bolt 0.2.1.0 → 0.2.2.0

raw patch · 3 files changed

+87/−19 lines, 3 filesdep +boltdep +tastydep +tasty-quickcheckdep ~basedep ~cerealPVP ok

version bump matches the API change (PVP)

Dependencies added: bolt, tasty, tasty-quickcheck

Dependency ranges changed: base, cereal

API changes (from Hackage documentation)

Files

• bolt.cabal +17/−10
• src/Data/PackStream.hs +9/−9
• test/Spec.hs +61/−0

@@ -1,5 +1,5 @@ name:                bolt
-version:             0.2.1.0
+version:             0.2.2.0
 synopsis:            Bolt driver for Neo4j
 description:
     A Bolt driver to access Neo4j databases using
@@ -40,7 +40,7 @@   build-depends:       base                 >= 4.8    && < 5
                      , bifunctors           >= 5.2    && < 5.5
                      , bytestring           >= 0.10.6 && < 0.11
-                     , cereal               >= 0.5.2  && < 0.6
+                     , cereal               >= 0.5.4  && < 0.6
                      , containers           >= 0.5.6  && < 0.6
                      , hashable             >= 1.2.4  && < 1.3
                      , network              >= 2.6.2  && < 2.7
@@ -53,14 +53,21 @@   ghc-options:         -Wall
   default-language:    Haskell2010
 
--- test-suite tests
---   type:                exitcode-stdio-1.0
---   hs-source-dirs:      test
---   main-is:             Spec.hs
---   build-depends:       base
---                      , bolt
---   ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall
---   default-language:    Haskell2010
+test-suite tests
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test
+  main-is:             Spec.hs
+  build-depends:       base
+                     , bolt
+                     , bytestring           >= 0.10.6 && < 0.11
+                     , cereal               >= 0.5.4  && < 0.6
+                     , text                 >= 1.2.2  && < 1.3
+                     , unordered-containers >= 0.2.7  && < 0.3
+                     , vector               >= 0.11.0 && < 0.12
+                     , tasty
+                     , tasty-quickcheck
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall
+  default-language:    Haskell2010
 
 source-repository head
   type:     git

@@ -181,10 +181,10 @@ 
        | marker <  0x80   -> return $ Int (fromIntegral marker)
        | marker >= 0xf0   -> return $ Int (fromIntegral marker - 0x100)
-       | marker == 0xc8   -> Int . fromIntegral <$> getWord8
-       | marker == 0xc9   -> Int . fromIntegral <$> getWord16be
-       | marker == 0xca   -> Int . fromIntegral <$> getWord32be
-       | marker == 0xcb   -> Int . fromIntegral <$> getWord64be
+       | marker == 0xc8   -> Int . fromIntegral <$> getInt8
+       | marker == 0xc9   -> Int . fromIntegral <$> getInt16be
+       | marker == 0xca   -> Int . fromIntegral <$> getInt32be
+       | marker == 0xcb   -> Int . fromIntegral <$> getInt64be
 
        | 0x80 <= marker && marker < 0x90
                           -> getString (fromIntegral marker .&. 0x0f)
@@ -234,11 +234,11 @@ putPackStream (Bool True)   = putWord8 0xc3
 
 putPackStream (Int i)
-    |               -0x10 <= i && i < 0x80               =                  putWord8    (fromIntegral i)
-    |               -0x80 <= i && i < 0x80               = putWord8 0xc8 >> putWord8    (fromIntegral i)
-    |             -0x8000 <= i && i < 0x8000             = putWord8 0xc9 >> putWord16be (fromIntegral i)
-    |         -0x80000000 <= i && i < 0x80000000         = putWord8 0xca >> putWord32be (fromIntegral i)
-    | otherwise                                          = putWord8 0xcb >> putWord64be (fromIntegral i)
+    |               -0x10 <= i && i < 0x80               =                  putInt8    (fromIntegral i)
+    |               -0x80 <= i && i < 0x80               = putWord8 0xc8 >> putInt8    (fromIntegral i)
+    |             -0x8000 <= i && i < 0x8000             = putWord8 0xc9 >> putInt16be (fromIntegral i)
+    |         -0x80000000 <= i && i < 0x80000000         = putWord8 0xca >> putInt32be (fromIntegral i)
+    | otherwise                                          = putWord8 0xcb >> putInt64be (fromIntegral i)
 
 putPackStream (String t) = do
     let bstr = T.encodeUtf8 t

@@ -0,0 +1,61 @@+module Main where
+
+import           Data.ByteString     (ByteString)
+import           Data.PackStream
+import qualified Data.HashMap.Strict as HM
+import qualified Data.Text           as Text
+import qualified Data.Vector         as Vec
+import           Data.Serialize.Get
+import           Data.Serialize.Put
+
+import           Test.Tasty
+import           Test.Tasty.QuickCheck
+
+instance Arbitrary PackStream where
+    arbitrary =
+      oneof [ return Null
+            , Bool   <$> arbitrary
+            , Int    <$> arbitrary
+            , Float  <$> arbitrary
+            , String <$> (Text.pack    <$> arbitrary)
+            , List   <$> (Vec.fromList <$> scale' (listOf arbitrary))
+            , Map    <$> (HM.fromList  <$> scale' (listOf arbitrary))
+            , Struct <$> arbitrary     <*> scale' (listOf arbitrary)
+            ]
+      where
+         scale' = scale (`div` 2)
+
+    shrink Null          = []
+    shrink (Bool _)      = [Null]
+    shrink (Int _)       = [Null]
+    shrink (Float _)     = [Null]
+    shrink (String s)    = Null : ((String . Text.pack)  <$> shrink (Text.unpack s))
+    shrink (List xs)
+        | Vec.length xs == 0 = [Null]
+        | Vec.length xs == 1 = [Vec.head xs]
+        | otherwise          = Null : ((List . Vec.fromList) <$> shrink (Vec.toList xs))
+    shrink (Map xs)
+        | HM.size xs == 0 = [Null]
+        | HM.size xs == 1 = let [(k, v)] = HM.toList xs in [k, v]
+        | otherwise       = Null : ((Map . HM.fromList)   <$> shrink (HM.toList xs))
+    shrink (Struct s xs) = Null : List (Vec.fromList xs) : (Struct s <$> shrink xs)
+
+prop_decode_encode :: PackStream -> Property
+prop_decode_encode a = (decode . encode) a === a
+  where
+    encode :: PackStream -> ByteString
+    encode = runPut . pack
+    decode :: ByteString -> PackStream
+    decode x = case runGet unpack x of
+                 Left err -> error err
+                 Right (Left err) -> error err
+                 Right (Right ps) -> ps
+
+
+main :: IO ()
+main = defaultMain $
+  testGroup "Tests"
+    [ testGroup "(checked by QuickCheck)"
+        [ testProperty "id == decode . encode" prop_decode_encode
+        ]
+    ]