mysql-pure 1.0.2 → 1.1.0

raw patch · 11 files changed

+16/−637 lines, 11 filesdep −cerealdep −cereal-conduitdep −conduitdep ~basedep ~binarydep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies removed: cereal, cereal-conduit, conduit, conduit-extra, transformers

Dependency ranges changed: base, binary, bytestring, criterion, io-streams

API changes (from Hackage documentation)

Files

• ChangeLog.md +10/−0
• README.md +0/−1
• mysql-pure.cabal +6/−26
• src/Data/Binary/Parser/Char8.hs +0/−167
• src/System/IO/Streams/Binary.hs +0/−124
• test/Main.hs +0/−4
• test/QC/ByteString.hs +0/−8
• test/QC/Combinator.hs +0/−11
• test/WireStreams.hs +0/−82
• wire-streams-bench/Main.hs +0/−88
• wire-streams-bench/System/IO/Streams/Cereal.hs +0/−126

@@ -1,5 +1,15 @@ # Revision history for mysql-pure +## 1.1.0 -- 2023.08.12 +There was a bunch of stuff unrelated to mysql+which I purged.+If you need any on these go depend on the +respective unmaintained package.+++ Delete module System.IO.Streams.UnixSocket++ Dleete module Data.Binary.Parser.Char8++ Delete module System.IO.Streams.Binary+ ## 1.0.2 -- 2023.08.12  + Bump dependencies, go all into crypton + merge tcp-streams into the package

@@ -5,7 +5,6 @@ It merges in:   + [word24](https://hackage.haskell.org/package/word24)   + [binary-parsers](https://hackage.haskell.org/package/binary-parsers-0.2.4.0)-  + [wirestreams](https://hackage.haskell.org/package/wire-streams)   + [tcp-streams](https://hackage.haskell.org/package/tcp-streams)  this makes maintenance easier.

@@ -1,6 +1,6 @@ cabal-version:      2.2 name:               mysql-pure-version:            1.0.2+version:            1.1.0 synopsis:           pure haskell MySQL driver description:        pure haskell MySQL driver. license:            BSD-3-Clause@@ -45,7 +45,6 @@ library   exposed-modules:     Data.Binary.Parser-    Data.Binary.Parser.Char8     Data.Binary.Parser.Numeric     Data.Binary.Parser.Word8     Data.Connection@@ -65,7 +64,6 @@     Database.MySQL.Protocol.MySQLValue     Database.MySQL.Protocol.Packet     Database.MySQL.TLS-    System.IO.Streams.Binary     System.IO.Streams.TCP     System.IO.Streams.TLS @@ -105,7 +103,11 @@     MultiWayIf     OverloadedStrings -  ghc-options:        -Wall+  ghc-options:+    -Wall -Wincomplete-uni-patterns+    -Wincomplete-record-updates -Widentities -Wredundant-constraints+    -Wcpp-undef -fwarn-tabs -Wpartial-fields+    -Wunused-packages -fenable-th-splice-warnings  test-suite test   type:               exitcode-stdio-1.0@@ -127,7 +129,6 @@     TCPStreams     TextRow     TextRowNew-    WireStreams     Word24    hs-source-dirs:     test@@ -194,27 +195,6 @@   main-is:          Bench.hs   type:             exitcode-stdio-1.0   ghc-options:      -O2--benchmark bench-wirestream-  type:             exitcode-stdio-1.0-  main-is:          Main.hs-  other-modules:    System.IO.Streams.Cereal-  hs-source-dirs:   wire-streams-bench-  default-language: Haskell2010-  build-depends:-    base,-    binary,-    bytestring,-    cereal,-    cereal-conduit,-    conduit,-    conduit-extra,-    criterion >=1.0.2.0,-    io-streams,-    mysql-pure,-    transformers--  ghc-options:      -rtsopts -Wall  benchmark bench24   default-language: Haskell2010

@@ -1,167 +0,0 @@--- |--- Module      :  Data.Binary.Parser.Char8--- Copyright   :  Bryan O'Sullivan 2007-2015, Winterland 2016--- License     :  BSD3------ Maintainer  :  drkoster@qq.com--- Stability   :  experimental--- Portability :  unknown------ This module is intended for parsing text that is--- represented using an 8-bit character set, e.g. ASCII or--- ISO-8859-15.  It /does not/ make any attempt to deal with character--- encodings, multibyte characters, or wide characters.  In--- particular, all attempts to use characters above code point U+00FF--- will give wrong answers.------ Code points below U+0100 are simply translated to and from their--- numeric values, so e.g. the code point U+00A4 becomes the byte--- @0xA4@ (which is the Euro symbol in ISO-8859-15, but the generic--- currency sign in ISO-8859-1).  Haskell 'Char' values above U+00FF--- are truncated, so e.g. U+1D6B7 is truncated to the byte @0xB7@.--module Data.Binary.Parser.Char8 where--import           Control.Applicative-import qualified Data.Binary.Get          as BG-import           Data.Binary.Get.Internal-import qualified Data.Binary.Parser.Word8 as W-import           Data.ByteString          (ByteString)-import qualified Data.ByteString          as B-import           Data.ByteString.Internal (c2w, w2c)-import qualified Data.ByteString.Unsafe   as B-import           Prelude                  hiding (takeWhile)-------------------------------------------------------------------------------------- | Match any char, to perform lookahead. Returns 'Nothing' if end of--- input has been reached. Does not consume any input.----peekMaybe :: Get (Maybe Char)-peekMaybe = fmap w2c <$> W.peekMaybe-{-# INLINE peekMaybe #-}---- | Match any char, to perform lookahead.  Does not consume any--- input, but will fail if end of input has been reached.----peek :: Get Char-peek = w2c <$> W.peek-{-# INLINE peek #-}---- | The parser @satisfy p@ succeeds for any char for which the--- predicate @p@ returns 'True'. Returns the char that is actually--- parsed.----satisfy :: (Char -> Bool) -> Get Char-satisfy p = w2c <$> W.satisfy (p . w2c)-{-# INLINE satisfy #-}---- | The parser @satisfyWith f p@ transforms a char, and succeeds if--- the predicate @p@ returns 'True' on the transformed value. The--- parser returns the transformed char that was parsed.----satisfyWith :: (Char -> a) -> (a -> Bool) -> Get a-satisfyWith f = W.satisfyWith (f . w2c)-{-# INLINE satisfyWith #-}---- | Match a specific character.----char :: Char -> Get ()-char c = W.word8 (c2w c)-{-# INLINE char #-}---- | Match any character.----anyChar :: Get Char-anyChar = w2c <$> BG.getWord8-{-# INLINE anyChar #-}---- | The parser @skipChar p@ succeeds for any char for which the predicate @p@ returns 'True'.----skipChar :: (Char -> Bool) -> Get ()-skipChar p = W.skipWord8 (p . w2c)-{-# INLINE skipChar #-}-------------------------------------------------------------------------------------- | Consume input as long as the predicate returns 'False' or reach the end of input,--- and return the consumed input.----takeTill :: (Char -> Bool) -> Get ByteString-takeTill p = W.takeTill (p . w2c)-{-# INLINE takeTill #-}---- | Consume input as long as the predicate returns 'True' or reach the end of input,--- and return the consumed input.----takeWhile :: (Char -> Bool) -> Get ByteString-takeWhile p = W.takeWhile (p . w2c)-{-# INLINE takeWhile #-}---- Similar to 'takeWhile', but requires the predicate to succeed on at least one char--- of input: it will fail if the predicate never returns 'True' or reach the end of input----takeWhile1 :: (Char -> Bool) -> Get ByteString-takeWhile1 p = W.takeWhile1 (p . w2c)-{-# INLINE takeWhile1 #-}---- | Skip past input for as long as the predicate returns 'True'.----skipWhile :: (Char -> Bool) -> Get ()-skipWhile p = W.skipWhile (p . w2c)-{-# INLINE skipWhile #-}---- | Satisfy a literal string but ignoring case.----stringCI :: ByteString -> Get ByteString-stringCI bs = do-    let l = B.length bs-    ensureN l-    bs' <- B.unsafeTake l <$> get-    if B.map toLower bs' == B.map toLower bs-    then put (B.unsafeDrop l bs') >> return bs'-    else fail "stringCI"-  where-    toLower w | w >= 65 && w <= 90 = w + 32-              | otherwise          = w-{-# INLINE stringCI #-}-------------------------------------------------------------------------------------- | Fast predicate for matching ASCII space characters.------ /Note/: This predicate only gives correct answers for the ASCII--- encoding.  For instance, it does not recognise U+00A0 (non-breaking--- space) as a space character, even though it is a valid ISO-8859-15--- byte. For a Unicode-aware and only slightly slower predicate,--- use 'Data.Char.isSpace'----isSpace :: Char -> Bool-isSpace c = (c == ' ') || ('\t' <= c && c <= '\r')-{-# INLINE isSpace #-}---- | Decimal digit predicate.----isDigit :: Char -> Bool-isDigit c = c >= '0' && c <= '9'-{-# INLINE isDigit #-}---- | Hex digit predicate.----isHexDigit :: Char -> Bool-isHexDigit c = (c >= '0' && c <= '9') || (c >= 'a' && c <= 'f') || (c >= 'A' && c <= 'F')-{-# INLINE isHexDigit #-}---- | A predicate that matches either a space @\' \'@ or horizontal tab--- @\'\\t\'@ character.----isHorizontalSpace :: Char -> Bool-isHorizontalSpace c = c == ' ' || c == '\t'-{-# INLINE isHorizontalSpace #-}---- | A predicate that matches either a carriage return @\'\\r\'@ or--- newline @\'\\n\'@ character.----isEndOfLine :: Char -> Bool-isEndOfLine c = c == '\r' || c == '\n'-{-# INLINE isEndOfLine #-}

@@ -1,124 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE OverloadedStrings  #-}------------------------------------------------------------------------------------- |--- Module      :  Sytem.IO.Streams.Binary--- Copyright   :  Petter Bergman, Winterland--- License     :  BSD3------ Maintainer  :  Winterland--- Stability   :  experimental------ Use binary to encode/decode io-streams.-----------------------------------------------------------------------------------module System.IO.Streams.Binary (-    -- * single element encode/decode-      getFromStream-    , decodeFromStream-    , putToStream-    -- * 'InputStream' encode/decode-    , getInputStream-    , decodeInputStream-    -- * 'OutputStream' encode-    , putOutputStream-    , encodeOutputStream-    -- * exception type-    , DecodeException(..)-    ) where------------------------------------------------------------------------------------import           Control.Exception            (Exception, throwIO)-import           Control.Monad                (unless)-import           Data.Binary                  (Binary, get, put)-import qualified Data.Binary.Parser           as P-import           Data.Binary.Get              (ByteOffset, Decoder(..), Get)-import           Data.Binary.Put              (runPut, Put)-import           Data.ByteString              (ByteString)-import qualified Data.ByteString              as S-import           Data.Typeable                (Typeable)-import           System.IO.Streams            (InputStream, OutputStream)-import qualified System.IO.Streams            as Streams-import           System.IO.Streams.ByteString (writeLazyByteString)-------------------------------------------------------------------------------------- | An Exception raised when binary decoding fails.------ it contains offset information where cereal don't.-data DecodeException = DecodeException ByteString ByteOffset String-  deriving (Typeable)--instance Show DecodeException where-  show (DecodeException buf offset message) =-        "DecodeException\nbuf:" ++ show buf ++ "\noffset:" ++ show offset ++ "\nmessage:" ++ show message--instance Exception DecodeException-------------------------------------------------------------------------------------- | Write an instance of 'Binary' to an 'OutputStream'.-putToStream :: Binary a => Maybe a -> OutputStream ByteString -> IO ()-putToStream Nothing  os = Streams.write Nothing os-putToStream (Just x) os = writeLazyByteString ((runPut . put) x) os-{-# INLINE putToStream #-}-------------------------------------------------------------------------------------- | Take a 'Get' and an 'InputStream' and decode a--- value. Consumes only as much input as necessary to decode the--- value. Unconsumed input will be unread. If there is--- an error while deserializing, a 'DecodeException' is thrown, and--- unconsumed part will be unread. binary decoder use 'Nothing'--- to indicate input end, so EOFs/Nothing will close a binary decoder.--- Examples:------ >>> import qualified System.IO.Streams as Streams--- >>> getFromStream (get :: Get String) =<< Streams.fromLazyByteString (Data.ByteString.Lazy.drop 1 $ runPut $ put "encode me")--- *** Exception: System.IO.Streams.Binary: binary decode exception: offset 16, "not enough bytes"----getFromStream :: Get a -> InputStream ByteString -> IO (Maybe a)-getFromStream g is = Streams.read is >>= maybe (return Nothing) (go . P.parse g)-  where go (Fail s offset message) = do-            unless (S.null s) (Streams.unRead s is)-            throwIO $ DecodeException s offset message-        go (Done s _ x) = do-            unless (S.null s) (Streams.unRead s is)-            return (Just x)-        go (Partial p) = Streams.read is >>= go .  p-{-# INLINE getFromStream #-}---- | typeclass version of 'getFromStream'-decodeFromStream :: Binary a => InputStream ByteString -> IO (Maybe a)-decodeFromStream = getFromStream get-{-# INLINE decodeFromStream #-}-------------------------------------------------------------------------------------- | Convert a stream of individual encoded 'ByteString's to a stream--- of Results. Throws a 'DecodeException' on error.-getInputStream :: Get a -> InputStream ByteString -> IO (InputStream a)-getInputStream g = Streams.makeInputStream . getFromStream g-{-# INLINE getInputStream #-}---- | typeclass version of 'getInputStream'-decodeInputStream :: Binary a => InputStream ByteString -> IO (InputStream a)-decodeInputStream = Streams.makeInputStream . decodeFromStream-{-# INLINE decodeInputStream #-}-------------------------------------------------------------------------------------- | create an 'OutputStream' of serializable values from an 'OutputStream'--- of bytestrings with a 'Putter'.-putOutputStream :: (a -> Put) -> OutputStream ByteString -> IO (OutputStream a)-putOutputStream p os = Streams.makeOutputStream $ \ ma ->-    case ma of Nothing -> Streams.write Nothing os-               Just a -> writeLazyByteString (runPut (p a)) os-{-# INLINE putOutputStream #-}---- | typeclass version of 'putOutputStream'-encodeOutputStream :: Binary a => OutputStream ByteString -> IO (OutputStream a)-encodeOutputStream = putOutputStream put-{-# INLINE encodeOutputStream #-}

@@ -5,7 +5,6 @@ import Test.Tasty (defaultMain, testGroup) import qualified JSON import qualified MysqlTests-import qualified WireStreams import qualified Word24 import qualified TCPStreams @@ -17,9 +16,6 @@         testGroup "bs" ByteString.tests       , testGroup "combinator" Combinator.tests       , testGroup "JSON" jsonTests-      ],-      testGroup "wire-stream" [-         WireStreams.tests       ],       testGroup "mysql" [           -- TODO figure out how to run the tests that need a mysql

@@ -15,7 +15,6 @@ import qualified Data.Scientific as Sci import qualified Data.ByteString.Builder.Scientific as Sci import qualified Data.Binary.Parser as P-import qualified Data.Binary.Parser.Char8 as P8 import qualified Data.ByteString as B import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Char8 as B8@@ -66,12 +65,6 @@ string s t = parseBS (P.string s' *> pure s') (s `L.append` t) === Just s'   where s' = toStrictBS s -stringCI :: ASCII L.ByteString -> ASCII L.ByteString -> Property-stringCI (ASCII s) (ASCII t) =-    parseBS (P8.stringCI up) (s `L.append` t) === Just s'-  where s' = toStrictBS s-        up = B8.map toUpper s'- strings :: L.ByteString -> L.ByteString -> L.ByteString -> Property strings s t u =     parseBS (P.string (toStrictBS s) >> (P.string t' *> pure t')) (L.concat [s,t,u])@@ -171,7 +164,6 @@     , testProperty "skipWord8" skipWord8     , testProperty "skipWhile" skipWhile     , testProperty "string" string-    , testProperty "stringCI" stringCI     , testProperty "strings" strings     , testProperty "take" take     , testProperty "takeCount" takeCount

@@ -12,7 +12,6 @@ import Test.Tasty (TestTree) import Test.Tasty.QuickCheck (testProperty) import Test.QuickCheck-import qualified Data.Binary.Parser.Char8 as C import qualified Data.Binary.Parser as P import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8@@ -36,19 +35,9 @@       mr = parseBS withLookAheadThenConsume $ toLazyBS ys   in isJust mr && fst (fromJust mr) == snd (fromJust mr) -match :: Int -> NonNegative Int -> NonNegative Int -> Repack -> Bool-match n (NonNegative x) (NonNegative y) rs =-    parseBS (P.match parser) (repackBS rs input) == Just (input, n)-  where parser = C.skipWhile (=='x') *> P.signed P.decimal <*-                 C.skipWhile (=='y')-        input = B.concat [-            B8.replicate x 'x', B8.pack (show n), B8.replicate y 'y'-          ]- tests :: [TestTree] tests = [     testProperty "asum" asum   , testProperty "replicateM" replicateM   , testProperty "lookAhead" lookAhead-  , testProperty "match" match   ]

@@ -1,82 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}-module WireStreams ( tests ) where--import           Control.Exception        (catch, evaluate)-import           Data.Binary              (Binary)-import           Data.ByteString          (ByteString)-import qualified Data.ByteString          as S-import           System.IO.Streams        (write)-import           System.IO.Streams.Binary (DecodeException, decodeInputStream,-                                           encodeOutputStream)-import           System.IO.Streams.List   (fromList, outputToList, toList,-                                           writeList)-import           Test.QuickCheck.Monadic  (assert, monadicIO, run)-import           Test.QuickCheck.Property (Property)-import           Test.Tasty-import           Test.Tasty.QuickCheck    (testProperty)----- Using binary-streams, decode from a list of bytestrings-decode :: Binary a => [ByteString] -> IO [a]-decode ss = fromList ss >>= decodeInputStream >>= toList---- Using binary-streams, encode to a list of bytestrings-encode :: Binary a => [a] -> IO [ByteString]-encode xs = outputToList $ \os ->-  do-    bos <- encodeOutputStream os-    writeList xs bos-    write Nothing bos---- Encode something, then decode it and make sure we get the same thing back.-encodeDecodeEq :: (Binary a,Eq a) => [a] -> Property-encodeDecodeEq xs = monadicIO $ do-  xs' <- run go-  assert $ xs == xs'-  where go = encode xs >>= decode---- corrupt something, remove the last byte of the last bytestring-corrupt :: [ByteString] -> [ByteString]-corrupt = reverse . go . reverse-  where go (h:t) = ((S.reverse $ S.drop 1 $ S.reverse h):t)-        go [] = []---- Encode something, corrupt the encoded data, and make sure we get a--- decode error when we try do decode it.-encodeDecodeError :: forall a. (Binary a,Eq a) => [a] -> Property-encodeDecodeError [] = monadicIO $ return ()-encodeDecodeError xs = monadicIO $ do-  run $ catch go $ \(_ :: DecodeException) -> return ()-  where go =-         do-           bList <- encode xs-           (xs' :: [a]) <- decode $ corrupt bList-           evaluate xs'-           fail "decoding succeeded when it should fail"--tests :: TestTree-tests = testGroup "tests" [-         testProperty "encode-decode-equality Int"-         (encodeDecodeEq :: [Int] -> Property),-         testProperty "encode-decode-equality String"-         (encodeDecodeEq :: [String] -> Property),-         testProperty "encode-decode-equality Maybe Int"-         (encodeDecodeEq :: [Maybe Int] -> Property),-         testProperty "encode-decode-equality Either Int String"-         (encodeDecodeEq :: [Either Int String] -> Property),-         testProperty "encode-decode-equality (Int,Int)"-         (encodeDecodeEq :: [(Int,Int)] -> Property),-         testProperty "encode-decode-equality (String,String)"-         (encodeDecodeEq :: [(Int,Int)] -> Property),-         testProperty "encode-decode-error Int"-         (encodeDecodeError :: [Int] -> Property),-         testProperty "encode-decode-error String"-         (encodeDecodeError :: [String] -> Property),-         testProperty "encode-decode-error Maybe Int"-         (encodeDecodeError :: [Maybe Int] -> Property),-         testProperty "encode-decode-error Either Int String"-         (encodeDecodeError :: [Either Int String] -> Property),-         testProperty "encode-decode-error (Int,Int)"-         (encodeDecodeError :: [(Int,Int)] -> Property),-         testProperty "encode-decode-error (String,String)"-         (encodeDecodeError :: [(String,String)] -> Property)]

@@ -1,88 +0,0 @@-{-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE OverloadedStrings #-}--module Main where-----------------------------------------------------------------------------------import           Control.Exception        (evaluate)-import           Control.Monad            (replicateM_)-import           Control.Monad.IO.Class-import           Criterion.Main-import           Data.Binary              (Binary)-import           Data.ByteString          (ByteString)-import qualified Data.ByteString.Lazy     as BL-import           Data.Conduit-import qualified Data.Conduit.Binary      as Conduit-import qualified Data.Conduit.Cereal      as Conduit-import           Data.Serialize           (Serialize)-import           Data.Serialize           (Get, get, put, runPutLazy)-import           GHC.Generics-----------------------------------------------------------------------------------import qualified System.IO.Streams        as Streams-import qualified System.IO.Streams.Binary as Binary-import qualified System.IO.Streams.Cereal as Cereal-----------------------------------------------------------------------------------main :: IO ()-main = do-  let lstring = BL.concat $ map (runPutLazy . put) foos-      foos = map exFoo [0..1000]-      exFoo x = Foo x "oh look, a Foo!"-  defaultMain-    [ bgroup "decode one element wire-streams/cereal" [-         bench "1000 items" $ whnfIO $ benchCS lstring ]-    , bgroup "decode one element wire-streams/binary" [-         bench "1000 items" $ whnfIO $ benchBS lstring ]-    , bgroup "decode one element cereal-conduit" [-         bench "1000 items" $ whnfIO $ benchCC lstring ]-    , bgroup "decode 1000 elements from wire-streams/cereal" [-         bench "1000 items" $ whnfIO $ benchCSA lstring ]-    , bgroup "decode 1000 elements from wire-streams/binary" [-         bench "1000 items" $ whnfIO $ benchBSA lstring ]-    , bgroup "decode 1000 elements cereal-conduit" [-         bench "1000 items" $ whnfIO $ benchCCA lstring ]-    ]--benchCS lstring = do-    s <- Cereal.decodeInputStream =<< Streams.fromLazyByteString lstring-    a <- Streams.read s :: IO (Maybe Foo)-    evaluate a--benchBS lstring = do-    s <- Binary.decodeInputStream =<< Streams.fromLazyByteString lstring-    a <- Streams.read s :: IO (Maybe Foo)-    evaluate a--benchCC lstring = do-    Conduit.sourceLbs lstring =$= Conduit.conduitGet2 (get :: Get Foo) $$ do-        a <- await-        liftIO (evaluate a)--benchCSA lstring = do-    s <- Cereal.decodeInputStream =<< Streams.fromLazyByteString lstring-    replicateM_ 1000 $ do-        a <- Streams.read s :: IO (Maybe Foo)-        evaluate a--benchBSA lstring = do-    s <- Binary.decodeInputStream =<< Streams.fromLazyByteString lstring-    replicateM_ 1000 $ do-        a <- Streams.read s :: IO (Maybe Foo)-        evaluate a--benchCCA lstring = do-    Conduit.sourceLbs lstring =$= Conduit.conduitGet2 (get :: Get Foo) $$-        replicateM_ 1000 $ do-            a <- await-            liftIO (evaluate a)-----------------------------------------------------------------------------------data Foo = Foo Int ByteString deriving (Generic, Show, Eq)--instance Serialize Foo-instance Binary    Foo

@@ -1,126 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE OverloadedStrings  #-}---------------------------------------------------------------------------------- |--- Module      :  Sytem.IO.Streams.Cereal--- Copyright   :  Soostone Inc, Winterland--- License     :  BSD3------ Maintainer  :  Winterland--- Stability   :  experimental------ Use cereal to encode/decode io-streams.-------------------------------------------------------------------------------module System.IO.Streams.Cereal (-    -- * single element encode/decode-      getFromStream-    , decodeFromStream-    , putToStream-    -- * 'InputStream' encode/decode-    , getInputStream-    , decodeInputStream-    -- * 'OutputStream' encode-    , putOutputStream-    , encodeOutputStream-    -- * exception type-    , DecodeException(..)-    ) where-----------------------------------------------------------------------------------import           Control.Exception      (Exception, throwIO)-import           Control.Monad          (unless)-import           Data.ByteString        (ByteString)-import qualified Data.ByteString.Char8  as S-import           Data.Serialize-import           Data.Typeable-import qualified System.IO.Streams      as Streams-import           System.IO.Streams.Core------------------------------------------------------------------------------------- | An Exception raised when cereal decoding fails.-data DecodeException = DecodeException String-  deriving (Typeable)--instance Show DecodeException where-    show (DecodeException s) = "System.IO.Streams.Cereal: cereal decode exception: " ++ s--instance Exception DecodeException------------------------------------------------------------------------------------- | write a instance of 'Serialize' to an 'OutputStream'----putToStream :: Serialize a => Maybe a -> OutputStream ByteString -> IO ()-putToStream Nothing  = Streams.write Nothing-putToStream (Just a) = (Streams.writeLazyByteString . runPutLazy . put) a-{-# INLINE putToStream #-}------------------------------------------------------------------------------------- | Take a 'Get' and an 'InputStream' and decode a--- value. Consumes only as much input as necessary to decode the--- value. Unconsumed input will be unread. If there is--- an error while deserializing, a 'DecodeException' is thrown, and--- unconsumed part will be unread. To simplify upstream generation,--- all empty 'ByteString' will be filtered out and not passed to cereal,--- only EOFs/Nothing will close a cereal decoder.------ Examples:------ >>> import qualified System.IO.Streams as Streams--- >>> getFromStream (get :: Get String) =<< Streams.fromByteString (Data.ByteString.drop 1 $ runPut $ put "encode me")--- *** Exception: System.IO.Streams.Cereal: cereal decode exception: too few bytes--- From:	demandInput--- <BLANKLINE>----getFromStream :: Get a -> InputStream ByteString -> IO (Maybe a)-getFromStream g is =-    Streams.read is >>= maybe (return Nothing) (go . runGetPartial g)-  where-    go (Fail msg s) = do-        unless (S.null s) (Streams.unRead s is)-        throwIO (DecodeException msg)-    go (Done r s) = do-         unless (S.null s) (Streams.unRead s is)-         return (Just r)-    go c@(Partial cont) =-        Streams.read is >>= maybe (go (cont S.empty))   -- use 'empty' to notify cereal ending.-        (\ s -> if S.null s then go c else go (cont s))-{-# INLINE getFromStream #-}---- | typeclass version of 'getFromStream'-decodeFromStream :: Serialize a => InputStream ByteString -> IO (Maybe a)-decodeFromStream = getFromStream get-{-# INLINE decodeFromStream #-}------------------------------------------------------------------------------------- | Convert a stream of individual encoded 'ByteString's to a stream--- of Results. Throws a 'DecodeException' on error.-getInputStream :: Get a -> InputStream ByteString -> IO (InputStream a)-getInputStream g is = makeInputStream (getFromStream g is)-{-# INLINE getInputStream #-}---- | typeclass version of 'getInputStream'-decodeInputStream :: Serialize a => InputStream ByteString -> IO (InputStream a)-decodeInputStream = getInputStream get-{-# INLINE decodeInputStream #-}------------------------------------------------------------------------------------- | create an 'OutputStream' of serializable values from an 'OutputStream'--- of bytestrings with a 'Putter'.-putOutputStream :: Putter a -> OutputStream ByteString -> IO (OutputStream a)-putOutputStream p os = Streams.makeOutputStream $ \ ma ->-    case ma of Nothing -> Streams.write Nothing os-               Just a  -> Streams.writeLazyByteString (runPutLazy (p a)) os-{-# INLINE putOutputStream #-}---- | typeclass version of 'putOutputStream'-encodeOutputStream :: Serialize a => OutputStream ByteString -> IO (OutputStream a)-encodeOutputStream = putOutputStream put-{-# INLINE encodeOutputStream #-}