Merge pull request #25 from input-output-hk/nc/qc

Switch to using QuickCheck for tests

cuddle.cabal

@@ -102,10 +102,9 @@ test-suite cuddle-test
     build-depends:
         , base              ^>=4.16.3.0 || ^>=4.18.1.0 || ^>=4.19.0.0
         , cuddle
-        , hedgehog
         , hspec
-        , hspec-hedgehog
         , hspec-megaparsec
         , megaparsec
         , prettyprinter
+        , QuickCheck
         , text

src/Codec/CBOR/Cuddle/CBOR/Gen.hs

@@ -38,6 +38,7 @@ import Data.Functor.Identity (Identity (runIdentity))
 import Data.List.NonEmpty qualified as NE
 import Data.Map.Strict qualified as Map
 import Data.Maybe (fromMaybe)
+import Data.Word (Word64)
 import GHC.Generics (Generic)
 import System.Random.Stateful
   ( Random,
@@ -340,8 +341,8 @@ applyOccurenceIndicator OIOneOrMore oldGen =
   genUniformRM (0 :: Int, 10) >>= \i ->
     G <$> replicateM i oldGen
 applyOccurenceIndicator (OIBounded mlb mub) oldGen =
-  genUniformRM (fromMaybe 0 mlb :: Int, fromMaybe 10 mub)
-    >>= \i -> G <$> replicateM i oldGen
+  genUniformRM (fromMaybe 0 mlb :: Word64, fromMaybe 10 mub)
+    >>= \i -> G <$> replicateM (fromIntegral i) oldGen
 
 genValue :: Value -> Gen Term
 genValue (VUInt i) = pure . TInt $ fromIntegral i

src/Codec/CBOR/Cuddle/CDDL.hs

@@ -7,7 +7,7 @@ import Data.ByteString qualified as B
 import Data.Hashable (Hashable)
 import Data.List.NonEmpty qualified as NE
 import Data.Text qualified as T
-import Data.Word (Word64)
+import Data.Word (Word64, Word8)
 import GHC.Generics (Generic)
 
 newtype CDDL = CDDL (NE.NonEmpty (WithComments Rule))
@@ -227,10 +227,10 @@ data Type2
   | T2EnumRef Name (Maybe GenericArg)
   | -- | a tagged data item, tagged with the "uint" given and containing the
     --  type given as the tagged value, or
-    T2Tag (Maybe Int) Type0
+    T2Tag (Maybe Word64) Type0
   | -- | a data item of a major type (given by the DIGIT), optionally
     --  constrained to the additional information given by the uint, or
-    T2DataItem Int (Maybe Int)
+    T2DataItem Word8 (Maybe Word64)
   | -- | Any data item
     T2Any
   deriving (Eq, Generic, Show)
@@ -253,7 +253,7 @@ data OccurrenceIndicator
   = OIOptional
   | OIZeroOrMore
   | OIOneOrMore
-  | OIBounded (Maybe Int) (Maybe Int)
+  | OIBounded (Maybe Word64) (Maybe Word64)
   deriving (Eq, Generic, Show)
 
 instance Hashable OccurrenceIndicator

src/Codec/CBOR/Cuddle/Huddle.hs

@@ -98,8 +98,8 @@ import Data.String (IsString (fromString))
 import Data.Text qualified as T
 import Data.Tuple.Optics (Field1 (..), Field2 (..), Field3 (..))
 import Data.Void (Void)
-import GHC.Exts (IsList (Item, fromList, toList))
 import Data.Word (Word64)
+import GHC.Exts (IsList (Item, fromList, toList))
 import GHC.Generics (Generic)
 import Optics.Core (over, view, (%~), (&), (.~))
 import Prelude hiding ((/))
@@ -252,8 +252,8 @@ instance Num Type0 where
 
 -- | Occurrence bounds.
 data Occurs = Occurs
-  { lb :: Maybe Int,
-    ub :: Maybe Int
+  { lb :: Maybe Word64,
+    ub :: Maybe Word64
   }
   deriving (Eq, Generic, Show)
 
@@ -495,10 +495,10 @@ instance (IsType0 a) => IsType0 (Tagged a) where
 
 class CanQuantify a where
   -- | Apply a lower bound
-  (<+) :: Int -> a -> a
+  (<+) :: Word64 -> a -> a
 
   -- | Apply an upper bound
-  (+>) :: a -> Int -> a
+  (+>) :: a -> Word64 -> a
 
 infixl 8 <+
 
@@ -699,12 +699,12 @@ ae / rt = ae & field @"value" %~ (// toType0 rt)
 --------------------------------------------------------------------------------
 
 -- | A tagged type carries an optional tag
-data Tagged a = Tagged (Maybe Int) a
+data Tagged a = Tagged (Maybe Word64) a
   deriving (Show, Functor)
 
 -- | Tag a CBOR item with a CDDL minor type. Thus, `tag n x` is equivalent to
 -- `#6.n(x)` in CDDL.
-tag :: Int -> a -> Tagged a
+tag :: Word64 -> a -> Tagged a
 tag mi = Tagged (Just mi)
 
 --------------------------------------------------------------------------------

src/Codec/CBOR/Cuddle/Parser.hs

@@ -31,7 +31,7 @@ pRule =
           <$> pName
           <*> optcomp pGenericParam
           <*> (space *> pAssignT <* space)
-          <*> (TOGType <$> pType0),
+          <*> (TOGType <$> pType0 <* notFollowedBy (void (char ':') <|> void (string "=>"))),
       Rule
         <$> pName
         <*> optcomp pGenericParam
@@ -73,20 +73,20 @@ pGenericParam :: Parser GenericParam
 pGenericParam =
   GenericParam
     <$> between
-      (char '<')
+      (char '<' <* space)
       (char '>')
-      (NE.sepBy1 (space *> pName <* space) (char ','))
+      (NE.sepBy1 (pName <* space) (char ',' <* space))
 
 pGenericArg :: Parser GenericArg
 pGenericArg =
   GenericArg
     <$> between
-      (char '<')
+      (char '<' <* space)
       (char '>')
-      (NE.sepBy1 (space *> pType1 <* space) (char ','))
+      (NE.sepBy1 (pType1 <* space) (char ',' <* space))
 
 pType0 :: Parser Type0
-pType0 = Type0 <$> sepBy1' (space *> pType1 <* space) (char '/')
+pType0 = Type0 <$> sepBy1' (pType1 <* space) (char '/' <* space)
 
 pType1 :: Parser Type1
 pType1 = Type1 <$> pType2 <*> optcomp ((,) <$> (space *> pTyOp <* space) <*> pType2)
@@ -96,24 +96,24 @@ pType2 =
   choice
     [ try $ T2Value <$> pValue,
       try $ T2Name <$> pName <*> optional pGenericArg,
-      try $ T2Group <$> between (char '(') (char ')') (space *> pType0 <* space),
-      try $ T2Map <$> between (char '{') (char '}') (space *> pGroup <* space),
-      try $ T2Array <$> between (char '[') (char ']') (space *> pGroup <* space),
+      try $ T2Group <$> between (char '(' <* space) (char ')' <* space) (pType0 <* space),
+      try $ T2Map <$> between (char '{' <* space) (char '}' <* space) (pGroup <* space),
+      try $ T2Array <$> between (char '[' <* space) (char ']' <* space) (pGroup <* space),
       try $ T2Unwrapped <$> (char '~' *> space *> pName) <*> optional pGenericArg,
       try $
         T2Enum
           <$> ( char '&'
                   *> space
                   *> between
-                    (char '(')
+                    (char '(' <* space)
                     (char ')')
-                    (space *> pGroup <* space)
+                    (pGroup <* space)
               ),
       try $ T2EnumRef <$> (char '&' *> space *> pName) <*> optional pGenericArg,
       try $
         T2Tag
           <$> (string "#6" *> optcomp (char '.' *> L.decimal))
-          <*> between (char '(') (char ')') (space *> pType0 <* space),
+          <*> between (char '(' <* space) (char ')') (pType0 <* space),
       try $ T2DataItem <$> (char '#' *> L.decimal) <*> optcomp (char '.' *> L.decimal),
       T2Any <$ char '#'
     ]
@@ -212,7 +212,7 @@ pValue =
     -- value.
     pUInt = VUInt <$> L.decimal <* notFollowedBy (oneOf ['*', '.'])
     pNInt = VNInt <$> (char '-' *> L.decimal <* notFollowedBy (oneOf ['*', '.']))
-    pFloat = VFloat64 <$> L.float
+    pFloat = VFloat64 <$> L.signed hspace L.float
     pText = VText <$> (char '"' *> pSChar <* char '"')
     -- Currently this doesn't allow string escaping
     pSChar :: Parser Text