bolt 0.1.0.3 → 0.2.0.0

raw patch · 17 files changed

+1084/−1001 lines, 17 filesdep +scientificdep +transformerssetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: scientific, transformers

API changes (from Hackage documentation)

Files

• LICENSE +30/−30
• README.md +15/−15
• Setup.hs +2/−2
• bolt.cabal +67/−64
• src/Data/PackStream.hs +309/−293
• src/Database/Bolt/Exception.hs +39/−39
• src/Database/Bolt/Protocol/Ver1.hs +37/−29
• src/Database/Bolt/Protocol/Ver1/Graph.hs +82/−82
• src/Database/Bolt/Protocol/Ver1/Message.hs +77/−77
• src/Database/Bolt/Protocol/Ver1/Pretty.hs +30/−30
• src/Database/Bolt/Protocol/Ver1/Request.hs +74/−74
• src/Database/Bolt/Protocol/Ver1/Transaction.hs +43/−0
• src/Database/Bolt/Protocol/Ver1/Types.hs +33/−20
• src/Database/Bolt/Transport.hs +68/−68
• src/Database/Bolt/Transport/Chunked.hs +73/−73
• src/Database/Bolt/Transport/Message.hs +26/−26
• src/Database/Bolt/Transport/Socket.hs +79/−79

@@ -1,30 +1,30 @@-Copyright Shaun Sharples (c) 2016--All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:--    * Redistributions of source code must retain the above copyright-      notice, this list of conditions and the following disclaimer.--    * Redistributions in binary form must reproduce the above-      copyright notice, this list of conditions and the following-      disclaimer in the documentation and/or other materials provided-      with the distribution.--    * Neither the name of Author name here nor the names of other-      contributors may be used to endorse or promote products derived-      from this software without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+Copyright Shaun Sharples (c) 2016
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Author name here nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -1,15 +1,15 @@-# Bolt driver for Haskell--I have started writing a basic Bolt driver to access Neo4j databases by-implementing the [Bolt Protocol, Version 1](http://boltprotocol.org/v1/).--## Join In!--I am happy to receive bug reports, fixes, documentation enhancements, and-other improvements.--Please report bugs via the [github issue tracker](https://github.com/bflyblue/bolt/issues).--## Authors--This library is written and maintained by Shaun Sharples, <shaun.sharples@gmail.com>.+# Bolt driver for Haskell
+
+I have started writing a basic Bolt driver to access Neo4j databases by
+implementing the [Bolt Protocol, Version 1](http://boltprotocol.org/v1/).
+
+## Join In!
+
+I am happy to receive bug reports, fixes, documentation enhancements, and
+other improvements.
+
+Please report bugs via the [github issue tracker](https://github.com/bflyblue/bolt/issues).
+
+## Authors
+
+This library is written and maintained by Shaun Sharples, <shaun.sharples@gmail.com>.

@@ -1,2 +1,2 @@-import Distribution.Simple-main = defaultMain+import Distribution.Simple
+main = defaultMain

@@ -1,64 +1,67 @@-name:                bolt-version:             0.1.0.3-synopsis:            Bolt driver for Neo4j-description:-    A Bolt driver to access Neo4j databases using-    the Bolt Protocol, Version 1. <http://boltprotocol.org/v1/>-homepage:            https://github.com/bflyblue/bolt#readme-license:             BSD3-license-file:        LICENSE-author:              Shaun Sharples-maintainer:          shaun.sharples@gmail.com-stability:           experimental-copyright:           (c) 2016 Shaun Sharples-category:            Database-build-type:          Simple-extra-source-files:  README.md-cabal-version:       >=1.10--library-  hs-source-dirs:      src-  other-extensions:    DeriveAnyClass-                     , DeriveGeneric-                     , MultiWayIf-                     , OverloadedStrings-                     , RecordWildCards-                     , ScopedTypeVariables-  exposed-modules:     Data.PackStream-                     , Database.Bolt.Exception-                     , Database.Bolt.Protocol.Ver1-                     , Database.Bolt.Protocol.Ver1.Graph-                     , Database.Bolt.Protocol.Ver1.Message-                     , Database.Bolt.Protocol.Ver1.Pretty-                     , Database.Bolt.Protocol.Ver1.Request-                     , Database.Bolt.Protocol.Ver1.Types-                     , Database.Bolt.Transport-                     , Database.Bolt.Transport.Chunked-                     , Database.Bolt.Transport.Message-                     , Database.Bolt.Transport.Socket-  build-depends:       base >= 4.8 && < 5-                     , bifunctors           >= 5.2 && < 5.5-                     , bytestring           >= 0.10.6 && < 0.11-                     , cereal               >= 0.5.2 && < 0.6-                     , containers           >= 0.5.6 && < 0.6-                     , hashable             >= 1.2.4 && < 1.3-                     , network              >= 2.6.2 && < 2.7-                     , network-uri          >= 2.6.1 && < 2.7-                     , text                 >= 1.2.2 && < 1.3-                     , unordered-containers >= 0.2.7 && < 0.3-                     , vector               >= 0.11.0 && < 0.12-  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--source-repository head-  type:     git-  location: https://github.com/bflyblue/bolt+name:                bolt
+version:             0.2.0.0
+synopsis:            Bolt driver for Neo4j
+description:
+    A Bolt driver to access Neo4j databases using
+    the Bolt Protocol, Version 1. <http://boltprotocol.org/v1/>
+homepage:            https://github.com/bflyblue/bolt#readme
+license:             BSD3
+license-file:        LICENSE
+author:              Shaun Sharples
+maintainer:          shaun.sharples@gmail.com
+stability:           experimental
+copyright:           (c) 2016 Shaun Sharples
+category:            Database
+build-type:          Simple
+extra-source-files:  README.md
+cabal-version:       >=1.10
+
+library
+  hs-source-dirs:      src
+  other-extensions:    DeriveAnyClass
+                     , DeriveGeneric
+                     , MultiWayIf
+                     , OverloadedStrings
+                     , RecordWildCards
+                     , ScopedTypeVariables
+  exposed-modules:     Data.PackStream
+                     , Database.Bolt.Exception
+                     , Database.Bolt.Protocol.Ver1
+                     , Database.Bolt.Protocol.Ver1.Graph
+                     , Database.Bolt.Protocol.Ver1.Message
+                     , Database.Bolt.Protocol.Ver1.Pretty
+                     , Database.Bolt.Protocol.Ver1.Request
+                     , Database.Bolt.Protocol.Ver1.Transaction
+                     , Database.Bolt.Protocol.Ver1.Types
+                     , Database.Bolt.Transport
+                     , Database.Bolt.Transport.Chunked
+                     , Database.Bolt.Transport.Message
+                     , Database.Bolt.Transport.Socket
+  build-depends:       base >= 4.8 && < 5
+                     , bifunctors           >= 5.2 && < 5.5
+                     , bytestring           >= 0.10.6 && < 0.11
+                     , cereal               >= 0.5.2 && < 0.6
+                     , containers           >= 0.5.6 && < 0.6
+                     , hashable             >= 1.2.4 && < 1.3
+                     , network              >= 2.6.2 && < 2.7
+                     , network-uri          >= 2.6.1 && < 2.7
+                     , scientific           >= 0.3.0 && < 0.4
+                     , text                 >= 1.2.2 && < 1.3
+                     , transformers         >= 0.5.0 && < 0.6
+                     , unordered-containers >= 0.2.7 && < 0.3
+                     , vector               >= 0.11.0 && < 0.12
+  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
+
+source-repository head
+  type:     git
+  location: https://github.com/bflyblue/bolt

@@ -1,293 +1,309 @@-{-# LANGUAGE DeriveAnyClass    #-}-{-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE MultiWayIf        #-}-{-# LANGUAGE OverloadedStrings #-}--module Data.PackStream-  ( PackStream(..)-  , ToPackStream(..)-  , FromPackStream(..)-  , Parser-  , parse-  , parseEither-  , parseMaybe-  , pack-  , unpack-  , pretty-  , prettyStruct-  , genericStructName-  , (.=)-  , (.:)-  , (.:?)-  , (.!=)-  )-where--import           Control.Monad-import           Data.Bifunctor-import           Data.Bits-import           Data.Hashable-import qualified Data.HashMap.Strict    as HM-import           Data.Int-import qualified Data.Map.Strict        as M-import           Data.Monoid-import           Data.Serialize.Get-import           Data.Serialize.IEEE754-import           Data.Serialize.Put-import           Data.Text              (Text)-import qualified Data.Text              as T-import qualified Data.Text.Encoding     as T-import qualified Data.Vector            as V-import           Data.Word-import           GHC.Generics           (Generic)-import           Text.Printf---- Orphan instance should go away once vector-instances 0.4 is available-instance (Hashable a) => Hashable (V.Vector a) where-    hashWithSalt salt = hashWithSalt salt . V.toList-    {-# INLINE hashWithSalt #-}--data PackStream = Null-                | Bool   !Bool-                | Int    !Int64-                | Float  !Double-                | String !Text-                | List   !(V.Vector PackStream)-                | Map    !(HM.HashMap PackStream PackStream)-                | Struct !Word8 ![PackStream]-    deriving (Show, Eq, Generic, Hashable)--type Parser = Either String--parse :: (a -> Parser b) -> a -> Parser b-parse = parseEither--parseEither :: (a -> Parser b) -> a -> Either String b-parseEither f = f--parseMaybe :: (a -> Parser b) -> a -> Maybe b-parseMaybe f = either (const Nothing) Just . parseEither f--class FromPackStream a where-    parsePackStream :: PackStream -> Parser a--instance FromPackStream PackStream where-    parsePackStream = return--instance FromPackStream Bool where-    parsePackStream (Bool b) = return b-    parsePackStream _        = fail "Expecting Bool"--instance FromPackStream Int64 where-    parsePackStream (Int i) = return i-    parsePackStream _       = fail "Expecting Int"--instance FromPackStream Double where-    parsePackStream (Float d) = return d-    parsePackStream _         = fail "Expecting Float"--instance FromPackStream Text where-    parsePackStream (String t) = return t-    parsePackStream _          = fail "Expecting String"--instance FromPackStream a => FromPackStream [a] where-    parsePackStream (List l) = mapM parsePackStream (V.toList l)-    parsePackStream _        = fail "Expecting List"--instance FromPackStream a => FromPackStream (V.Vector a) where-    parsePackStream (List l) = mapM parsePackStream l-    parsePackStream _        = fail "Expecting List"--instance (Eq a, Hashable a, FromPackStream a, FromPackStream b) => FromPackStream (HM.HashMap a b) where-    parsePackStream (Map m) = do-        kvs <- mapM parseAssoc (HM.toList m)-        return $ HM.fromList kvs-      where-        parseAssoc (k, v) = (,) <$> parsePackStream k <*> parsePackStream v--    parsePackStream _ = fail "Expecting Map"--instance (Ord a, FromPackStream a, FromPackStream b) => FromPackStream (M.Map a b) where-    parsePackStream (Map m) = do-        kvs <- mapM parseAssoc (HM.toList m)-        return $ M.fromList kvs-      where-        parseAssoc (k, v) = (,) <$> parsePackStream k <*> parsePackStream v--    parsePackStream _ = fail "Expecting Map"--class ToPackStream a where-    toPackStream :: a -> PackStream--instance ToPackStream PackStream where-    toPackStream = id--instance ToPackStream Bool where-    toPackStream = Bool--instance ToPackStream Int64 where-    toPackStream = Int--instance ToPackStream Double where-    toPackStream = Float--instance ToPackStream Text where-    toPackStream = String--instance ToPackStream a => ToPackStream [a] where-    toPackStream = List . V.fromList . fmap toPackStream--instance ToPackStream a => ToPackStream (V.Vector a) where-    toPackStream = List . fmap toPackStream--instance (ToPackStream a, ToPackStream b) => ToPackStream (M.Map a b) where-    toPackStream = Map . HM.fromList . fmap (bimap toPackStream toPackStream) . M.toList--instance (ToPackStream a, ToPackStream b) => ToPackStream (HM.HashMap a b) where-    toPackStream = Map . HM.fromList . fmap (bimap toPackStream toPackStream) . HM.toList--pack :: ToPackStream a => Putter a-pack = putPackStream . toPackStream--unpack :: FromPackStream a => Get (Parser a)-unpack = parsePackStream <$> getPackStream--getPackStream :: Get PackStream-getPackStream = do-    marker <- getWord8-    if | marker == 0xc0   -> return Null--       | marker == 0xc1   -> Float <$> getFloat64be--       | marker == 0xc2   -> return $ Bool False-       | marker == 0xc3   -> return $ Bool True--       | 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--       | 0x80 <= marker && marker < 0x90-                          -> getString (fromIntegral marker .&. 0x0f)-       | marker == 0xd0   -> fromIntegral <$> getWord8    >>= getString-       | marker == 0xd1   -> fromIntegral <$> getWord16be >>= getString-       | marker == 0xd2   -> fromIntegral <$> getWord32be >>= getString--       | 0x90 <= marker && marker < 0xa0-                          -> getList (fromIntegral marker .&. 0x0f)-       | marker == 0xd4   -> fromIntegral <$> getWord8    >>= getList-       | marker == 0xd5   -> fromIntegral <$> getWord16be >>= getList-       | marker == 0xd6   -> fromIntegral <$> getWord32be >>= getList--       | 0xa0 <= marker && marker < 0xb0-                          -> getMap (fromIntegral marker .&. 0x0f)-       | marker == 0xd8   -> fromIntegral <$> getWord8    >>= getMap-       | marker == 0xd9   -> fromIntegral <$> getWord16be >>= getMap-       | marker == 0xda   -> fromIntegral <$> getWord32be >>= getMap--       | 0xb0 <= marker && marker < 0xc0-                          -> getStruct (fromIntegral marker .&. 0x0f)-       | marker == 0xdc   -> fromIntegral <$> getWord8    >>= getStruct-       | marker == 0xdd   -> fromIntegral <$> getWord16be >>= getStruct-       | otherwise        -> fail $ "Unknown marker " ++ printf "0x%02x" marker--getString :: Int -> Get PackStream-getString n = String . T.decodeUtf8 <$> getByteString n--getList :: Int -> Get PackStream-getList n = List . V.fromList <$> replicateM n getPackStream--getMap :: Int -> Get PackStream-getMap n = Map . HM.fromList <$> replicateM n getPair-  where-    getPair = (,) <$> getPackStream <*> getPackStream--getStruct :: Int -> Get PackStream-getStruct n = Struct <$> getWord8 <*> replicateM n getPackStream--putPackStream :: Putter PackStream--putPackStream Null          = putWord8 0xc0--putPackStream (Float d)     = putWord8 0xc1 >> putFloat64be d--putPackStream (Bool False)  = putWord8 0xc2-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)--putPackStream (String t) = do-    let size = T.length t-    if | size < 0x10         -> putWord8 (0x80 + fromIntegral size)-       | size < 0x100        -> putWord8 0xd0 >> putWord8    (fromIntegral size)-       | size < 0x10000      -> putWord8 0xd1 >> putWord16be (fromIntegral size)-       | size < 0x100000000  -> putWord8 0xd2 >> putWord16be (fromIntegral size)-       | otherwise           -> fail "String too long"-    putByteString $ T.encodeUtf8 t--putPackStream (List xs) = do-    let size = V.length xs-    if | size < 0x10         -> putWord8 (0x90 + fromIntegral size)-       | size < 0x100        -> putWord8 0xd4 >> putWord8    (fromIntegral size)-       | size < 0x10000      -> putWord8 0xd5 >> putWord16be (fromIntegral size)-       | size < 0x100000000  -> putWord8 0xd6 >> putWord16be (fromIntegral size)-       | otherwise           -> fail "List too long"-    mapM_ putPackStream xs--putPackStream (Map m) = do-    let size = HM.size m-    if | size < 0x10         -> putWord8 (0xa0 + fromIntegral size)-       | size < 0x100        -> putWord8 0xd8 >> putWord8    (fromIntegral size)-       | size < 0x10000      -> putWord8 0xd9 >> putWord16be (fromIntegral size)-       | size < 0x100000000  -> putWord8 0xda >> putWord16be (fromIntegral size)-       | otherwise           -> fail "Map too large"-    mapM_ (uncurry putPair) (HM.toList m)-  where-    putPair k v = putPackStream k >> putPackStream v--putPackStream (Struct sig fs) = do-    let size = length fs-    if | size < 0x10         -> putWord8 (0xb0 + fromIntegral size)-       | size < 0x100        -> putWord8 0xdc >> putWord8    (fromIntegral size)-       | size < 0x10000      -> putWord8 0xdd >> putWord16be (fromIntegral size)-       | otherwise           -> fail "Structure too big"-    putWord8 sig-    mapM_ putPackStream fs--pretty :: PackStream -> Text-pretty = prettyStruct genericStructName--prettyStruct :: (Word8 -> Text) -> PackStream -> Text-prettyStruct _  Null           = "null"-prettyStruct _  (Bool True)    = "true"-prettyStruct _  (Bool False)   = "false"-prettyStruct _  (Int i)        = T.pack (show i)-prettyStruct _  (Float d)      = T.pack (show d)-prettyStruct _  (String t)     = "\"" <> t <> "\""-prettyStruct _  (List xs)      = "[" <> T.intercalate ", " (pretty <$> V.toList xs) <> "]"-prettyStruct _  (Map ps)       = "{" <> T.intercalate ", " (fmap (\(k, v) -> pretty k <> ": " <> pretty v) (HM.toList ps)) <> "}"-prettyStruct sn (Struct s fs)  = sn s <> "{" <> T.intercalate ", " (pretty <$> fs) <> "}"--genericStructName :: Word8 -> Text-genericStructName n = "Struct(signature=" <> T.pack (printf "0x%02x" n) <> ")"--(.=) :: ToPackStream a => Text -> a -> (PackStream, PackStream)-k .= v = (String k, toPackStream v)--(.:) :: FromPackStream a => HM.HashMap PackStream PackStream -> Text -> Parser a-m .: k = maybe (error "Expected Key missing in map") parsePackStream (HM.lookup (String k) m)--(.:?) :: FromPackStream a => HM.HashMap PackStream PackStream -> Text -> Parser (Maybe a)-m .:? k = maybe (return Nothing) (fmap Just . parsePackStream) (HM.lookup (String k) m)--(.!=) :: Parser (Maybe a) -> a -> Parser a-p .!= d = do-    ma <- p-    maybe (return d) return ma+{-# LANGUAGE DeriveAnyClass    #-}
+{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE MultiWayIf        #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Data.PackStream
+  ( PackStream(..)
+  , ToPackStream(..)
+  , FromPackStream(..)
+  , Parser
+  , parse
+  , parsefail
+  , parseEither
+  , parseMaybe
+  , pack
+  , unpack
+  , pretty
+  , prettyStruct
+  , genericStructName
+  , (.=)
+  , (.:)
+  , (.:?)
+  , (.!=)
+  )
+where
+
+import           Control.Monad
+import           Data.Bifunctor
+import           Data.Bits
+import           Data.Hashable
+import qualified Data.HashMap.Strict    as HM
+import           Data.Int
+import qualified Data.Map.Strict        as M
+import           Data.Monoid
+import           Data.Scientific
+import           Data.Serialize.Get
+import           Data.Serialize.IEEE754
+import           Data.Serialize.Put
+import           Data.Text              (Text)
+import qualified Data.Text              as T
+import qualified Data.Text.Encoding     as T
+import qualified Data.Vector            as V
+import           Data.Word
+import           GHC.Generics           (Generic)
+import           Text.Printf
+
+-- Orphan instance should go away once vector-instances 0.4 is available
+instance (Hashable a) => Hashable (V.Vector a) where
+    hashWithSalt salt = hashWithSalt salt . V.toList
+    {-# INLINE hashWithSalt #-}
+
+data PackStream = Null
+                | Bool   !Bool
+                | Int    !Int64
+                | Float  !Double
+                | String !Text
+                | List   !(V.Vector PackStream)
+                | Map    !(HM.HashMap PackStream PackStream)
+                | Struct !Word8 ![PackStream]
+    deriving (Show, Eq, Generic, Hashable)
+
+type Parser = Either String
+
+parse :: (a -> Parser b) -> a -> Parser b
+parse = parseEither
+
+parseEither :: (a -> Parser b) -> a -> Either String b
+parseEither f = f
+
+parseMaybe :: (a -> Parser b) -> a -> Maybe b
+parseMaybe f = either (const Nothing) Just . parseEither f
+
+parsefail :: a -> Either a b
+parsefail = Left
+
+class FromPackStream a where
+    parsePackStream :: PackStream -> Parser a
+
+instance FromPackStream PackStream where
+    parsePackStream = return
+
+instance FromPackStream Bool where
+    parsePackStream (Bool b) = return b
+    parsePackStream _        = parsefail "Expecting Bool"
+
+instance FromPackStream Int64 where
+    parsePackStream (Int i) = return i
+    parsePackStream _       = parsefail "Expecting Int"
+
+instance FromPackStream Double where
+    parsePackStream (Float d) = return d
+    parsePackStream _         = parsefail "Expecting Float"
+
+instance FromPackStream Text where
+    parsePackStream (String t) = return t
+    parsePackStream _          = parsefail "Expecting String"
+
+instance FromPackStream a => FromPackStream [a] where
+    parsePackStream (List l) = mapM parsePackStream (V.toList l)
+    parsePackStream _        = parsefail "Expecting List"
+
+instance FromPackStream a => FromPackStream (V.Vector a) where
+    parsePackStream (List l) = mapM parsePackStream l
+    parsePackStream _        = parsefail "Expecting List"
+
+instance (Eq a, Hashable a, FromPackStream a, FromPackStream b) => FromPackStream (HM.HashMap a b) where
+    parsePackStream (Map m) = do
+        kvs <- mapM parseAssoc (HM.toList m)
+        return $ HM.fromList kvs
+      where
+        parseAssoc (k, v) = (,) <$> parsePackStream k <*> parsePackStream v
+
+    parsePackStream _ = parsefail "Expecting Map"
+
+instance (Ord a, FromPackStream a, FromPackStream b) => FromPackStream (M.Map a b) where
+    parsePackStream (Map m) = do
+        kvs <- mapM parseAssoc (HM.toList m)
+        return $ M.fromList kvs
+      where
+        parseAssoc (k, v) = (,) <$> parsePackStream k <*> parsePackStream v
+
+    parsePackStream _ = parsefail "Expecting Map"
+
+instance FromPackStream Scientific where
+    parsePackStream (Int i)   = return $ fromIntegral i
+    parsePackStream (Float f) = return $ fromFloatDigits f
+    parsePackStream _         = parsefail "Expecting Int or Float"
+
+class ToPackStream a where
+    toPackStream :: a -> PackStream
+
+instance ToPackStream PackStream where
+    toPackStream = id
+
+instance ToPackStream Bool where
+    toPackStream = Bool
+
+instance ToPackStream Int64 where
+    toPackStream = Int
+
+instance ToPackStream Double where
+    toPackStream = Float
+
+instance ToPackStream Text where
+    toPackStream = String
+
+instance ToPackStream a => ToPackStream [a] where
+    toPackStream = List . V.fromList . fmap toPackStream
+
+instance ToPackStream a => ToPackStream (V.Vector a) where
+    toPackStream = List . fmap toPackStream
+
+instance (ToPackStream a, ToPackStream b) => ToPackStream (M.Map a b) where
+    toPackStream = Map . HM.fromList . fmap (bimap toPackStream toPackStream) . M.toList
+
+instance (ToPackStream a, ToPackStream b) => ToPackStream (HM.HashMap a b) where
+    toPackStream = Map . HM.fromList . fmap (bimap toPackStream toPackStream) . HM.toList
+
+instance ToPackStream Scientific where
+    toPackStream s =
+        case Data.Scientific.floatingOrInteger s of
+            Left rf -> Float rf
+            Right i -> Int i
+
+pack :: ToPackStream a => Putter a
+pack = putPackStream . toPackStream
+
+unpack :: FromPackStream a => Get (Parser a)
+unpack = parsePackStream <$> getPackStream
+
+getPackStream :: Get PackStream
+getPackStream = do
+    marker <- getWord8
+    if | marker == 0xc0   -> return Null
+
+       | marker == 0xc1   -> Float <$> getFloat64be
+
+       | marker == 0xc2   -> return $ Bool False
+       | marker == 0xc3   -> return $ Bool True
+
+       | 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
+
+       | 0x80 <= marker && marker < 0x90
+                          -> getString (fromIntegral marker .&. 0x0f)
+       | marker == 0xd0   -> fromIntegral <$> getWord8    >>= getString
+       | marker == 0xd1   -> fromIntegral <$> getWord16be >>= getString
+       | marker == 0xd2   -> fromIntegral <$> getWord32be >>= getString
+
+       | 0x90 <= marker && marker < 0xa0
+                          -> getList (fromIntegral marker .&. 0x0f)
+       | marker == 0xd4   -> fromIntegral <$> getWord8    >>= getList
+       | marker == 0xd5   -> fromIntegral <$> getWord16be >>= getList
+       | marker == 0xd6   -> fromIntegral <$> getWord32be >>= getList
+
+       | 0xa0 <= marker && marker < 0xb0
+                          -> getMap (fromIntegral marker .&. 0x0f)
+       | marker == 0xd8   -> fromIntegral <$> getWord8    >>= getMap
+       | marker == 0xd9   -> fromIntegral <$> getWord16be >>= getMap
+       | marker == 0xda   -> fromIntegral <$> getWord32be >>= getMap
+
+       | 0xb0 <= marker && marker < 0xc0
+                          -> getStruct (fromIntegral marker .&. 0x0f)
+       | marker == 0xdc   -> fromIntegral <$> getWord8    >>= getStruct
+       | marker == 0xdd   -> fromIntegral <$> getWord16be >>= getStruct
+       | otherwise        -> fail $ "Unknown marker " ++ printf "0x%02x" marker
+
+getString :: Int -> Get PackStream
+getString n = String . T.decodeUtf8 <$> getByteString n
+
+getList :: Int -> Get PackStream
+getList n = List . V.fromList <$> replicateM n getPackStream
+
+getMap :: Int -> Get PackStream
+getMap n = Map . HM.fromList <$> replicateM n getPair
+  where
+    getPair = (,) <$> getPackStream <*> getPackStream
+
+getStruct :: Int -> Get PackStream
+getStruct n = Struct <$> getWord8 <*> replicateM n getPackStream
+
+putPackStream :: Putter PackStream
+
+putPackStream Null          = putWord8 0xc0
+
+putPackStream (Float d)     = putWord8 0xc1 >> putFloat64be d
+
+putPackStream (Bool False)  = putWord8 0xc2
+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)
+
+putPackStream (String t) = do
+    let size = T.length t
+    if | size < 0x10         -> putWord8 (0x80 + fromIntegral size)
+       | size < 0x100        -> putWord8 0xd0 >> putWord8    (fromIntegral size)
+       | size < 0x10000      -> putWord8 0xd1 >> putWord16be (fromIntegral size)
+       | size < 0x100000000  -> putWord8 0xd2 >> putWord16be (fromIntegral size)
+       | otherwise           -> fail "String too long"
+    putByteString $ T.encodeUtf8 t
+
+putPackStream (List xs) = do
+    let size = V.length xs
+    if | size < 0x10         -> putWord8 (0x90 + fromIntegral size)
+       | size < 0x100        -> putWord8 0xd4 >> putWord8    (fromIntegral size)
+       | size < 0x10000      -> putWord8 0xd5 >> putWord16be (fromIntegral size)
+       | size < 0x100000000  -> putWord8 0xd6 >> putWord16be (fromIntegral size)
+       | otherwise           -> fail "List too long"
+    mapM_ putPackStream xs
+
+putPackStream (Map m) = do
+    let size = HM.size m
+    if | size < 0x10         -> putWord8 (0xa0 + fromIntegral size)
+       | size < 0x100        -> putWord8 0xd8 >> putWord8    (fromIntegral size)
+       | size < 0x10000      -> putWord8 0xd9 >> putWord16be (fromIntegral size)
+       | size < 0x100000000  -> putWord8 0xda >> putWord16be (fromIntegral size)
+       | otherwise           -> fail "Map too large"
+    mapM_ (uncurry putPair) (HM.toList m)
+  where
+    putPair k v = putPackStream k >> putPackStream v
+
+putPackStream (Struct sig fs) = do
+    let size = length fs
+    if | size < 0x10         -> putWord8 (0xb0 + fromIntegral size)
+       | size < 0x100        -> putWord8 0xdc >> putWord8    (fromIntegral size)
+       | size < 0x10000      -> putWord8 0xdd >> putWord16be (fromIntegral size)
+       | otherwise           -> fail "Structure too big"
+    putWord8 sig
+    mapM_ putPackStream fs
+
+pretty :: PackStream -> Text
+pretty = prettyStruct genericStructName
+
+prettyStruct :: (Word8 -> Text) -> PackStream -> Text
+prettyStruct _  Null           = "null"
+prettyStruct _  (Bool True)    = "true"
+prettyStruct _  (Bool False)   = "false"
+prettyStruct _  (Int i)        = T.pack (show i)
+prettyStruct _  (Float d)      = T.pack (show d)
+prettyStruct _  (String t)     = "\"" <> t <> "\""
+prettyStruct _  (List xs)      = "[" <> T.intercalate ", " (pretty <$> V.toList xs) <> "]"
+prettyStruct _  (Map ps)       = "{" <> T.intercalate ", " (fmap (\(k, v) -> pretty k <> ": " <> pretty v) (HM.toList ps)) <> "}"
+prettyStruct sn (Struct s fs)  = sn s <> "{" <> T.intercalate ", " (pretty <$> fs) <> "}"
+
+genericStructName :: Word8 -> Text
+genericStructName n = "Struct(signature=" <> T.pack (printf "0x%02x" n) <> ")"
+
+(.=) :: ToPackStream a => Text -> a -> (PackStream, PackStream)
+k .= v = (String k, toPackStream v)
+
+(.:) :: FromPackStream a => HM.HashMap PackStream PackStream -> Text -> Parser a
+m .: k = maybe (parsefail "Expected Key missing in map") parsePackStream (HM.lookup (String k) m)
+
+(.:?) :: FromPackStream a => HM.HashMap PackStream PackStream -> Text -> Parser (Maybe a)
+m .:? k = maybe (return Nothing) (fmap Just . parsePackStream) (HM.lookup (String k) m)
+
+(.!=) :: Parser (Maybe a) -> a -> Parser a
+p .!= d = do
+    ma <- p
+    maybe (return d) return ma

@@ -1,39 +1,39 @@-module Database.Bolt.Exception-    ( internalErr-    , transportErr-    , protocolErr-    , authFail-    , reqFail-    , reqIgnore-    ) where--import           Control.Exception-import           Data.Text         (Text)--data BoltException = AuthenticationFailure Text-                   | RequestFailure Text-                   | RequestIgnored Text-                   | InternalError Text-                   | TransportError Text-                   | ProtocolError Text-    deriving (Show)--instance Exception BoltException--authFail :: Text -> IO a-authFail = throwIO . AuthenticationFailure--reqFail :: Text -> IO a-reqFail = throwIO . RequestFailure--reqIgnore :: Text -> IO a-reqIgnore = throwIO . RequestIgnored--internalErr :: Text -> IO a-internalErr = throwIO . InternalError--transportErr :: Text -> IO a-transportErr = throwIO . TransportError--protocolErr :: Text -> IO a-protocolErr = throwIO . ProtocolError+module Database.Bolt.Exception
+    ( internalErr
+    , transportErr
+    , protocolErr
+    , authFail
+    , reqFail
+    , reqIgnore
+    ) where
+
+import           Control.Exception
+import           Data.Text         (Text)
+
+data BoltException = AuthenticationFailure Text
+                   | RequestFailure Text
+                   | RequestIgnored Text
+                   | InternalError Text
+                   | TransportError Text
+                   | ProtocolError Text
+    deriving (Show)
+
+instance Exception BoltException
+
+authFail :: Text -> IO a
+authFail = throwIO . AuthenticationFailure
+
+reqFail :: Text -> IO a
+reqFail = throwIO . RequestFailure
+
+reqIgnore :: Text -> IO a
+reqIgnore = throwIO . RequestIgnored
+
+internalErr :: Text -> IO a
+internalErr = throwIO . InternalError
+
+transportErr :: Text -> IO a
+transportErr = throwIO . TransportError
+
+protocolErr :: Text -> IO a
+protocolErr = throwIO . ProtocolError

@@ -1,29 +1,37 @@-{-# LANGUAGE OverloadedStrings #-}--module Database.Bolt.Protocol.Ver1- ( init- , exec- , AuthToken(..)- , open- ) where--import           Prelude                    hiding (init)-import           Control.Monad--import           Database.Bolt.Exception-import           Database.Bolt.Protocol.Ver1.Message (AuthToken(..))-import           Database.Bolt.Protocol.Ver1.Request (init, exec)-import           Database.Bolt.Protocol.Ver1.Types-import           Database.Bolt.Transport--useragent :: UserAgent-useragent = "haskell-bolt/0.0"--open :: Transport t => (a -> IO t) -> a -> AuthToken -> IO t-open c a auth = do-    conn <- c a-    agreed <- handshake conn (OfferProtocols 1 noProto noProto noProto)-    unless (agreed == 1) $-        protocolErr "Can't negotiate protocol version"-    init conn useragent auth-    return conn+{-# LANGUAGE OverloadedStrings #-}
+
+module Database.Bolt.Protocol.Ver1
+ ( init
+ , exec
+ , AuthToken(..)
+ , open
+ , Transaction
+ , runTransaction
+ , cypher
+ , object
+ , (#=)
+ , (#:)
+ , (#:?)
+ ) where
+
+import           Control.Monad
+import           Prelude                                 hiding (init)
+
+import           Database.Bolt.Exception
+import           Database.Bolt.Protocol.Ver1.Message     (AuthToken (..))
+import           Database.Bolt.Protocol.Ver1.Request     (exec, init)
+import           Database.Bolt.Protocol.Ver1.Transaction (Transaction, cypher, runTransaction)
+import           Database.Bolt.Protocol.Ver1.Types
+import           Database.Bolt.Transport
+
+useragent :: UserAgent
+useragent = "haskell-bolt/0.0"
+
+open :: Transport t => (a -> IO t) -> a -> AuthToken -> IO t
+open c a auth = do
+    conn <- c a
+    agreed <- handshake conn (OfferProtocols 1 noProto noProto noProto)
+    unless (agreed == 1) $
+        protocolErr "Can't negotiate protocol version"
+    init conn useragent auth
+    return conn

@@ -1,82 +1,82 @@-{-# LANGUAGE OverloadedStrings #-}--module Database.Bolt.Protocol.Ver1.Graph- ( Node(..)- , Relationship(..)- , Path(..)- , UnboundedRelationship(..)- )-where--import           Data.Int-import           Data.PackStream--import           Database.Bolt.Protocol.Ver1.Types--data Node = Node-    { nodeIdentity      :: Identity-    , nodeLabels        :: [Label]-    , nodeProperties    :: Properties-    } deriving (Show, Eq)--data Relationship = Relationship-    { relIdentity       :: Identity-    , startNodeIdentity :: Identity-    , endNodeIdentity   :: Identity-    , relType           :: Type-    , relProperties     :: Properties-    } deriving (Show, Eq)--data Path = Path-    { pathNodes         :: [Node]-    , pathRelationships :: [UnboundedRelationship]-    , pathSequence      :: [Int64]-    } deriving (Show, Eq)--data UnboundedRelationship = UnboundedRelationship-    { urelIdentity      :: Identity-    , urelType          :: Type-    , urelProperties    :: Properties-    } deriving (Show, Eq)--instance ToPackStream Node where-    toPackStream (Node nodeid labels props) = Struct 0x4e [toPackStream nodeid, toPackStream labels, toPackStream props]--instance FromPackStream Node where-    parsePackStream s = do-        struct <- parsePackStream s-        case struct of-            (Struct 0x4e [nodeid, labels, props]) -> Node <$> parsePackStream nodeid <*> parsePackStream labels <*> parsePackStream props-            _                                     -> error "Invalid Node"--instance ToPackStream Relationship where-    toPackStream (Relationship relid start end ty props) = Struct 0x52 [ toPackStream relid, toPackStream start, toPackStream end-                                                                       , toPackStream ty, toPackStream props ]--instance FromPackStream Relationship where-    parsePackStream s = do-        struct <- parsePackStream s-        case struct of-            (Struct 0x52 [relid, start, end, ty, props]) -> Relationship <$> parsePackStream relid <*> parsePackStream start <*> parsePackStream end-                                                                         <*> parsePackStream ty <*> parsePackStream props-            _                                            -> error "Invalid Relationship"--instance ToPackStream Path where-    toPackStream (Path nodes rels seqn) = Struct 0x50 [ toPackStream nodes, toPackStream rels, toPackStream seqn]--instance FromPackStream Path where-    parsePackStream s = do-        struct <- parsePackStream s-        case struct of-            (Struct 0x50 [nodes, rels, seqn]) -> Path <$> parsePackStream nodes <*> parsePackStream rels <*> parsePackStream seqn-            _                                 -> error "Invalid Path"--instance ToPackStream UnboundedRelationship where-    toPackStream (UnboundedRelationship relid ty props) = Struct 0x72 [toPackStream relid, toPackStream ty, toPackStream props]--instance FromPackStream UnboundedRelationship where-    parsePackStream s = do-        struct <- parsePackStream s-        case struct of-            (Struct 0x72 [relid, ty, props]) -> UnboundedRelationship <$> parsePackStream relid <*> parsePackStream ty <*> parsePackStream props-            _                                -> error "Invalid UnboundedRelationship"+{-# LANGUAGE OverloadedStrings #-}
+
+module Database.Bolt.Protocol.Ver1.Graph
+ ( Node(..)
+ , Relationship(..)
+ , Path(..)
+ , UnboundedRelationship(..)
+ )
+where
+
+import           Data.Int
+import           Data.PackStream
+
+import           Database.Bolt.Protocol.Ver1.Types
+
+data Node = Node
+    { nodeIdentity      :: Identity
+    , nodeLabels        :: [Label]
+    , nodeProperties    :: Properties
+    } deriving (Show, Eq)
+
+data Relationship = Relationship
+    { relIdentity       :: Identity
+    , startNodeIdentity :: Identity
+    , endNodeIdentity   :: Identity
+    , relType           :: Type
+    , relProperties     :: Properties
+    } deriving (Show, Eq)
+
+data Path = Path
+    { pathNodes         :: [Node]
+    , pathRelationships :: [UnboundedRelationship]
+    , pathSequence      :: [Int64]
+    } deriving (Show, Eq)
+
+data UnboundedRelationship = UnboundedRelationship
+    { urelIdentity      :: Identity
+    , urelType          :: Type
+    , urelProperties    :: Properties
+    } deriving (Show, Eq)
+
+instance ToPackStream Node where
+    toPackStream (Node nodeid labels props) = Struct 0x4e [toPackStream nodeid, toPackStream labels, toPackStream props]
+
+instance FromPackStream Node where
+    parsePackStream s = do
+        struct <- parsePackStream s
+        case struct of
+            (Struct 0x4e [nodeid, labels, props]) -> Node <$> parsePackStream nodeid <*> parsePackStream labels <*> parsePackStream props
+            _                                     -> error "Invalid Node"
+
+instance ToPackStream Relationship where
+    toPackStream (Relationship relid start end ty props) = Struct 0x52 [ toPackStream relid, toPackStream start, toPackStream end
+                                                                       , toPackStream ty, toPackStream props ]
+
+instance FromPackStream Relationship where
+    parsePackStream s = do
+        struct <- parsePackStream s
+        case struct of
+            (Struct 0x52 [relid, start, end, ty, props]) -> Relationship <$> parsePackStream relid <*> parsePackStream start <*> parsePackStream end
+                                                                         <*> parsePackStream ty <*> parsePackStream props
+            _                                            -> error "Invalid Relationship"
+
+instance ToPackStream Path where
+    toPackStream (Path nodes rels seqn) = Struct 0x50 [ toPackStream nodes, toPackStream rels, toPackStream seqn]
+
+instance FromPackStream Path where
+    parsePackStream s = do
+        struct <- parsePackStream s
+        case struct of
+            (Struct 0x50 [nodes, rels, seqn]) -> Path <$> parsePackStream nodes <*> parsePackStream rels <*> parsePackStream seqn
+            _                                 -> error "Invalid Path"
+
+instance ToPackStream UnboundedRelationship where
+    toPackStream (UnboundedRelationship relid ty props) = Struct 0x72 [toPackStream relid, toPackStream ty, toPackStream props]
+
+instance FromPackStream UnboundedRelationship where
+    parsePackStream s = do
+        struct <- parsePackStream s
+        case struct of
+            (Struct 0x72 [relid, ty, props]) -> UnboundedRelationship <$> parsePackStream relid <*> parsePackStream ty <*> parsePackStream props
+            _                                -> error "Invalid UnboundedRelationship"

@@ -1,77 +1,77 @@-{-# LANGUAGE OverloadedStrings #-}--module Database.Bolt.Protocol.Ver1.Message- ( Message(..)- , AuthToken(..)- )-where--import qualified Data.HashMap.Strict               as HM-import           Data.PackStream-import           Data.Text                         (Text)--import           Database.Bolt.Protocol.Ver1.Types--data Message = Init UserAgent AuthToken-             | AckFailure-             | Reset-             | Run Statement Parameters-             | DiscardAll-             | PullAll-             | Success Metadata-             | Ignored Metadata-             | Failure Metadata-             | Record Record-    deriving (Show)--instance ToPackStream Message where-    toPackStream (Init useragent authtoken) = Struct 0x01 [toPackStream useragent, toPackStream authtoken]-    toPackStream AckFailure                 = Struct 0x0e []-    toPackStream Reset                      = Struct 0x0f []-    toPackStream (Run stmt params)          = Struct 0x10 [toPackStream stmt, toPackStream params]-    toPackStream DiscardAll                 = Struct 0x2f []-    toPackStream PullAll                    = Struct 0x3f []-    toPackStream (Success metadata)         = Struct 0x70 [toPackStream metadata]-    toPackStream (Ignored metadata)         = Struct 0x71 [toPackStream metadata]-    toPackStream (Failure metadata)         = Struct 0x7e [toPackStream metadata]-    toPackStream (Record  record)           = Struct 0x7f record--instance FromPackStream Message where-    parsePackStream s = do-        struct <- parsePackStream s-        case struct of-            (Struct 0x01 [useragent, authtoken]) -> Init <$> parsePackStream useragent <*> parsePackStream authtoken-            (Struct 0x0e [])                     -> return AckFailure-            (Struct 0x0f [])                     -> return Reset-            (Struct 0x10 [stmt, params])         -> Run <$> parsePackStream stmt <*> parsePackStream params-            (Struct 0x2f [])                     -> return DiscardAll-            (Struct 0x3f [])                     -> return PullAll-            (Struct 0x70 [metadata])             -> Success <$> parsePackStream metadata-            (Struct 0x71 value)                  -> return $ Record  value-            (Struct 0x7e [metadata])             -> Ignored <$> parsePackStream metadata-            (Struct 0x7f [metadata])             -> Failure <$> parsePackStream metadata-            _                                    -> error "Invalid Message"--data AuthToken = NoAuth-               | Basic Principal Credentials-    deriving (Show)--instance ToPackStream AuthToken where-    toPackStream NoAuth            = Map $ HM.fromList [ "scheme"      .= ("none"  :: Text) ]-    toPackStream (Basic user pass) = Map $ HM.fromList [ "scheme"      .= ("basic" :: Text)-                                                       , "principal"   .= user-                                                       , "credentials" .= pass-                                                       ]--instance FromPackStream AuthToken where-    parsePackStream (Map m) = do-        scheme <- m .:? "scheme" .!= "none"-        parseScheme scheme-      where-        parseScheme :: Text -> Parser AuthToken-        parseScheme "none"  = return NoAuth-        parseScheme "basic" = Basic <$> m .: "principal"-                                    <*> m .: "credentials"-        parseScheme _       = error "Unknown authentication scheme"--    parsePackStream _ = error "AuthToken should be a map"+{-# LANGUAGE OverloadedStrings #-}
+
+module Database.Bolt.Protocol.Ver1.Message
+ ( Message(..)
+ , AuthToken(..)
+ )
+where
+
+import qualified Data.HashMap.Strict               as HM
+import           Data.PackStream
+import           Data.Text                         (Text)
+
+import           Database.Bolt.Protocol.Ver1.Types
+
+data Message = Init UserAgent AuthToken
+             | AckFailure
+             | Reset
+             | Run Statement Parameters
+             | DiscardAll
+             | PullAll
+             | Success Metadata
+             | Ignored Metadata
+             | Failure Metadata
+             | Record Record
+    deriving (Show)
+
+instance ToPackStream Message where
+    toPackStream (Init useragent authtoken) = Struct 0x01 [toPackStream useragent, toPackStream authtoken]
+    toPackStream AckFailure                 = Struct 0x0e []
+    toPackStream Reset                      = Struct 0x0f []
+    toPackStream (Run stmt params)          = Struct 0x10 [toPackStream stmt, toPackStream params]
+    toPackStream DiscardAll                 = Struct 0x2f []
+    toPackStream PullAll                    = Struct 0x3f []
+    toPackStream (Success metadata)         = Struct 0x70 [toPackStream metadata]
+    toPackStream (Ignored metadata)         = Struct 0x71 [toPackStream metadata]
+    toPackStream (Failure metadata)         = Struct 0x7e [toPackStream metadata]
+    toPackStream (Record  record)           = Struct 0x7f [toPackStream record]
+
+instance FromPackStream Message where
+    parsePackStream s = do
+        struct <- parsePackStream s
+        case struct of
+            (Struct 0x01 [useragent, authtoken]) -> Init <$> parsePackStream useragent <*> parsePackStream authtoken
+            (Struct 0x0e [])                     -> return AckFailure
+            (Struct 0x0f [])                     -> return Reset
+            (Struct 0x10 [stmt, params])         -> Run <$> parsePackStream stmt <*> parsePackStream params
+            (Struct 0x2f [])                     -> return DiscardAll
+            (Struct 0x3f [])                     -> return PullAll
+            (Struct 0x70 [metadata])             -> Success <$> parsePackStream metadata
+            (Struct 0x71 [record])               -> Record <$> parsePackStream record
+            (Struct 0x7e [metadata])             -> Ignored <$> parsePackStream metadata
+            (Struct 0x7f [metadata])             -> Failure <$> parsePackStream metadata
+            _                                    -> error "Invalid Message"
+
+data AuthToken = NoAuth
+               | Basic Principal Credentials
+    deriving (Show)
+
+instance ToPackStream AuthToken where
+    toPackStream NoAuth            = Map $ HM.fromList [ "scheme"      .= ("none"  :: Text) ]
+    toPackStream (Basic user pass) = Map $ HM.fromList [ "scheme"      .= ("basic" :: Text)
+                                                       , "principal"   .= user
+                                                       , "credentials" .= pass
+                                                       ]
+
+instance FromPackStream AuthToken where
+    parsePackStream (Map m) = do
+        scheme <- m .:? "scheme" .!= "none"
+        parseScheme scheme
+      where
+        parseScheme :: Text -> Parser AuthToken
+        parseScheme "none"  = return NoAuth
+        parseScheme "basic" = Basic <$> m .: "principal"
+                                    <*> m .: "credentials"
+        parseScheme _       = error "Unknown authentication scheme"
+
+    parsePackStream _ = error "AuthToken should be a map"

@@ -1,30 +1,30 @@-{-# LANGUAGE OverloadedStrings #-}--module Database.Bolt.Protocol.Ver1.Pretty- ( pretty- , structName- ) where--import           Data.PackStream (PackStream, genericStructName, prettyStruct)-import           Data.Text-import           Data.Word--pretty :: PackStream -> Text-pretty = prettyStruct structName--structName :: Word8 -> Text-structName 0x01 = "InitMessage"-structName 0x0e = "AckFailureMessage"-structName 0x0f = "ResetMessage"-structName 0x10 = "RunMessage"-structName 0x2f = "DiscardAllMessage"-structName 0x3f = "PullAllMessage"-structName 0x43 = "Node"-structName 0x50 = "Path"-structName 0x52 = "Relationship"-structName 0x70 = "SuccessMessage"-structName 0x71 = "RecordMessage"-structName 0x72 = "UnboundedRelationship"-structName 0x7e = "IgnoredMessage"-structName 0x7f = "FailureMessage"-structName n    = genericStructName n+{-# LANGUAGE OverloadedStrings #-}
+
+module Database.Bolt.Protocol.Ver1.Pretty
+ ( pretty
+ , structName
+ ) where
+
+import           Data.PackStream (PackStream, genericStructName, prettyStruct)
+import           Data.Text
+import           Data.Word
+
+pretty :: PackStream -> Text
+pretty = prettyStruct structName
+
+structName :: Word8 -> Text
+structName 0x01 = "InitMessage"
+structName 0x0e = "AckFailureMessage"
+structName 0x0f = "ResetMessage"
+structName 0x10 = "RunMessage"
+structName 0x2f = "DiscardAllMessage"
+structName 0x3f = "PullAllMessage"
+structName 0x4e = "Node"
+structName 0x50 = "Path"
+structName 0x52 = "Relationship"
+structName 0x70 = "SuccessMessage"
+structName 0x71 = "RecordMessage"
+structName 0x72 = "UnboundedRelationship"
+structName 0x7e = "IgnoredMessage"
+structName 0x7f = "FailureMessage"
+structName n    = genericStructName n

@@ -1,74 +1,74 @@-{-# LANGUAGE OverloadedStrings #-}--module Database.Bolt.Protocol.Ver1.Request- ( init- , reset- , discardAll- , pullAll- , run- , exec- ) where--import           Prelude                             hiding (init)--import           Database.Bolt.Exception-import           Database.Bolt.Protocol.Ver1.Message (AuthToken, Message)-import qualified Database.Bolt.Protocol.Ver1.Message as Msg-import           Database.Bolt.Protocol.Ver1.Types-import           Database.Bolt.Transport-import           Database.Bolt.Transport.Message--data Response = Success [Record]-              | Failed-              | Ignored--request :: Transport t => t -> Message -> IO Response-request conn msg = do-    sendmsg conn msg-    gather []-  where-    gather vals = do-        reply <- recvmsg conn-        case reply of-            Msg.Success _meta -> return $ Success (reverse vals)-            Msg.Failure _meta -> return Failed-            Msg.Ignored _meta -> return Ignored-            Msg.Record  val   -> gather (val : vals)-            _                 -> protocolErr "Unexpected message in response"--simple :: Transport t => t -> Message -> IO ()-simple conn msg = do-    resp <- request conn msg-    case resp of-        Success [] -> return ()-        Success _  -> reqFail   "Request not expecting records"-        Failed     -> reqFail   "Request failed"-        Ignored    -> reqIgnore "Request ignored"--detail :: Transport t => t -> Message -> IO [Record]-detail conn msg = do-    resp <- request conn msg-    case resp of-        Success rs -> return rs-        Failed     -> reqFail   "Request failed"-        Ignored    -> reqIgnore "Request ignored"--init :: Transport t => t -> UserAgent -> AuthToken -> IO ()-init conn agent auth = simple conn $ Msg.Init agent auth--reset :: Transport t => t -> IO ()-reset conn = simple conn Msg.Reset--discardAll :: Transport t => t -> IO ()-discardAll conn = simple conn Msg.DiscardAll--pullAll :: Transport t => t -> IO [Record]-pullAll conn = detail conn Msg.PullAll--run :: Transport t => t -> Statement -> Parameters -> IO ()-run conn stmt params = simple conn $ Msg.Run stmt params--exec :: Transport t => t -> Statement -> Parameters -> IO [Record]-exec conn stmt params = do-    run conn stmt params-    pullAll conn+{-# LANGUAGE OverloadedStrings #-}
+
+module Database.Bolt.Protocol.Ver1.Request
+ ( init
+ , reset
+ , discardAll
+ , pullAll
+ , run
+ , exec
+ ) where
+
+import           Prelude                             hiding (init)
+
+import           Database.Bolt.Exception
+import           Database.Bolt.Protocol.Ver1.Message (AuthToken, Message)
+import qualified Database.Bolt.Protocol.Ver1.Message as Msg
+import           Database.Bolt.Protocol.Ver1.Types
+import           Database.Bolt.Transport
+import           Database.Bolt.Transport.Message
+
+data Response = Success [Record]
+              | Failed
+              | Ignored
+
+request :: Transport t => t -> Message -> IO Response
+request conn msg = do
+    sendmsg conn msg
+    gather []
+  where
+    gather vals = do
+        reply <- recvmsg conn
+        case reply of
+            Msg.Success _meta -> return $ Success (reverse vals)
+            Msg.Failure _meta -> return Failed
+            Msg.Ignored _meta -> return Ignored
+            Msg.Record  val   -> gather (val : vals)
+            _                 -> protocolErr "Unexpected message in response"
+
+simple :: Transport t => t -> Message -> IO ()
+simple conn msg = do
+    resp <- request conn msg
+    case resp of
+        Success [] -> return ()
+        Success _  -> reqFail   "Request not expecting records"
+        Failed     -> reqFail   "Request failed"
+        Ignored    -> reqIgnore "Request ignored"
+
+detail :: Transport t => t -> Message -> IO [Record]
+detail conn msg = do
+    resp <- request conn msg
+    case resp of
+        Success rs -> return rs
+        Failed     -> reqFail   "Request failed"
+        Ignored    -> reqIgnore "Request ignored"
+
+init :: Transport t => t -> UserAgent -> AuthToken -> IO ()
+init conn agent auth = simple conn $ Msg.Init agent auth
+
+reset :: Transport t => t -> IO ()
+reset conn = simple conn Msg.Reset
+
+discardAll :: Transport t => t -> IO ()
+discardAll conn = simple conn Msg.DiscardAll
+
+pullAll :: Transport t => t -> IO [Record]
+pullAll conn = detail conn Msg.PullAll
+
+run :: Transport t => t -> Statement -> Parameters -> IO ()
+run conn stmt params = simple conn $ Msg.Run stmt params
+
+exec :: Transport t => t -> Statement -> Parameters -> IO [Record]
+exec conn stmt params = do
+    run conn stmt params
+    pullAll conn

@@ -0,0 +1,43 @@+{-# LANGUAGE Rank2Types                 #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings          #-}
+
+module Database.Bolt.Protocol.Ver1.Transaction
+ ( Transaction
+ , runTransaction
+ , cypher
+ ) where
+
+import           Control.Exception
+import           Control.Monad.IO.Class
+import           Control.Monad.Trans.Reader
+-- import           Database.Bolt.Exception
+import qualified Data.HashMap.Strict                 as HM
+import           Database.Bolt.Protocol.Ver1.Request
+import           Database.Bolt.Protocol.Ver1.Types
+import           Database.Bolt.Transport
+
+newtype Tran t a = Tran { unTransaction :: ReaderT t IO a }
+    deriving (Functor, Applicative, Monad, MonadIO)
+
+type Transaction a = forall t. Transport t => Tran t a
+
+runTransaction :: Transport t => t -> Transaction a -> IO a
+runTransaction conn t = do
+    _ <- exec conn "BEGIN" HM.empty
+    r <- try $ runReaderT (unTransaction t) conn
+    case r of
+        Left (SomeException ex) -> do
+            _ <- exec conn "ROLLBACK" HM.empty
+            throwIO ex
+        Right a -> do
+            _ <- exec conn "COMMIT" HM.empty
+            return a
+
+getConn :: Tran t t
+getConn = Tran ask
+
+cypher :: Statement -> Parameters -> Transaction [Record]
+cypher stmt params = do
+    conn <- getConn
+    liftIO $ exec conn stmt params

@@ -1,20 +1,33 @@-module Database.Bolt.Protocol.Ver1.Types where--import           Data.Int-import qualified Data.HashMap.Strict as HM-import           Data.PackStream-import           Data.Text           (Text)--type UserAgent   = Text-type Principal   = Text-type Credentials = Text-type Statement   = Text-type Label       = Text-type Type        = Text-type Identity    = Int64--type Object      = HM.HashMap Text PackStream-type Parameters  = Object-type Properties  = Object-type Metadata    = Object-type Record      = [PackStream]+module Database.Bolt.Protocol.Ver1.Types where
+
+import           Data.Int
+import           Data.Hashable
+import qualified Data.HashMap.Strict as HM
+import           Data.PackStream
+import           Data.Text           (Text)
+
+type UserAgent   = Text
+type Principal   = Text
+type Credentials = Text
+type Statement   = Text
+type Label       = Text
+type Type        = Text
+type Identity    = Int64
+
+type Object      = HM.HashMap Text PackStream
+type Parameters  = Object
+type Properties  = Object
+type Metadata    = Object
+type Record      = [PackStream]
+
+object :: (Eq k, Hashable k) => [(k, v)] -> HM.HashMap k v
+object = HM.fromList
+
+(#=) :: ToPackStream a => Text -> a -> (Text, PackStream)
+k #= v = (k, toPackStream v)
+
+(#:) :: FromPackStream a => Object -> Text -> Parser a
+m #: k = maybe (parsefail "Expected Key missing in object") parsePackStream (HM.lookup k m)
+
+(#:?) :: FromPackStream a => Object -> Text -> Parser (Maybe a)
+m #:? k = maybe (return Nothing) (fmap Just . parsePackStream) (HM.lookup k m)

@@ -1,68 +1,68 @@-{-# LANGUAGE OverloadedStrings #-}--module Database.Bolt.Transport-    ( Transport(..)-    , put-    , get-    , getE-    , handshake-    , BoltProtocol-    , OfferProtocols(..)-    , noProto-    ) where--import qualified Data.ByteString         as BS-import           Data.Monoid-import           Data.Serialize.Get-import           Data.Serialize.Put-import           Data.Text               as T-import           Data.Word--import           Database.Bolt.Exception---- Transport--class Transport t where-    send :: t -> BS.ByteString -> IO ()-    recv :: t -> Int -> IO BS.ByteString-    close :: t -> IO ()--    sendMany :: t -> [BS.ByteString] -> IO ()-    sendMany conn = mapM_ (send conn)--put :: Transport t => t -> Put -> IO ()-put conn = send conn . runPut--get :: Transport t => t -> Int -> Get a -> IO a-get conn n g = getE conn n g >>= either bad return-  where-    bad e = transportErr $ "Bad data received: " <> T.pack e--getE :: Transport t => t -> Int -> Get a -> IO (Either String a)-getE conn n g = runGet g <$> recv conn n---- Protocol negotiation--type BoltProtocol = Word32--noProto :: BoltProtocol-noProto = 0--data OfferProtocols = OfferProtocols BoltProtocol BoltProtocol BoltProtocol BoltProtocol-    deriving (Show, Eq, Ord)--handshake :: Transport t => t -> OfferProtocols -> IO BoltProtocol-handshake conn offer = do-    put conn (gogobolt >> offerProtocols offer)-    get conn 4 agreedProtocol--gogobolt :: Put-gogobolt = mapM_ putWord8 [0x60, 0x60, 0xb0, 0x17]--offerProtocols :: Putter OfferProtocols-offerProtocols (OfferProtocols p1 p2 p3 p4) = mapM_ offerProtocol [p1, p2, p3, p4]-  where-    offerProtocol = putWord32be--agreedProtocol :: Get BoltProtocol-agreedProtocol = getWord32be+{-# LANGUAGE OverloadedStrings #-}
+
+module Database.Bolt.Transport
+    ( Transport(..)
+    , put
+    , get
+    , getE
+    , handshake
+    , BoltProtocol
+    , OfferProtocols(..)
+    , noProto
+    ) where
+
+import qualified Data.ByteString         as BS
+import           Data.Monoid
+import           Data.Serialize.Get
+import           Data.Serialize.Put
+import           Data.Text               as T
+import           Data.Word
+
+import           Database.Bolt.Exception
+
+-- Transport
+
+class Transport t where
+    send :: t -> BS.ByteString -> IO ()
+    recv :: t -> Int -> IO BS.ByteString
+    close :: t -> IO ()
+
+    sendMany :: t -> [BS.ByteString] -> IO ()
+    sendMany conn = mapM_ (send conn)
+
+put :: Transport t => t -> Put -> IO ()
+put conn = send conn . runPut
+
+get :: Transport t => t -> Int -> Get a -> IO a
+get conn n g = getE conn n g >>= either bad return
+  where
+    bad e = transportErr $ "Bad data received: " <> T.pack e
+
+getE :: Transport t => t -> Int -> Get a -> IO (Either String a)
+getE conn n g = runGet g <$> recv conn n
+
+-- Protocol negotiation
+
+type BoltProtocol = Word32
+
+noProto :: BoltProtocol
+noProto = 0
+
+data OfferProtocols = OfferProtocols BoltProtocol BoltProtocol BoltProtocol BoltProtocol
+    deriving (Show, Eq, Ord)
+
+handshake :: Transport t => t -> OfferProtocols -> IO BoltProtocol
+handshake conn offer = do
+    put conn (gogobolt >> offerProtocols offer)
+    get conn 4 agreedProtocol
+
+gogobolt :: Put
+gogobolt = mapM_ putWord8 [0x60, 0x60, 0xb0, 0x17]
+
+offerProtocols :: Putter OfferProtocols
+offerProtocols (OfferProtocols p1 p2 p3 p4) = mapM_ offerProtocol [p1, p2, p3, p4]
+  where
+    offerProtocol = putWord32be
+
+agreedProtocol :: Get BoltProtocol
+agreedProtocol = getWord32be

@@ -1,73 +1,73 @@-{-# LANGUAGE MultiWayIf        #-}-{-# LANGUAGE OverloadedStrings #-}--module Database.Bolt.Transport.Chunked-    ( send-    , recv-    , put-    , get-    ) where--import qualified Data.ByteString         as BS-import qualified Data.ByteString.Lazy    as LBS-import           Data.Monoid-import           Data.Serialize.Get-import           Data.Serialize.Put-import qualified Data.Text               as T--import           Database.Bolt.Exception-import           Database.Bolt.Transport (Transport)-import qualified Database.Bolt.Transport as Trans---------- Chunked I/O ----------send :: Transport t => t -> LBS.ByteString -> IO ()-send conn lbs = Trans.put conn $ mapM_ putChunks (LBS.toChunks lbs) >> done-  where-    maxChunk = 0xffff--    done = putWord16be 0--    putChunks bs = do-        let sz = BS.length bs-        if | sz == 0       -> return ()-           | sz > maxChunk -> split bs-           | otherwise     -> sendChunk bs--    split bs = do-        let (bs1, bs2) = BS.splitAt maxChunk bs-        sendChunk bs1-        putChunks bs2--    sendChunk bs = do-        putWord16be $ fromIntegral $ BS.length bs-        putByteString bs--recv :: Transport t => t -> IO LBS.ByteString-recv conn = LBS.fromChunks <$> getChunks-  where-    getChunks = do-        size <- Trans.get conn 2 getWord16be-        case size of-            0   -> return []-            csz -> do bs  <- getChunk csz-                      bs' <- getChunks-                      return (bs ++ bs')--    getChunk n = do-        bs <- Trans.recv conn (fromIntegral n)-        let sz = fromIntegral $ BS.length bs-        if | sz == 0   -> transportErr "Unexpected end of stream"-           | sz < n    -> do bs' <- getChunk (n - sz)-                             return (bs : bs')-           | otherwise -> return [bs]--put :: Transport t => t -> Put -> IO ()-put conn = send conn . runPutLazy--get :: Transport t => t -> Get a -> IO a-get conn g = do-    lbs <- recv conn-    case runGetLazy g lbs of-        Left err -> transportErr $ "Unexpected data received: " <> T.pack err-        Right a  -> return a+{-# LANGUAGE MultiWayIf        #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Database.Bolt.Transport.Chunked
+    ( send
+    , recv
+    , put
+    , get
+    ) where
+
+import qualified Data.ByteString         as BS
+import qualified Data.ByteString.Lazy    as LBS
+import           Data.Monoid
+import           Data.Serialize.Get
+import           Data.Serialize.Put
+import qualified Data.Text               as T
+
+import           Database.Bolt.Exception
+import           Database.Bolt.Transport (Transport)
+import qualified Database.Bolt.Transport as Trans
+
+-------- Chunked I/O --------
+
+send :: Transport t => t -> LBS.ByteString -> IO ()
+send conn lbs = Trans.put conn $ mapM_ putChunks (LBS.toChunks lbs) >> done
+  where
+    maxChunk = 0xffff
+
+    done = putWord16be 0
+
+    putChunks bs = do
+        let sz = BS.length bs
+        if | sz == 0       -> return ()
+           | sz > maxChunk -> split bs
+           | otherwise     -> sendChunk bs
+
+    split bs = do
+        let (bs1, bs2) = BS.splitAt maxChunk bs
+        sendChunk bs1
+        putChunks bs2
+
+    sendChunk bs = do
+        putWord16be $ fromIntegral $ BS.length bs
+        putByteString bs
+
+recv :: Transport t => t -> IO LBS.ByteString
+recv conn = LBS.fromChunks <$> getChunks
+  where
+    getChunks = do
+        size <- Trans.get conn 2 getWord16be
+        case size of
+            0   -> return []
+            csz -> do bs  <- getChunk csz
+                      bs' <- getChunks
+                      return (bs ++ bs')
+
+    getChunk n = do
+        bs <- Trans.recv conn (fromIntegral n)
+        let sz = fromIntegral $ BS.length bs
+        if | sz == 0   -> transportErr "Unexpected end of stream"
+           | sz < n    -> do bs' <- getChunk (n - sz)
+                             return (bs : bs')
+           | otherwise -> return [bs]
+
+put :: Transport t => t -> Put -> IO ()
+put conn = send conn . runPutLazy
+
+get :: Transport t => t -> Get a -> IO a
+get conn g = do
+    lbs <- recv conn
+    case runGetLazy g lbs of
+        Left err -> transportErr $ "Unexpected data received: " <> T.pack err
+        Right a  -> return a

@@ -1,26 +1,26 @@-{-# LANGUAGE OverloadedStrings #-}--module Database.Bolt.Transport.Message-    ( sendmsg-    , recvmsg-    ) where--import           Data.Monoid-import           Data.PackStream-import qualified Data.Text                       as T--import           Database.Bolt.Exception-import           Database.Bolt.Transport         (Transport)-import qualified Database.Bolt.Transport.Chunked as Chunked---------- Message I/O ----------sendmsg :: (Transport t, ToPackStream a) => t -> a -> IO ()-sendmsg conn = Chunked.put conn . pack--recvmsg :: (Transport t, FromPackStream a) => t -> IO a-recvmsg conn = do-    ma <- Chunked.get conn unpack-    case ma of-        Left e  -> transportErr $ "Couldn't unpack received data: " <> T.pack e-        Right a -> return a+{-# LANGUAGE OverloadedStrings #-}
+
+module Database.Bolt.Transport.Message
+    ( sendmsg
+    , recvmsg
+    ) where
+
+import           Data.Monoid
+import           Data.PackStream
+import qualified Data.Text                       as T
+
+import           Database.Bolt.Exception
+import           Database.Bolt.Transport         (Transport)
+import qualified Database.Bolt.Transport.Chunked as Chunked
+
+-------- Message I/O --------
+
+sendmsg :: (Transport t, ToPackStream a) => t -> a -> IO ()
+sendmsg conn = Chunked.put conn . pack
+
+recvmsg :: (Transport t, FromPackStream a) => t -> IO a
+recvmsg conn = do
+    ma <- Chunked.get conn unpack
+    case ma of
+        Left e  -> transportErr $ "Couldn't unpack received data: " <> T.pack e
+        Right a -> return a

@@ -1,79 +1,79 @@-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE RecordWildCards     #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Database.Bolt.Transport.Socket-    ( ConnInfo-    , hostserv-    , uri--    , Connection-    , connect-    , close--    , send-    , sendMany-    , recv-    , put-    , get-    ) where--import           Control.Exception-import           Control.Monad-import           Data.Monoid-import qualified Data.Text                 as T-import qualified Network.Socket            as Net-import qualified Network.Socket.ByteString as NetBS-import           Network.URI--import           Database.Bolt.Exception-import           Database.Bolt.Transport---------- Socket ----------newtype Connection = Connection { connSocket :: Net.Socket }--instance Transport Connection where-    send     = NetBS.sendAll  . connSocket-    sendMany = NetBS.sendMany . connSocket-    recv     = NetBS.recv     . connSocket-    close    = Net.close      . connSocket--data ConnInfo = ConnInfo-    { connHost    :: Net.HostName-    , connService :: Net.ServiceName-    } deriving (Show, Read, Eq, Ord)---------- Connections ------------ Create ConnInfo from a host and service name-hostserv :: String -> String -> ConnInfo-hostserv = ConnInfo---- Create ConnInfo from a bolt URI-uri :: String -> Maybe ConnInfo-uri uristr = do-    uri' <- parseAbsoluteURI uristr-    guard $ uriScheme    uri' == "bolt"-    auth <- uriAuthority uri'-    guard $ uriUserInfo  auth == ""-    guard $ uriPath      uri' == ""-    guard $ uriQuery     uri' == ""-    guard $ uriFragment  uri' == ""-    return ConnInfo { connHost = uriRegName auth-                    , connService = uriPort auth }---- Connect using ConnInfo and return a handle-connect :: ConnInfo -> IO Connection-connect ConnInfo{..} = do-    let hints = Net.defaultHints { Net.addrSocketType = Net.Stream }-    addrs <- Net.getAddrInfo (Just hints) (Just connHost) (Just connService)-    connectAny addrs-  where-    connectAny []           = transportErr $ "Unable to connect to " <> T.pack connHost <> ":" <> T.pack connService-    connectAny (addr:addrs) = doConnect addr `catch` (\ (_ :: IOException) -> connectAny addrs)--    doConnect addr = do-        sock <- Net.socket (Net.addrFamily addr) (Net.addrSocketType addr) (Net.addrProtocol addr)-        Net.connect sock (Net.addrAddress addr) `onException` Net.close sock-        return $ Connection sock+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE RecordWildCards     #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Database.Bolt.Transport.Socket
+    ( ConnInfo
+    , hostserv
+    , uri
+
+    , Connection
+    , connect
+    , close
+
+    , send
+    , sendMany
+    , recv
+    , put
+    , get
+    ) where
+
+import           Control.Exception
+import           Control.Monad
+import           Data.Monoid
+import qualified Data.Text                 as T
+import qualified Network.Socket            as Net
+import qualified Network.Socket.ByteString as NetBS
+import           Network.URI
+
+import           Database.Bolt.Exception
+import           Database.Bolt.Transport
+
+-------- Socket --------
+
+newtype Connection = Connection { connSocket :: Net.Socket }
+
+instance Transport Connection where
+    send     = NetBS.sendAll  . connSocket
+    sendMany = NetBS.sendMany . connSocket
+    recv     = NetBS.recv     . connSocket
+    close    = Net.close      . connSocket
+
+data ConnInfo = ConnInfo
+    { connHost    :: Net.HostName
+    , connService :: Net.ServiceName
+    } deriving (Show, Read, Eq, Ord)
+
+-------- Connections --------
+
+-- Create ConnInfo from a host and service name
+hostserv :: String -> String -> ConnInfo
+hostserv = ConnInfo
+
+-- Create ConnInfo from a bolt URI
+uri :: String -> Maybe ConnInfo
+uri uristr = do
+    uri' <- parseAbsoluteURI uristr
+    guard $ uriScheme    uri' == "bolt"
+    auth <- uriAuthority uri'
+    guard $ uriUserInfo  auth == ""
+    guard $ uriPath      uri' == ""
+    guard $ uriQuery     uri' == ""
+    guard $ uriFragment  uri' == ""
+    return ConnInfo { connHost = uriRegName auth
+                    , connService = uriPort auth }
+
+-- Connect using ConnInfo and return a handle
+connect :: ConnInfo -> IO Connection
+connect ConnInfo{..} = do
+    let hints = Net.defaultHints { Net.addrSocketType = Net.Stream }
+    addrs <- Net.getAddrInfo (Just hints) (Just connHost) (Just connService)
+    connectAny addrs
+  where
+    connectAny []           = transportErr $ "Unable to connect to " <> T.pack connHost <> ":" <> T.pack connService
+    connectAny (addr:addrs) = doConnect addr `catch` (\ (_ :: IOException) -> connectAny addrs)
+
+    doConnect addr = do
+        sock <- Net.socket (Net.addrFamily addr) (Net.addrSocketType addr) (Net.addrProtocol addr)
+        Net.connect sock (Net.addrAddress addr) `onException` Net.close sock
+        return $ Connection sock