[#280] Roundtrip tests for Combinator.Primitive (#288)

test/Test/Toml/BigType.hs

@@ -29,6 +29,7 @@ import GHC.Generics (Generic)
 import Hedgehog (Gen)
 import Numeric.Natural (Natural)
 
+import Test.Toml.Codec.Combinator.Common (Batman (..))
 import Test.Toml.Gen (genBool, genByteString, genDay, genDouble, genFloat, genHashSet, genHours,
                       genInt, genIntSet, genInteger, genLByteString, genLocal, genNatural,
                       genNonEmpty, genString, genText, genWord, genZoned)
@@ -75,20 +76,6 @@ data BigType = BigType
     , btLast          :: !(Last Int)
     } deriving stock (Show, Eq, Generic)
 
--- | Wrapper over 'Double' and 'Float' to be equal on @NaN@ values.
-newtype Batman a = Batman
-    { unBatman :: a
-    } deriving stock (Show)
-
-instance HasCodec a => HasCodec (Batman a) where
-    hasCodec = Toml.diwrap . hasCodec @a
-
-instance RealFloat a => Eq (Batman a) where
-    Batman a == Batman b =
-        if isNaN a
-            then isNaN b
-            else a == b
-
 newtype BigTypeNewtype = BigTypeNewtype
     { unBigTypeNewtype :: ZonedTime
     } deriving stock (Show)

test/Test/Toml/Codec/Combinator.hs

@@ -6,15 +6,18 @@ import Hedgehog (forAll, tripping)
 import Test.Hspec (Arg, Expectation, Spec, SpecWith, describe, it)
 import Test.Hspec.Hedgehog (hedgehog)
 
-import Test.Toml.BigType (bigTypeCodec, genBigType)
+-- import Test.Toml.BigType (bigTypeCodec, genBigType)
+import Test.Toml.Codec.Combinator.Primitive (primitiveSpec)
 import Toml.Codec.Code (decode, encode)
 
 
 combinatorSpec :: Spec
 combinatorSpec = describe "Combinator spec"
-    encodeDecodeSpec
+    primitiveSpec
 
-encodeDecodeSpec :: SpecWith (Arg Expectation)
-encodeDecodeSpec = it "decode . encode ≡ id" $ hedgehog $ do
-    bigType <- forAll genBigType
-    tripping bigType (encode bigTypeCodec) (decode bigTypeCodec)
+--     encodeDecodeSpec
+--
+-- encodeDecodeSpec :: SpecWith (Arg Expectation)
+-- encodeDecodeSpec = it "decode . encode ≡ id" $ hedgehog $ do
+--     bigType <- forAll genBigType
+--     tripping bigType (encode bigTypeCodec) (decode bigTypeCodec)

test/Test/Toml/Codec/Combinator/Common.hs

@@ -0,0 +1,55 @@
+module Test.Toml.Codec.Combinator.Common
+    ( codecRoundtrip
+
+      -- * Double helpers
+    , Batman (..)
+    , batmanDoubleCodec
+    , batmanFloatCodec
+    ) where
+
+import Hedgehog (Gen, forAll, tripping)
+import Test.Hspec (Arg, Expectation, SpecWith, it)
+import Test.Hspec.Hedgehog (hedgehog)
+
+import Toml.Codec.Code (decode, encode)
+import Toml.Codec.Types (TomlCodec)
+import Toml.Type.Key (Key)
+
+
+import qualified Toml.Codec as Toml
+
+
+codecRoundtrip
+    :: forall a
+    .  (Eq a, Show a)
+    => String
+    -> (Key -> TomlCodec a)
+    -> Gen a
+    -> SpecWith (Arg Expectation)
+codecRoundtrip typeName mkCodec genA = it label $ hedgehog $ do
+    a <- forAll genA
+    let codec = mkCodec "a"
+    tripping a (encode codec) (decode codec)
+  where
+    label :: String
+    label = typeName ++ ": decode . encode ≡ id"
+
+-- | Wrapper over 'Double' and 'Float' to be equal on @NaN@ values.
+newtype Batman a = Batman
+    { unBatman :: a
+    } deriving stock (Show)
+
+instance Toml.HasCodec a => Toml.HasCodec (Batman a) where
+    hasCodec = Toml.diwrap . Toml.hasCodec @a
+
+instance RealFloat a => Eq (Batman a) where
+    Batman a == Batman b =
+        if isNaN a
+            then isNaN b
+            else a == b
+
+batmanDoubleCodec :: Key -> TomlCodec (Batman Double)
+batmanDoubleCodec = Toml.diwrap . Toml.double
+
+batmanFloatCodec :: Key -> TomlCodec (Batman Float)
+batmanFloatCodec = Toml.diwrap . Toml.float

test/Test/Toml/Codec/Combinator/Primitive.hs

@@ -0,0 +1,30 @@
+module Test.Toml.Codec.Combinator.Primitive
+    ( primitiveSpec
+    ) where
+
+import Test.Hspec (Spec, describe)
+
+import Test.Toml.Codec.Combinator.Common (Batman (..), batmanDoubleCodec, batmanFloatCodec,
+                                          codecRoundtrip)
+
+import qualified Test.Toml.Gen as Gen
+import qualified Toml.Codec.Combinator.Primitive as Toml
+
+
+primitiveSpec :: Spec
+primitiveSpec = describe "Combinator.Primitive: Roundtrip tests" $ do
+    codecRoundtrip "Bool             " Toml.bool                Gen.genBool
+    codecRoundtrip "Integer          " Toml.integer             Gen.genInteger
+    codecRoundtrip "Int              " Toml.int                 Gen.genInt
+    codecRoundtrip "Natural          " Toml.natural             Gen.genNatural
+    codecRoundtrip "Word             " Toml.word                Gen.genWord
+    codecRoundtrip "Word8            " Toml.word8               Gen.genWord8
+    codecRoundtrip "Double           " batmanDoubleCodec        (Batman <$> Gen.genDouble)
+    codecRoundtrip "Float            " batmanFloatCodec         (Batman <$> Gen.genFloat)
+    codecRoundtrip "String           " Toml.string              Gen.genString
+    codecRoundtrip "Text             " Toml.text                Gen.genText
+    codecRoundtrip "LText            " Toml.lazyText            Gen.genLText
+    codecRoundtrip "ByteString       " Toml.byteString          Gen.genByteString
+    codecRoundtrip "LByteString      " Toml.lazyByteString      Gen.genLByteString
+    codecRoundtrip "ByteString Array " Toml.byteStringArray     Gen.genByteString
+    codecRoundtrip "LByteString Array" Toml.lazyByteStringArray Gen.genLByteString

tomland.cabal

@@ -162,6 +162,8 @@ test-suite tomland-test
                          Test.Toml.Codec.BiMap
                            Test.Toml.Codec.BiMap.Conversion
                          Test.Toml.Codec.Combinator
+                           Test.Toml.Codec.Combinator.Common
+                           Test.Toml.Codec.Combinator.Primitive
                          Test.Toml.Codec.Generic
 
                        Test.Toml.Parser