packages feed

siphon 0.8.2.0 → 0.8.2.1

raw patch · 7 files changed

+865/−683 lines, 7 filesdep −contravariantdep −eitherdep −pipesdep ~colonnadedep ~streamingdep ~textsetup-changednew-uploader

Dependencies removed: contravariant, either, pipes, semigroups

Dependency ranges changed: colonnade, streaming, text, transformers

Files

CHANGELOG.md view
@@ -1,6 +1,11 @@ # Revision history for siphon -## 0.8.2.0 -- 2022-??-??+## 0.8.2.1 -- 2024-03-06++* Update package metadata.+* Removed `semigroups` dependency.++## 0.8.2.0 -- 2022-10-11  * Add 
+ README.md view
@@ -0,0 +1,9 @@+To run doctests:++First make sure `doctest` is on the `PATH` (i.e. `cabal install doctest`).++Then run:++```+cabal repl --with-ghc=doctest --repl-options="-fno-warn-orphans -Wno-x-partial" siphon+```
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
siphon.cabal view
@@ -1,49 +1,57 @@-cabal-version: 3.0-name: siphon-version: 0.8.2.0-synopsis: Encode and decode CSV files-description: Please see README.md-homepage: https://github.com/andrewthad/colonnade#readme-license: BSD-3-Clause-license-file: LICENSE-author: Andrew Martin-maintainer: andrew.thaddeus@gmail.com-copyright: 2016 Andrew Martin-category: web-build-type: Simple-extra-source-files: CHANGELOG.md+cabal-version:   3.0+name:            siphon+version:         0.8.2.1+synopsis:        Encode and decode CSV files+description:     Encode and decode CSV files.+homepage:        https://github.com/byteverse/siphon+bug-reports:     https://github.com/byteverse/siphon/issues+license:         BSD-3-Clause+license-file:    LICENSE+author:          Andrew Martin+maintainer:      amartin@layer3com.com+copyright:       2016 Andrew Martin+category:        web+build-type:      Simple+extra-doc-files:+  CHANGELOG.md+  README.md +tested-with:     GHC ==9.4.8 || ==9.6.3 || ==9.8.1++common build-settings+  default-language: Haskell2010+  ghc-options:      -Wall -Wunused-packages+  build-depends:    base >=4.8 && <5+ library-  hs-source-dirs: src+  import:          build-settings+  ghc-options:     -O2+  hs-source-dirs:  src   exposed-modules:     Siphon     Siphon.Types+   build-depends:-      base >= 4.8 && < 5-    , colonnade >= 1.2 && < 1.3-    , text >= 1.0 && < 2.1+    , attoparsec     , bytestring+    , colonnade     >=1.2+    , streaming     >=0.1.4+    , text          >=1.0+    , transformers  >=0.4.2     , vector-    , streaming >= 0.1.4 && < 0.3-    , attoparsec-    , transformers >= 0.4.2 && < 0.6-    , semigroups >= 0.18.2 && < 0.20-  default-language: Haskell2010  test-suite test-  type: exitcode-stdio-1.0+  import:         build-settings+  type:           exitcode-stdio-1.0   hs-source-dirs: test-  main-is: Test.hs+  main-is:        Test.hs   build-depends:-      base-    , HUnit-    , QuickCheck+    , base     , bytestring     , colonnade-    , contravariant-    , either-    , pipes+    , HUnit     , profunctors+    , QuickCheck     , siphon     , streaming     , test-framework@@ -51,8 +59,7 @@     , test-framework-quickcheck2     , text     , vector-  default-language: Haskell2010  source-repository head-  type: git-  location: https://github.com/andrewthad/colonnade+  type:     git+  location: git://github.com/byteverse/siphon.git
src/Siphon.hs view
@@ -1,105 +1,110 @@-{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE RankNTypes #-}--{-# OPTIONS_GHC -Wall -fno-warn-unused-imports #-}+{-# LANGUAGE ScopedTypeVariables #-} --- | Build CSVs using the abstractions provided in the @colonnade@ library, and ---   parse CSVs using 'Siphon', which is the dual of 'Colonnade'.---   Read the documentation for @colonnade@ before reading the documentation---   for @siphon@. All of the examples on this page assume a common set of---   imports that are provided at the bottom of this page.+{- | Build CSVs using the abstractions provided in the @colonnade@ library, and+  parse CSVs using 'Siphon', which is the dual of 'Colonnade'.+  Read the documentation for @colonnade@ before reading the documentation+  for @siphon@. All of the examples on this page assume a common set of+  imports that are provided at the bottom of this page.+-} module Siphon   ( -- * Encode CSV     encodeCsv   , encodeCsvStream   , encodeCsvUtf8   , encodeCsvStreamUtf8+     -- * Decode CSV   , decodeCsvUtf8   , decodeHeadedCsvUtf8   , decodeIndexedCsvUtf8+     -- * Build Siphon   , headed   , headless   , indexed+     -- * Types+  , Escaped   , Siphon-  , SiphonError(..)-  , Indexed(..)+  , SiphonError (..)+  , Indexed (..)+     -- * For Testing   , headedToIndexed+     -- * Utility   , humanizeSiphonError   , eqSiphonHeaders   , showSiphonHeaders+     -- * Imports     -- $setup   ) where -import Siphon.Types-import Data.Monoid-import Control.Applicative import Control.Monad-import Data.Functor.Classes (Eq1,Show1,liftEq,showsPrec1)+import Control.Monad.ST+import Control.Monad.Trans.Class+import Data.Attoparsec.ByteString.Char8 (char)+import Data.ByteString (ByteString)+import Data.ByteString.Builder (byteString, toLazyByteString)+import Data.Char (chr)+import Data.Functor.Classes (Eq1, Show1, liftEq, showsPrec1)+import Data.Functor.Identity (Identity (..))+import Data.Text (Text)+import Data.Text.Encoding (decodeUtf8')+import Data.Vector (Vector)+import Data.Vector.Mutable (MVector)+import Data.Word (Word8)+import Siphon.Types+import Streaming (Of (..), Stream) -import qualified Data.ByteString.Char8 as BC8+import qualified Colonnade.Encode as CE import qualified Data.Attoparsec.ByteString as A import qualified Data.Attoparsec.Lazy as AL+import qualified Data.Attoparsec.Types as ATYP import qualified Data.Attoparsec.Zepto as Z-import qualified Data.ByteString as S-import qualified Data.ByteString.Unsafe as S-import qualified Data.Vector as V import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as LByteString+import qualified Data.ByteString as S+import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Builder as Builder+import qualified Data.ByteString.Char8 as BC8+import qualified Data.ByteString.Lazy as LByteString+import qualified Data.ByteString.Unsafe as S+import qualified Data.List as L+import qualified Data.Semigroup as SG+import qualified Data.Text as T import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Builder as TB-import qualified Data.Text as T-import qualified Data.List as L+import qualified Data.Vector as V+import qualified Data.Vector.Mutable as MV import qualified Streaming as SM import qualified Streaming.Prelude as SMP-import qualified Data.Attoparsec.Types as ATYP-import qualified Colonnade.Encode as CE-import qualified Data.Vector.Mutable as MV-import qualified Data.ByteString.Builder as BB-import qualified Data.Semigroup as SG -import Control.Monad.Trans.Class-import Data.Functor.Identity (Identity(..))-import Data.ByteString.Builder (toLazyByteString,byteString)-import Data.Attoparsec.ByteString.Char8 (char, endOfInput, string)-import Data.Word (Word8)-import Data.Vector (Vector)-import Data.ByteString (ByteString)-import Data.Coerce (coerce)-import Data.Char (chr)-import Data.Text.Encoding (decodeUtf8')-import Streaming (Stream,Of(..))-import Data.Vector.Mutable (MVector)-import Control.Monad.ST-import Data.Text (Text)-import Data.Semigroup (Semigroup)--newtype Escaped c = Escaped { getEscaped :: c }+newtype Escaped c = Escaped {getEscaped :: c} data Ended = EndedYes | EndedNo   deriving (Show) data CellResult c = CellResultData !c | CellResultNewline !c !Ended   deriving (Show)  -- | Backwards-compatibility alias for 'decodeHeadedCsvUtf8'.-decodeCsvUtf8 :: Monad m-  => Siphon CE.Headed ByteString a-  -> Stream (Of ByteString) m () -- ^ encoded csv-  -> Stream (Of a) m (Maybe SiphonError)+decodeCsvUtf8 ::+  (Monad m) =>+  Siphon CE.Headed ByteString a ->+  -- | encoded csv+  Stream (Of ByteString) m () ->+  Stream (Of a) m (Maybe SiphonError) decodeCsvUtf8 = decodeHeadedCsvUtf8  -- | Decode a CSV whose first row is contains headers identify each column.-decodeHeadedCsvUtf8 :: Monad m-  => Siphon CE.Headed ByteString a-  -> Stream (Of ByteString) m () -- ^ encoded csv-  -> Stream (Of a) m (Maybe SiphonError)+decodeHeadedCsvUtf8 ::+  (Monad m) =>+  Siphon CE.Headed ByteString a ->+  -- | encoded csv+  Stream (Of ByteString) m () ->+  Stream (Of a) m (Maybe SiphonError) decodeHeadedCsvUtf8 headedSiphon s1 = do   e <- lift (consumeHeaderRowUtf8 s1)   case e of@@ -111,107 +116,134 @@         consumeBodyUtf8 1 requiredLength ixedSiphon s2  -- | Decode a CSV without a header.-decodeIndexedCsvUtf8 :: Monad m-  => Int -- ^ How many columns are there? This number should be greater than any indices referenced by the scheme.-  -> Siphon Indexed ByteString a-  -> Stream (Of ByteString) m () -- ^ encoded csv-  -> Stream (Of a) m (Maybe SiphonError)+decodeIndexedCsvUtf8 ::+  (Monad m) =>+  -- | How many columns are there? This number should be greater than any indices referenced by the scheme.+  Int ->+  Siphon Indexed ByteString a ->+  -- | encoded csv+  Stream (Of ByteString) m () ->+  Stream (Of a) m (Maybe SiphonError) decodeIndexedCsvUtf8 !requiredLength ixedSiphon s1 = do   consumeBodyUtf8 0 requiredLength ixedSiphon s1 -encodeCsvStreamUtf8 :: (Monad m, CE.Headedness h)-  => CE.Colonnade h a ByteString-  -> Stream (Of a) m r-  -> Stream (Of ByteString) m r+encodeCsvStreamUtf8 ::+  (Monad m, CE.Headedness h) =>+  CE.Colonnade h a ByteString ->+  Stream (Of a) m r ->+  Stream (Of ByteString) m r encodeCsvStreamUtf8 =   encodeCsvInternal escapeChar8 (B.singleton comma) (B.singleton newline) --- | Streaming variant of 'encodeCsv'. This is particularly useful---   when you need to produce millions of rows without having them---   all loaded into memory at the same time.-encodeCsvStream :: (Monad m, CE.Headedness h)-  => CE.Colonnade h a Text-  -> Stream (Of a) m r-  -> Stream (Of Text) m r+{- | Streaming variant of 'encodeCsv'. This is particularly useful+  when you need to produce millions of rows without having them+  all loaded into memory at the same time.+-}+encodeCsvStream ::+  (Monad m, CE.Headedness h) =>+  CE.Colonnade h a Text ->+  Stream (Of a) m r ->+  Stream (Of Text) m r encodeCsvStream =   encodeCsvInternal textEscapeChar8 (T.singleton ',') (T.singleton '\n') --- | Encode a collection to a CSV as a text 'TB.Builder'. For example,---   we can take the following columnar encoding of a person:------ >>> :{--- let colPerson :: Colonnade Headed Person Text---     colPerson = mconcat---       [ C.headed "Name" name---       , C.headed "Age" (T.pack . show . age)---       , C.headed "Company" (fromMaybe "N/A" . company)---       ]--- :}------ And we have the following people whom we wish to encode--- in this way:------ >>> :{--- let people :: [Person]---     people =---       [ Person "Chao" 26 (Just "Tectonic, Inc.")---       , Person "Elsie" 41 (Just "Globex Corporation")---       , Person "Arabella" 19 Nothing---       ]--- :}------ We pair the encoding with the rows to get a CSV:------ >>> LTIO.putStr (TB.toLazyText (encodeCsv colPerson people))--- Name,Age,Company--- Chao,26,"Tectonic, Inc."--- Elsie,41,Globex Corporation--- Arabella,19,N/A-encodeCsv :: (Foldable f, CE.Headedness h)-  => CE.Colonnade h a Text -- ^ Tablular encoding-  -> f a -- ^ Value of each row-  -> TB.Builder-encodeCsv enc = +{- | Encode a collection to a CSV as a text 'TB.Builder'. For example,+  we can take the following columnar encoding of a person:++>>> :{+let colPerson :: Colonnade Headed Person Text+    colPerson = mconcat+      [ C.headed "Name" name+      , C.headed "Age" (T.pack . show . age)+      , C.headed "Company" (fromMaybe "N/A" . company)+      ]+:}++And we have the following people whom we wish to encode+in this way:++>>> :{+let people :: [Person]+    people =+      [ Person "Chao" 26 (Just "Tectonic, Inc.")+      , Person "Elsie" 41 (Just "Globex Corporation")+      , Person "Arabella" 19 Nothing+      ]+:}++We pair the encoding with the rows to get a CSV:++>>> LTIO.putStr (TB.toLazyText (encodeCsv colPerson people))+Name,Age,Company+Chao,26,"Tectonic, Inc."+Elsie,41,Globex Corporation+Arabella,19,N/A+-}+encodeCsv ::+  (Foldable f, CE.Headedness h) =>+  -- | Tablular encoding+  CE.Colonnade h a Text ->+  -- | Value of each row+  f a ->+  TB.Builder+encodeCsv enc =   textStreamToBuilder . encodeCsvStream enc . SMP.each  -- | Encode a collection to a CSV as a bytestring 'BB.Builder'.-encodeCsvUtf8 :: (Foldable f, CE.Headedness h)-  => CE.Colonnade h a ByteString -- ^ Tablular encoding-  -> f a -- ^ Value of each row-  -> BB.Builder+encodeCsvUtf8 ::+  (Foldable f, CE.Headedness h) =>+  -- | Tablular encoding+  CE.Colonnade h a ByteString ->+  -- | Value of each row+  f a ->+  BB.Builder encodeCsvUtf8 enc =   streamToBuilder . encodeCsvStreamUtf8 enc . SMP.each  streamToBuilder :: Stream (Of ByteString) Identity () -> BB.Builder-streamToBuilder s = SM.destroy s-  (\(bs :> bb) -> BB.byteString bs <> bb) runIdentity (\() -> mempty)+streamToBuilder s =+  SM.destroy+    s+    (\(bs :> bb) -> BB.byteString bs <> bb)+    runIdentity+    (\() -> mempty)  textStreamToBuilder :: Stream (Of Text) Identity () -> TB.Builder-textStreamToBuilder s = SM.destroy s-  (\(bs :> bb) -> TB.fromText bs <> bb) runIdentity (\() -> mempty)+textStreamToBuilder s =+  SM.destroy+    s+    (\(bs :> bb) -> TB.fromText bs <> bb)+    runIdentity+    (\() -> mempty) -encodeCsvInternal :: (Monad m, CE.Headedness h)-  => (c -> Escaped c)-  -> c -- ^ separator-  -> c -- ^ newline-  -> CE.Colonnade h a c-  -> Stream (Of a) m r-  -> Stream (Of c) m r+encodeCsvInternal ::+  (Monad m, CE.Headedness h) =>+  (c -> Escaped c) ->+  -- | separator+  c ->+  -- | newline+  c ->+  CE.Colonnade h a c ->+  Stream (Of a) m r ->+  Stream (Of c) m r encodeCsvInternal escapeFunc separatorStr newlineStr colonnade s = do   case CE.headednessExtract of     Just toContent -> encodeHeader toContent escapeFunc separatorStr newlineStr colonnade     Nothing -> return ()   encodeRows escapeFunc separatorStr newlineStr colonnade s -encodeHeader :: Monad m-  => (h c -> c)-  -> (c -> Escaped c)-  -> c -- ^ separator-  -> c -- ^ newline-  -> CE.Colonnade h a c-  -> Stream (Of c) m ()+encodeHeader ::+  (Monad m) =>+  (h c -> c) ->+  (c -> Escaped c) ->+  -- | separator+  c ->+  -- | newline+  c ->+  CE.Colonnade h a c ->+  Stream (Of c) m () encodeHeader toContent escapeFunc separatorStr newlineStr colonnade = do-  let (vs,ws) = V.splitAt 1 (CE.getColonnade colonnade)+  let (vs, ws) = V.splitAt 1 (CE.getColonnade colonnade)   -- we only need to do this split because the first cell   -- gets treated differently than the others. It does not   -- get a separator added before it.@@ -222,21 +254,25 @@     SMP.yield (getEscaped (escapeFunc (toContent h)))   SMP.yield newlineStr -mapStreamM :: Monad m-  => (a -> Stream (Of b) m x)-  -> Stream (Of a) m r-  -> Stream (Of b) m r+mapStreamM ::+  (Monad m) =>+  (a -> Stream (Of b) m x) ->+  Stream (Of a) m r ->+  Stream (Of b) m r mapStreamM f = SM.concats . SM.mapsM (\(a :> s) -> return (f a >> return s)) -encodeRows :: Monad m-  => (c -> Escaped c)-  -> c -- ^ separator-  -> c -- ^ newline-  -> CE.Colonnade f a c-  -> Stream (Of a) m r-  -> Stream (Of c) m r+encodeRows ::+  (Monad m) =>+  (c -> Escaped c) ->+  -- | separator+  c ->+  -- | newline+  c ->+  CE.Colonnade f a c ->+  Stream (Of a) m r ->+  Stream (Of c) m r encodeRows escapeFunc separatorStr newlineStr colonnade = mapStreamM $ \a -> do-  let (vs,ws) = V.splitAt 1 (CE.getColonnade colonnade)+  let (vs, ws) = V.splitAt 1 (CE.getColonnade colonnade)   -- we only need to do this split because the first cell   -- gets treated differently than the others. It does not   -- get a separator added before it.@@ -246,22 +282,28 @@     SMP.yield (getEscaped (escapeFunc (encode a)))   SMP.yield newlineStr --- | Maps over a 'Decolonnade' that expects headers, converting these---   expected headers into the indices of the columns that they---   correspond to.-headedToIndexed :: forall c a. Eq c-  => (c -> T.Text)-  -> Vector c -- ^ Headers in the source document-  -> Siphon CE.Headed c a -- ^ Decolonnade that contains expected headers-  -> Either SiphonError (Siphon Indexed c a)+{- | Maps over a 'Decolonnade' that expects headers, converting these+  expected headers into the indices of the columns that they+  correspond to.+-}+headedToIndexed ::+  forall c a.+  (Eq c) =>+  (c -> T.Text) ->+  -- | Headers in the source document+  Vector c ->+  -- | Decolonnade that contains expected headers+  Siphon CE.Headed c a ->+  Either SiphonError (Siphon Indexed c a) headedToIndexed toStr v =-    mapLeft (\(HeaderErrors a b c) -> SiphonError 0 (RowErrorHeaders a b c)) -  . getEitherWrap-  . go-  where-  go :: forall b.-        Siphon CE.Headed c b-     -> EitherWrap HeaderErrors (Siphon Indexed c b)+  mapLeft (\(HeaderErrors a b c) -> SiphonError 0 (RowErrorHeaders a b c))+    . getEitherWrap+    . go+ where+  go ::+    forall b.+    Siphon CE.Headed c b ->+    EitherWrap HeaderErrors (Siphon Indexed c b)   go (SiphonPure b) = EitherWrap (Right (SiphonPure b))   go (SiphonAp (CE.Headed h) decode apNext) =     let rnext = go apNext@@ -271,17 +313,20 @@           | ixsLen == 1 = Right (ixs V.! 0)           | ixsLen == 0 = Left (HeaderErrors V.empty (V.singleton (toStr h)) V.empty)           | otherwise =-              let dups = V.singleton (V.map (\ix -> CellError ix (toStr (v V.! ix) {- (V.unsafeIndex v ix) -} )) ixs)+              let dups = V.singleton (V.map (\ix -> CellError ix (toStr (v V.! ix {- (V.unsafeIndex v ix) -}))) ixs)                in Left (HeaderErrors dups V.empty V.empty)-    in (\ix nextSiphon -> SiphonAp (Indexed ix) decode nextSiphon)-       <$> EitherWrap rcurrent-       <*> rnext+     in (\ix nextSiphon -> SiphonAp (Indexed ix) decode nextSiphon)+          <$> EitherWrap rcurrent+          <*> rnext  data HeaderErrors = HeaderErrors !(Vector (Vector CellError)) !(Vector T.Text) !(Vector Int)  instance Semigroup HeaderErrors where-  HeaderErrors a1 b1 c1 <> HeaderErrors a2 b2 c2 = HeaderErrors-    (mappend a1 a2) (mappend b1 b2) (mappend c1 c2)+  HeaderErrors a1 b1 c1 <> HeaderErrors a2 b2 c2 =+    HeaderErrors+      (mappend a1 a2)+      (mappend b1 b2)+      (mappend c1 c2)  instance Monoid HeaderErrors where   mempty = HeaderErrors mempty mempty mempty@@ -297,41 +342,53 @@ escapeChar8 :: ByteString -> Escaped ByteString escapeChar8 t = case B.find (\c -> c == newline || c == cr || c == comma || c == doubleQuote) t of   Nothing -> Escaped t-  Just _  -> escapeAlways t+  Just _ -> escapeAlways t  textEscapeChar8 :: Text -> Escaped Text textEscapeChar8 t = case T.find (\c -> c == '\n' || c == '\r' || c == ',' || c == '"') t of   Nothing -> Escaped t-  Just _  -> textEscapeAlways t+  Just _ -> textEscapeAlways t  -- This implementation is definitely suboptimal. -- A better option (which would waste a little space -- but would be much faster) would be to build the -- new bytestring by writing to a buffer directly. escapeAlways :: ByteString -> Escaped ByteString-escapeAlways t = Escaped $ LByteString.toStrict $ Builder.toLazyByteString $-     Builder.word8 doubleQuote-  <> B.foldl-      (\ acc b -> acc <> if b == doubleQuote-          then Builder.byteString-            (B.pack [doubleQuote,doubleQuote])-          else Builder.word8 b)-      mempty-      t-  <> Builder.word8 doubleQuote+escapeAlways t =+  Escaped $+    LByteString.toStrict $+      Builder.toLazyByteString $+        Builder.word8 doubleQuote+          <> B.foldl+            ( \acc b ->+                acc+                  <> if b == doubleQuote+                    then+                      Builder.byteString+                        (B.pack [doubleQuote, doubleQuote])+                    else Builder.word8 b+            )+            mempty+            t+          <> Builder.word8 doubleQuote  -- Suboptimal for similar reason as escapeAlways. textEscapeAlways :: Text -> Escaped Text-textEscapeAlways t = Escaped $ LT.toStrict $ TB.toLazyText $-     TB.singleton '"'-  <> T.foldl-      (\ acc b -> acc <> if b == '"'-          then TB.fromString "\"\""-          else TB.singleton b-      )-      mempty-      t-  <> TB.singleton '"'+textEscapeAlways t =+  Escaped $+    LT.toStrict $+      TB.toLazyText $+        TB.singleton '"'+          <> T.foldl+            ( \acc b ->+                acc+                  <> if b == '"'+                    then TB.fromString "\"\""+                    else TB.singleton b+            )+            mempty+            t+          <> TB.singleton '"'  -- Parse a record, not including the terminating line separator. The -- terminating line separate is not included as the last record in a@@ -343,22 +400,22 @@ --     -> AL.Parser (Vector ByteString) -- row !delim = rowNoNewline delim <* endOfLine -- {-# INLINE row #-}--- +-- -- rowNoNewline :: Word8  -- ^ Field delimiter --              -> AL.Parser (Vector ByteString) -- rowNoNewline !delim = V.fromList <$!> field delim `sepByDelim1'` delim -- {-# INLINE rowNoNewline #-}--- +-- -- removeBlankLines :: [Vector ByteString] -> [Vector ByteString] -- removeBlankLines = filter (not . blankLine) ---- | Parse a field. The field may be in either the escaped or---   non-escaped format. The return value is unescaped. This---   parser will consume the comma that comes after a field---   but not a newline that follows a field. If we are positioned---   at a newline when it starts, that newline will be consumed---   and we return CellResultNewline.+{- | Parse a field. The field may be in either the escaped or+  non-escaped format. The return value is unescaped. This+  parser will consume the comma that comes after a field+  but not a newline that follows a field. If we are positioned+  at a newline when it starts, that newline will be consumed+  and we return CellResultNewline.+-} field :: Word8 -> AL.Parser (CellResult ByteString) field !delim = do   mb <- A.peekWord8@@ -367,7 +424,7 @@   case mb of     Just b       | b == doubleQuote -> do-          (bs,tc) <- escapedField+          (bs, tc) <- escapedField           case tc of             TrailCharComma -> return (CellResultData bs)             TrailCharNewline -> return (CellResultNewline bs EndedNo)@@ -379,7 +436,7 @@             then return (CellResultNewline B.empty EndedYes)             else return (CellResultNewline B.empty EndedNo)       | otherwise -> do-          (bs,tc) <- unescapedField delim+          (bs, tc) <- unescapedField delim           case tc of             TrailCharComma -> return (CellResultData bs)             TrailCharNewline -> return (CellResultNewline bs EndedNo)@@ -390,19 +447,21 @@ eatNewlines :: AL.Parser S.ByteString eatNewlines = A.takeWhile (\x -> x == 10 || x == 13) -escapedField :: AL.Parser (S.ByteString,TrailChar)+escapedField :: AL.Parser (S.ByteString, TrailChar) escapedField = do   _ <- dquote   -- The scan state is 'True' if the previous character was a double   -- quote.  We need to drop a trailing double quote left by scan.-  s <- S.init <$>-    ( A.scan False $ \s c ->-      if c == doubleQuote-        then Just (not s)-        else if s-          then Nothing-          else Just False-    )+  s <-+    S.init+      <$> ( A.scan False $ \s c ->+              if c == doubleQuote+                then Just (not s)+                else+                  if s+                    then Nothing+                    else Just False+          )   mb <- A.peekWord8   trailChar <- case mb of     Just b@@ -416,48 +475,52 @@     Nothing -> return TrailCharEnd   if doubleQuote `S.elem` s     then case Z.parse unescape s of-      Right r  -> return (r,trailChar)+      Right r -> return (r, trailChar)       Left err -> fail err-    else return (s,trailChar)+    else return (s, trailChar)  data TrailChar = TrailCharNewline | TrailCharComma | TrailCharEnd --- | Consume an unescaped field. If it ends with a newline,---   leave that in tact. If it ends with a comma, consume the comma.-unescapedField :: Word8 -> AL.Parser (S.ByteString,TrailChar)+{- | Consume an unescaped field. If it ends with a newline,+  leave that in tact. If it ends with a comma, consume the comma.+-}+unescapedField :: Word8 -> AL.Parser (S.ByteString, TrailChar) unescapedField !delim = do-  bs <- A.takeWhile $ \c -> -    c /= doubleQuote &&-    c /= newline &&-    c /= delim &&-    c /= cr+  bs <- A.takeWhile $ \c ->+    c /= doubleQuote+      && c /= newline+      && c /= delim+      && c /= cr   mb <- A.peekWord8   case mb of     Just b-      | b == comma -> A.anyWord8 >> return (bs,TrailCharComma)-      | b == newline -> A.anyWord8 >> return (bs,TrailCharNewline)+      | b == comma -> A.anyWord8 >> return (bs, TrailCharComma)+      | b == newline -> A.anyWord8 >> return (bs, TrailCharNewline)       | b == cr -> do           _ <- A.anyWord8           _ <- A.word8 newline-          return (bs,TrailCharNewline)+          return (bs, TrailCharNewline)       | otherwise -> fail "encountered double quote in unescaped field"-    Nothing -> return (bs,TrailCharEnd)+    Nothing -> return (bs, TrailCharEnd)  dquote :: AL.Parser Char dquote = char '"' --- | This could be improved. We could avoid the builder and just--- write to a buffer directly.+{- | This could be improved. We could avoid the builder and just+write to a buffer directly.+-} unescape :: Z.Parser S.ByteString-unescape = (LByteString.toStrict . toLazyByteString) <$!> go mempty where+unescape = (LByteString.toStrict . toLazyByteString) <$!> go mempty+ where   go acc = do     h <- Z.takeWhile (/= doubleQuote)     let rest = do           start <- Z.take 2-          if (S.unsafeHead start == doubleQuote &&-              S.unsafeIndex start 1 == doubleQuote)-              then go (acc `mappend` byteString h `mappend` byteString (BC8.singleton '"'))-              else fail "invalid CSV escape sequence"+          if ( S.unsafeHead start == doubleQuote+                && S.unsafeIndex start 1 == doubleQuote+             )+            then go (acc `mappend` byteString h `mappend` byteString (BC8.singleton '"'))+            else fail "invalid CSV escape sequence"     done <- Z.atEnd     if done       then return (acc `mappend` byteString h)@@ -469,59 +532,74 @@ cr = 13 comma = 44 --- | This adds one to the index because text editors consider---   line number to be one-based, not zero-based.+{- | This adds one to the index because text editors consider+  line number to be one-based, not zero-based.+-} humanizeSiphonError :: SiphonError -> String-humanizeSiphonError (SiphonError ix e) = unlines-  $ ("Decolonnade error on line " ++ show (ix + 1) ++ " of file.")-  : ("Error Category: " ++ descr)-  : map ("  " ++) errDescrs-  where (descr,errDescrs) = prettyRowError e+humanizeSiphonError (SiphonError ix e) =+  unlines $+    ("Decolonnade error on line " ++ show (ix + 1) ++ " of file.")+      : ("Error Category: " ++ descr)+      : map ("  " ++) errDescrs+ where+  (descr, errDescrs) = prettyRowError e  prettyRowError :: RowError -> (String, [String]) prettyRowError x = case x of-  RowErrorParse -> (,) "CSV Parsing"-    [ "The cells were malformed."-    ]-  RowErrorSize reqLen actualLen -> (,) "Row Length"-    [ "Expected the row to have exactly " ++ show reqLen ++ " cells."-    , "The row only has " ++ show actualLen ++ " cells."-    ]-  RowErrorHeaderSize reqLen actualLen -> (,) "Minimum Header Length"-    [ "Expected the row to have at least " ++ show reqLen ++ " cells."-    , "The row only has " ++ show actualLen ++ " cells."-    ]-  RowErrorMalformed column -> (,) "Text Decolonnade"-    [ "Tried to decode input input in column " ++ columnNumToLetters column ++ " text"-    , "There is a mistake in the encoding of the text."-    ]-  RowErrorHeaders dupErrs namedErrs unnamedErrs -> (,) "Missing Headers" $ concat-    [ if V.length namedErrs > 0 then prettyNamedMissingHeaders namedErrs else []-    , if V.length unnamedErrs > 0 then ["Missing unnamed headers"] else []-    , if V.length dupErrs > 0 then prettyHeadingErrors dupErrs else []-    ]+  RowErrorParse ->+    (,)+      "CSV Parsing"+      [ "The cells were malformed."+      ]+  RowErrorSize reqLen actualLen ->+    (,)+      "Row Length"+      [ "Expected the row to have exactly " ++ show reqLen ++ " cells."+      , "The row only has " ++ show actualLen ++ " cells."+      ]+  RowErrorHeaderSize reqLen actualLen ->+    (,)+      "Minimum Header Length"+      [ "Expected the row to have at least " ++ show reqLen ++ " cells."+      , "The row only has " ++ show actualLen ++ " cells."+      ]+  RowErrorMalformed column ->+    (,)+      "Text Decolonnade"+      [ "Tried to decode input input in column " ++ columnNumToLetters column ++ " text"+      , "There is a mistake in the encoding of the text."+      ]+  RowErrorHeaders dupErrs namedErrs unnamedErrs ->+    (,) "Missing Headers" $+      concat+        [ if V.length namedErrs > 0 then prettyNamedMissingHeaders namedErrs else []+        , if V.length unnamedErrs > 0 then ["Missing unnamed headers"] else []+        , if V.length dupErrs > 0 then prettyHeadingErrors dupErrs else []+        ]   RowErrorDecode errs -> (,) "Cell Decolonnade" (prettyCellErrors errs)  prettyCellErrors :: Vector CellError -> [String] prettyCellErrors errs = drop 1 $   flip concatMap errs $ \(CellError ix content) ->-    let str = T.unpack content in-    [ "-----------"-    , "Column " ++ columnNumToLetters ix-    , "Cell Content Length: " ++ show (Prelude.length str)-    , "Cell Content: " ++ if null str-        then "[empty cell]"-        else str-    ]+    let str = T.unpack content+     in [ "-----------"+        , "Column " ++ columnNumToLetters ix+        , "Cell Content Length: " ++ show (Prelude.length str)+        , "Cell Content: "+            ++ if null str+              then "[empty cell]"+              else str+        ]  prettyNamedMissingHeaders :: Vector T.Text -> [String]-prettyNamedMissingHeaders missing = concat-  [ concatMap (\h -> ["The header " ++ T.unpack h ++ " was missing."]) missing-  ]+prettyNamedMissingHeaders missing =+  concat+    [ concatMap (\h -> ["The header " ++ T.unpack h ++ " was missing."]) missing+    ]  prettyHeadingErrors :: Vector (Vector CellError) -> [String] prettyHeadingErrors missing = join (V.toList (fmap f missing))-  where+ where   f :: Vector CellError -> [String]   f v     | not (V.null w) && V.all (== V.head w) (V.tail w) =@@ -530,9 +608,11 @@         , "] appears in columns "         , L.intercalate ", " (V.toList (V.map (\(CellError ix _) -> columnNumToLetters ix) v))         ]-    | otherwise = multiMsg : V.toList-        (V.map (\(CellError ix content) -> "  Column " ++ columnNumToLetters ix ++ ": " ++ T.unpack content) v)-    where+    | otherwise =+        multiMsg+          : V.toList+            (V.map (\(CellError ix content) -> "  Column " ++ columnNumToLetters ix ++ ": " ++ T.unpack content) v)+   where     w :: Vector T.Text     w = V.map cellErrorContent v     multiMsg :: String@@ -545,9 +625,10 @@  newtype EitherWrap a b = EitherWrap   { getEitherWrap :: Either a b-  } deriving (Functor)+  }+  deriving (Functor) -instance Monoid a => Applicative (EitherWrap a) where+instance (Monoid a) => Applicative (EitherWrap a) where   pure = EitherWrap . Right   EitherWrap (Left a1) <*> EitherWrap (Left a2) = EitherWrap (Left (mappend a1 a2))   EitherWrap (Left a1) <*> EitherWrap (Right _) = EitherWrap (Left a1)@@ -558,47 +639,66 @@ mapLeft _ (Right a) = Right a mapLeft f (Left a) = Left (f a) -consumeHeaderRowUtf8 :: Monad m-  => Stream (Of ByteString) m ()-  -> m (Either SiphonError (Of (Vector ByteString) (Stream (Of ByteString) m ())))+consumeHeaderRowUtf8 ::+  (Monad m) =>+  Stream (Of ByteString) m () ->+  m (Either SiphonError (Of (Vector ByteString) (Stream (Of ByteString) m ()))) consumeHeaderRowUtf8 = consumeHeaderRow (A.parse (field comma)) B.null B.empty (\() -> True) -consumeBodyUtf8 :: forall m a. Monad m-  => Int -- ^ index of first row, usually zero or one-  -> Int -- ^ Required row length-  -> Siphon Indexed ByteString a-  -> Stream (Of ByteString) m ()-  -> Stream (Of a) m (Maybe SiphonError)-consumeBodyUtf8 = consumeBody utf8ToStr-  (A.parse (field comma)) B.null B.empty (\() -> True)+consumeBodyUtf8 ::+  forall m a.+  (Monad m) =>+  -- | index of first row, usually zero or one+  Int ->+  -- | Required row length+  Int ->+  Siphon Indexed ByteString a ->+  Stream (Of ByteString) m () ->+  Stream (Of a) m (Maybe SiphonError)+consumeBodyUtf8 =+  consumeBody+    utf8ToStr+    (A.parse (field comma))+    B.null+    B.empty+    (\() -> True)  utf8ToStr :: ByteString -> T.Text utf8ToStr = either (\_ -> T.empty) id . decodeUtf8' -consumeHeaderRow :: forall m r c. Monad m-  => (c -> ATYP.IResult c (CellResult c))-  -> (c -> Bool) -- ^ true if null string-  -> c-  -> (r -> Bool) -- ^ true if termination is acceptable-  -> Stream (Of c) m r-  -> m (Either SiphonError (Of (Vector c) (Stream (Of c) m r)))+consumeHeaderRow ::+  forall m r c.+  (Monad m) =>+  (c -> ATYP.IResult c (CellResult c)) ->+  -- | true if null string+  (c -> Bool) ->+  c ->+  -- | true if termination is acceptable+  (r -> Bool) ->+  Stream (Of c) m r ->+  m (Either SiphonError (Of (Vector c) (Stream (Of c) m r))) consumeHeaderRow parseCell isNull emptyStr isGood s0 = go 0 StrictListNil s0-  where-  go :: Int-     -> StrictList c-     -> Stream (Of c) m r-     -> m (Either SiphonError (Of (Vector c) (Stream (Of c) m r)))+ where+  go ::+    Int ->+    StrictList c ->+    Stream (Of c) m r ->+    m (Either SiphonError (Of (Vector c) (Stream (Of c) m r)))   go !cellsLen !cells !s1 = do     e <- skipWhile isNull s1     case e of-      Left r -> return $ if isGood r-        then Right (reverseVectorStrictList cellsLen cells :> return r)-        else Left (SiphonError 0 RowErrorParse)+      Left r ->+        return $+          if isGood r+            then Right (reverseVectorStrictList cellsLen cells :> return r)+            else Left (SiphonError 0 RowErrorParse)       Right (c :> s2) -> handleResult cellsLen cells (parseCell c) s2-  handleResult :: Int -> StrictList c -               -> ATYP.IResult c (CellResult c)-               -> Stream (Of c) m r-               -> m (Either SiphonError (Of (Vector c) (Stream (Of c) m r)))+  handleResult ::+    Int ->+    StrictList c ->+    ATYP.IResult c (CellResult c) ->+    Stream (Of c) m r ->+    m (Either SiphonError (Of (Vector c) (Stream (Of c) m r)))   handleResult !cellsLen !cells !result s1 = case result of     ATYP.Fail _ _ _ -> return $ Left $ SiphonError 0 RowErrorParse     ATYP.Done !c1 !res -> case res of@@ -606,41 +706,52 @@       CellResultNewline cd _ -> do         let v = reverseVectorStrictList (cellsLen + 1) (StrictListCons cd cells)         return (Right (v :> (SMP.yield c1 >> s1)))-      CellResultData !cd -> if isNull c1-        then go (cellsLen + 1) (StrictListCons cd cells) s1-        else handleResult (cellsLen + 1) (StrictListCons cd cells) (parseCell c1) s1+      CellResultData !cd ->+        if isNull c1+          then go (cellsLen + 1) (StrictListCons cd cells) s1+          else handleResult (cellsLen + 1) (StrictListCons cd cells) (parseCell c1) s1     ATYP.Partial k -> do       e <- skipWhile isNull s1       case e of         Left r -> handleResult cellsLen cells (k emptyStr) (return r)         Right (c1 :> s2) -> handleResult cellsLen cells (k c1) s2 -consumeBody :: forall m r c a. Monad m-  => (c -> T.Text)-  -> (c -> ATYP.IResult c (CellResult c))-  -> (c -> Bool)-  -> c-  -> (r -> Bool) -- ^ True if termination is acceptable. False if it is because of a decoding error.-  -> Int -- ^ index of first row, usually zero or one-  -> Int -- ^ Required row length-  -> Siphon Indexed c a-  -> Stream (Of c) m r-  -> Stream (Of a) m (Maybe SiphonError)+consumeBody ::+  forall m r c a.+  (Monad m) =>+  (c -> T.Text) ->+  (c -> ATYP.IResult c (CellResult c)) ->+  (c -> Bool) ->+  c ->+  -- | True if termination is acceptable. False if it is because of a decoding error.+  (r -> Bool) ->+  -- | index of first row, usually zero or one+  Int ->+  -- | Required row length+  Int ->+  Siphon Indexed c a ->+  Stream (Of c) m r ->+  Stream (Of a) m (Maybe SiphonError) consumeBody toStr parseCell isNull emptyStr isGood row0 reqLen siphon s0 =   go row0 0 StrictListNil s0-  where+ where   go :: Int -> Int -> StrictList c -> Stream (Of c) m r -> Stream (Of a) m (Maybe SiphonError)   go !row !cellsLen !cells !s1 = do     e <- lift (skipWhile isNull s1)     case e of-      Left r -> return $ if isGood r-        then Nothing-        else Just (SiphonError row RowErrorParse)+      Left r ->+        return $+          if isGood r+            then Nothing+            else Just (SiphonError row RowErrorParse)       Right (c :> s2) -> handleResult row cellsLen cells (parseCell c) s2-  handleResult :: Int -> Int -> StrictList c -               -> ATYP.IResult c (CellResult c)-               -> Stream (Of c) m r-               -> Stream (Of a) m (Maybe SiphonError)+  handleResult ::+    Int ->+    Int ->+    StrictList c ->+    ATYP.IResult c (CellResult c) ->+    Stream (Of c) m r ->+    Stream (Of a) m (Maybe SiphonError)   handleResult !row !cellsLen !cells !result s1 = case result of     ATYP.Fail _ _ _ -> return $ Just $ SiphonError row RowErrorParse     ATYP.Done !c1 !res -> case res of@@ -653,16 +764,20 @@               EndedYes -> do                 e <- lift (SM.inspect s1)                 case e of-                  Left r -> return $ if isGood r-                    then Nothing-                    else Just (SiphonError row RowErrorParse)+                  Left r ->+                    return $+                      if isGood r+                        then Nothing+                        else Just (SiphonError row RowErrorParse)                   Right _ -> error "siphon: logical error, stream should be exhausted"-              EndedNo -> if isNull c1 -                then go (row + 1) 0 StrictListNil s1-                else handleResult (row + 1) 0 StrictListNil (parseCell c1) s1-      CellResultData !cd -> if isNull c1-        then go row (cellsLen + 1) (StrictListCons cd cells) s1-        else handleResult row (cellsLen + 1) (StrictListCons cd cells) (parseCell c1) s1+              EndedNo ->+                if isNull c1+                  then go (row + 1) 0 StrictListNil s1+                  else handleResult (row + 1) 0 StrictListNil (parseCell c1) s1+      CellResultData !cd ->+        if isNull c1+          then go row (cellsLen + 1) (StrictListCons cd cells) s1+          else handleResult row (cellsLen + 1) (StrictListCons cd cells) (parseCell c1) s1     ATYP.Partial k -> do       e <- lift (skipWhile isNull s1)       case e of@@ -670,95 +785,108 @@         Right (c1 :> s2) -> handleResult row cellsLen cells (k c1) s2   decodeRow :: Int -> Vector c -> Either SiphonError a   decodeRow rowIx v =-    let vlen = V.length v in-    if vlen /= reqLen-      then Left $ SiphonError rowIx $ RowErrorSize reqLen vlen-      else uncheckedRunWithRow toStr rowIx siphon v+    let vlen = V.length v+     in if vlen /= reqLen+          then Left $ SiphonError rowIx $ RowErrorSize reqLen vlen+          else uncheckedRunWithRow toStr rowIx siphon v --- | You must pass the length of the list and as the first argument.---   Passing the wrong length will lead to an error.+{- | You must pass the length of the list and as the first argument.+  Passing the wrong length will lead to an error.+-} reverseVectorStrictList :: forall c. Int -> StrictList c -> Vector c reverseVectorStrictList len sl0 = V.create $ do   mv <- MV.new len   go1 mv   return mv-  where+ where   go1 :: forall s. MVector s c -> ST s ()   go1 !mv = go2 (len - 1) sl0-    where+   where     go2 :: Int -> StrictList c -> ST s ()     go2 _ StrictListNil = return ()     go2 !ix (StrictListCons c slNext) = do       MV.write mv ix c       go2 (ix - 1) slNext --skipWhile :: forall m a r. Monad m-  => (a -> Bool)-  -> Stream (Of a) m r-  -> m (Either r (Of a (Stream (Of a) m r)))-skipWhile f = go where-  go :: Stream (Of a) m r-     -> m (Either r (Of a (Stream (Of a) m r)))+skipWhile ::+  forall m a r.+  (Monad m) =>+  (a -> Bool) ->+  Stream (Of a) m r ->+  m (Either r (Of a (Stream (Of a) m r)))+skipWhile f = go+ where+  go ::+    Stream (Of a) m r ->+    m (Either r (Of a (Stream (Of a) m r)))   go s1 = do     e <- SM.inspect s1     case e of       Left _ -> return e-      Right (a :> s2) -> if f a-        then go s2-        else return e+      Right (a :> s2) ->+        if f a+          then go s2+          else return e --- | Strict in the spine and in the values--- This is built in reverse and then reversed by reverseVectorStrictList--- when converting to a vector.+{- | Strict in the spine and in the values+This is built in reverse and then reversed by reverseVectorStrictList+when converting to a vector.+-} data StrictList a = StrictListNil | StrictListCons !a !(StrictList a) --- | This function uses 'unsafeIndex' to access---   elements of the 'Vector'.+{- | This function uses 'unsafeIndex' to access+  elements of the 'Vector'.+-} uncheckedRunWithRow ::-     (c -> T.Text)-  -> Int-  -> Siphon Indexed c a-  -> Vector c-  -> Either SiphonError a+  (c -> T.Text) ->+  Int ->+  Siphon Indexed c a ->+  Vector c ->+  Either SiphonError a uncheckedRunWithRow toStr i d v =   mapLeft (SiphonError i . RowErrorDecode) (uncheckedRun toStr d v) --- | This function does not check to make sure that the indicies in---   the 'Decolonnade' are in the 'Vector'. Only use this if you have---   already verified that none of the indices in the siphon are---   out of the bounds.-uncheckedRun :: forall c a.-     (c -> T.Text)-  -> Siphon Indexed c a-  -> Vector c-  -> Either (Vector CellError) a+{- | This function does not check to make sure that the indicies in+  the 'Decolonnade' are in the 'Vector'. Only use this if you have+  already verified that none of the indices in the siphon are+  out of the bounds.+-}+uncheckedRun ::+  forall c a.+  (c -> T.Text) ->+  Siphon Indexed c a ->+  Vector c ->+  Either (Vector CellError) a uncheckedRun toStr dc v = getEitherWrap (go dc)-  where-  go :: forall b.-        Siphon Indexed c b-     -> EitherWrap (Vector CellError) b+ where+  go ::+    forall b.+    Siphon Indexed c b ->+    EitherWrap (Vector CellError) b   go (SiphonPure b) = EitherWrap (Right b)   go (SiphonAp (Indexed ix) decode apNext) =     let rnext = go apNext         content = v V.! ix -- V.unsafeIndex v ix-        rcurrent = maybe-          (Left (V.singleton (CellError ix (toStr content))))-          Right-          (decode content)-    in rnext <*> (EitherWrap rcurrent)+        rcurrent =+          maybe+            (Left (V.singleton (CellError ix (toStr content))))+            Right+            (decode content)+     in rnext <*> (EitherWrap rcurrent)  -- | Uses the argument to parse a CSV column. headless :: (c -> Maybe a) -> Siphon CE.Headless c a headless f = SiphonAp CE.Headless f (SiphonPure id) --- | Uses the second argument to parse a CSV column whose ---   header content matches the first column exactly.+{- | Uses the second argument to parse a CSV column whose+  header content matches the first column exactly.+-} headed :: c -> (c -> Maybe a) -> Siphon CE.Headed c a headed h f = SiphonAp (CE.Headed h) f (SiphonPure id) --- | Uses the second argument to parse a CSV column that---   is positioned at the index given by the first argument.+{- | Uses the second argument to parse a CSV column that+  is positioned at the index given by the first argument.+-} indexed :: Int -> (c -> Maybe a) -> Siphon Indexed c a indexed ix f = SiphonAp (Indexed ix) f (SiphonPure id) @@ -772,20 +900,20 @@ showSiphonHeaders (SiphonPure _) = "" showSiphonHeaders (SiphonAp h0 _ s0) = showsPrec1 10 h0 (" :> " ++ showSiphonHeaders s0) --- $setup------ This code is copied from the head section. It has to be--- run before every set of tests.------ >>> :set -XOverloadedStrings--- >>> import Siphon (Siphon)--- >>> import Colonnade (Colonnade,Headed)--- >>> import qualified Siphon as S--- >>> import qualified Colonnade as C--- >>> import qualified Data.Text as T--- >>> import Data.Text (Text)--- >>> import qualified Data.Text.Lazy.IO as LTIO--- >>> import qualified Data.Text.Lazy.Builder as LB--- >>> import Data.Maybe (fromMaybe)--- >>> data Person = Person { name :: Text, age :: Int, company :: Maybe Text}+{- $setup +This code is copied from the head section. It has to be+run before every set of tests.++>>> :set -XOverloadedStrings+>>> import Siphon (Siphon)+>>> import Colonnade (Colonnade,Headed)+>>> import qualified Siphon as S+>>> import qualified Colonnade as C+>>> import qualified Data.Text as T+>>> import Data.Text (Text)+>>> import qualified Data.Text.Lazy.IO as LTIO+>>> import qualified Data.Text.Lazy.Builder as LB+>>> import Data.Maybe (fromMaybe)+>>> data Person = Person { name :: Text, age :: Int, company :: Maybe Text}+-}
src/Siphon/Types.hs view
@@ -1,30 +1,30 @@-{-# LANGUAGE GADTs #-} {-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# OPTIONS_GHC -Wall -Werror #-}- module Siphon.Types-  ( Siphon(..)-  , Indexed(..)-  , SiphonError(..)-  , RowError(..)-  , CellError(..)+  ( Siphon (..)+  , Indexed (..)+  , SiphonError (..)+  , RowError (..)+  , CellError (..)   ) where -import Data.Vector (Vector) import Control.Exception (Exception)+import Data.Functor.Classes (Eq1, Show1, liftEq, liftShowsPrec) import Data.Text (Text)-import Data.Functor.Classes (Eq1,Show1,liftEq,liftShowsPrec)+import Data.Vector (Vector)  data CellError = CellError   { cellErrorColumn :: !Int   , cellErrorContent :: !Text-  } deriving (Show,Read,Eq)+  }+  deriving (Show, Read, Eq)  newtype Indexed a = Indexed   { indexedIndex :: Int-  } deriving (Eq,Ord,Functor,Show,Read)+  }+  deriving (Eq, Ord, Functor, Show, Read)  instance Show1 Indexed where   liftShowsPrec _ _ p (Indexed i) s = showsPrec p i s@@ -35,43 +35,45 @@ data SiphonError = SiphonError   { siphonErrorRow :: !Int   , siphonErrorCause :: !RowError-  } deriving (Show,Read,Eq)+  }+  deriving (Show, Read, Eq)  instance Exception SiphonError  data RowError-  = RowErrorParse-    -- ^ Error occurred parsing the document into cells-  | RowErrorDecode !(Vector CellError)-    -- ^ Error decoding the content-  | RowErrorSize !Int !Int-    -- ^ Wrong number of cells in the row-  | RowErrorHeaders !(Vector (Vector CellError)) !(Vector Text) !(Vector Int)-    -- ^ Three parts:-    --   (a) Multiple header cells matched the same expected cell, -    --   (b) Headers that were missing, +  = -- | Error occurred parsing the document into cells+    RowErrorParse+  | -- | Error decoding the content+    RowErrorDecode !(Vector CellError)+  | -- | Wrong number of cells in the row+    RowErrorSize !Int !Int+  | -- | Three parts:+    --   (a) Multiple header cells matched the same expected cell,+    --   (b) Headers that were missing,     --   (c) Missing headers that were lambdas. They cannot be     --   shown so instead their positions in the 'Siphon' are given.-  | RowErrorHeaderSize !Int !Int-    -- ^ Not enough cells in header, expected, actual-  | RowErrorMalformed !Int-    -- ^ Error decoding unicode content, column number-  deriving (Show,Read,Eq)+    RowErrorHeaders !(Vector (Vector CellError)) !(Vector Text) !(Vector Int)+  | -- | Not enough cells in header, expected, actual+    RowErrorHeaderSize !Int !Int+  | -- | Error decoding unicode content, column number+    RowErrorMalformed !Int+  deriving (Show, Read, Eq) --- | This just actually a specialization of the free applicative.---   Check out @Control.Applicative.Free@ in the @free@ library to---   learn more about this. The meanings of the fields are documented---   slightly more in the source code. Unfortunately, haddock does not---   play nicely with GADTs.+{- | This just actually a specialization of the free applicative.+  Check out @Control.Applicative.Free@ in the @free@ library to+  learn more about this. The meanings of the fields are documented+  slightly more in the source code. Unfortunately, haddock does not+  play nicely with GADTs.+-} data Siphon f c a where   SiphonPure ::-       !a -- function-    -> Siphon f c a+    !a -> -- function+    Siphon f c a   SiphonAp ::-       !(f c) -- header-    -> !(c -> Maybe a) -- decoding function-    -> !(Siphon f c (a -> b)) -- next decoding-    -> Siphon f c b+    !(f c) -> -- header+    !(c -> Maybe a) -> -- decoding function+    !(Siphon f c (a -> b)) -> -- next decoding+    Siphon f c b  instance Functor (Siphon f c) where   fmap f (SiphonPure a) = SiphonPure (f a)@@ -81,4 +83,3 @@   pure = SiphonPure   SiphonPure f <*> y = fmap f y   SiphonAp h c y <*> z = SiphonAp h c (flip <$> y <*> z)-
test/Test.hs view
@@ -1,164 +1,187 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE DeriveGeneric     #-}  module Main (main) where -import Colonnade (headed,headless,Colonnade,Headed,Headless)+import Colonnade (Colonnade, Headed, Headless, headed, headless) import Control.Exception import Data.ByteString (ByteString) import Data.Char (ord)-import Data.Either.Combinators-import Data.Functor.Contravariant           (contramap)-import Data.Functor.Contravariant.Divisible (divided,conquered) import Data.Functor.Identity import Data.Profunctor (lmap) import Data.Text (Text) import Data.Word (Word8)-import Debug.Trace import GHC.Generics (Generic) import Siphon.Types-import Streaming (Stream,Of(..))-import Test.Framework (defaultMain, testGroup, Test)+import Streaming (Of (..), Stream)+import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.HUnit (testCase) import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.HUnit (Assertion,(@?=))-import Test.QuickCheck (Gen, Arbitrary(..), choose, elements, Property)-import Test.QuickCheck.Property (Result, succeeded, exception)+import Test.HUnit (Assertion, (@?=))+import Test.QuickCheck (Arbitrary (..), elements)+import Test.QuickCheck.Property (Result, exception, succeeded) -import qualified Data.Text as Text-import qualified Data.ByteString.Builder as Builder-import qualified Data.ByteString.Lazy as LByteString+import qualified Data.ByteString as B import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Builder as Builder import qualified Data.ByteString.Char8 as BC8-import qualified Data.ByteString as B-import qualified Data.Vector as Vector-import qualified Colonnade as Colonnade-import qualified Siphon as S-import qualified Streaming.Prelude as SMP+import qualified Data.ByteString.Lazy as LByteString+import qualified Data.Text as Text import qualified Data.Text.Lazy as LText import qualified Data.Text.Lazy.Builder as TBuilder import qualified Data.Text.Lazy.Builder.Int as TBuilder+import qualified Data.Vector as Vector+import qualified Siphon as S+import qualified Streaming.Prelude as SMP  main :: IO () main = defaultMain tests  tests :: [Test] tests =-  [ testGroup "ByteString encode/decode"-    [ testCase "Headed Encoding (int,char,bool)"-        $ runTestScenario [(4,intToWord8 (ord 'c'),False)]+  [ testGroup+      "ByteString encode/decode"+      [ testCase "Headed Encoding (int,char,bool)"+          $ runTestScenario+            [(4, intToWord8 (ord 'c'), False)]             S.encodeCsvStreamUtf8             encodingB-            $ ByteString.concat-              [ "number,letter,boolean\n"-              , "4,c,false\n"-              ]-    , testCase "Headed Encoding (int,char,bool) monoidal building"-        $ runTestScenario [(4,'c',False)]+          $ ByteString.concat+            [ "number,letter,boolean\n"+            , "4,c,false\n"+            ]+      , testCase "Headed Encoding (int,char,bool) monoidal building"+          $ runTestScenario+            [(4, 'c', False)]             S.encodeCsvStreamUtf8             encodingC-            $ ByteString.concat-              [ "boolean,letter\n"-              , "false,c\n"-              ]-    , testCase "Headed Encoding (escaped characters)"-        $ runTestScenario ["bob","there,be,commas","the \" quote"]+          $ ByteString.concat+            [ "boolean,letter\n"+            , "false,c\n"+            ]+      , testCase "Headed Encoding (escaped characters)"+          $ runTestScenario+            ["bob", "there,be,commas", "the \" quote"]             S.encodeCsvStreamUtf8             encodingF-            $ ByteString.concat-              [ "name\n"-              , "bob\n"-              , "\"there,be,commas\"\n"-              , "\"the \"\" quote\"\n"-              ]-    , testCase "Headed Decoding (int,char,bool)"-        $ ( runIdentity . SMP.toList )-            ( S.decodeCsvUtf8 decodingB-              ( mapM_ (SMP.yield . BC8.singleton) $ concat-                [ "number,letter,boolean\n"-                , "244,z,true\n"-                ]-              )-            ) @?= ([(244,intToWord8 (ord 'z'),True)] :> Nothing)-    , testCase "Headed Decoding (geolite)"-        $ ( runIdentity . SMP.toList )-            ( S.decodeCsvUtf8 decodingGeolite-              ( SMP.yield $ BC8.pack $ concat-                [ "network,autonomous_system_number,autonomous_system_organization\n"-                , "1,z,y\n"-                ]-              )-            ) @?= ([(1,intToWord8 (ord 'z'),intToWord8 (ord 'y'))] :> Nothing)-    , testCase "Headed Decoding (escaped characters, one big chunk)"-        $ ( runIdentity . SMP.toList )-            ( S.decodeCsvUtf8 decodingF-              ( SMP.yield $ BC8.pack $ concat-                [ "name\n"-                , "drew\n"-                , "\"martin, drew\"\n"-                ]-              )-            ) @?= (["drew","martin, drew"] :> Nothing)-    , testCase "Headed Decoding (escaped characters, character per chunk)"-        $ ( runIdentity . SMP.toList )-            ( S.decodeCsvUtf8 decodingF-              ( mapM_ (SMP.yield . BC8.singleton) $ concat-                [ "name\n"-                , "drew\n"-                , "\"martin, drew\"\n"-                ]-              )-            ) @?= (["drew","martin, drew"] :> Nothing)-    , testCase "Headed Decoding (escaped characters, character per chunk, CRLF)"-        $ ( runIdentity . SMP.toList )-            ( S.decodeCsvUtf8 decodingF-              ( mapM_ (SMP.yield . BC8.singleton) $ concat-                [ "name\r\n"-                , "drew\r\n"-                , "\"martin, drew\"\r\n"-                ]-              )-            ) @?= (["drew","martin, drew"] :> Nothing)-    , testCase "headedToIndexed" $-        let actual = S.headedToIndexed id (Vector.fromList ["letter","boolean","number"]) decodingG-         in case actual of-              Left e -> fail "headedToIndexed failed"-              Right actualInner -> -                let expected = SiphonAp (Indexed 2 :: Indexed Text) (\_ -> Nothing)-                             $ SiphonAp (Indexed 0 :: Indexed Text) (\_ -> Nothing)-                             $ SiphonAp (Indexed 1 :: Indexed Text) (\_ -> Nothing)-                             $ SiphonPure (\_ _ _ -> ())-                 in case S.eqSiphonHeaders actualInner expected of-                      True -> pure ()-                      False -> fail $-                        "Expected " ++-                        S.showSiphonHeaders expected ++-                        " but got " ++-                        S.showSiphonHeaders actualInner-    , testCase "Indexed Decoding (int,char,bool)"-        $ ( runIdentity . SMP.toList )-            ( S.decodeIndexedCsvUtf8 3 indexedDecodingB-              ( mapM_ (SMP.yield . BC8.singleton) $ concat-                [ "244,z,true\n"-                ]-              )-            ) @?= ([(244,intToWord8 (ord 'z'),True)] :> Nothing)-    , testProperty "Headed Isomorphism (int,char,bool)"-        $ propIsoStream BC8.unpack-          (S.decodeCsvUtf8 decodingB)-          (S.encodeCsvStreamUtf8 encodingB)-    ]+          $ ByteString.concat+            [ "name\n"+            , "bob\n"+            , "\"there,be,commas\"\n"+            , "\"the \"\" quote\"\n"+            ]+      , testCase "Headed Decoding (int,char,bool)" $+          (runIdentity . SMP.toList)+            ( S.decodeCsvUtf8+                decodingB+                ( mapM_ (SMP.yield . BC8.singleton) $+                    concat+                      [ "number,letter,boolean\n"+                      , "244,z,true\n"+                      ]+                )+            )+            @?= ([(244, intToWord8 (ord 'z'), True)] :> Nothing)+      , testCase "Headed Decoding (geolite)" $+          (runIdentity . SMP.toList)+            ( S.decodeCsvUtf8+                decodingGeolite+                ( SMP.yield $+                    BC8.pack $+                      concat+                        [ "network,autonomous_system_number,autonomous_system_organization\n"+                        , "1,z,y\n"+                        ]+                )+            )+            @?= ([(1, intToWord8 (ord 'z'), intToWord8 (ord 'y'))] :> Nothing)+      , testCase "Headed Decoding (escaped characters, one big chunk)" $+          (runIdentity . SMP.toList)+            ( S.decodeCsvUtf8+                decodingF+                ( SMP.yield $+                    BC8.pack $+                      concat+                        [ "name\n"+                        , "drew\n"+                        , "\"martin, drew\"\n"+                        ]+                )+            )+            @?= (["drew", "martin, drew"] :> Nothing)+      , testCase "Headed Decoding (escaped characters, character per chunk)" $+          (runIdentity . SMP.toList)+            ( S.decodeCsvUtf8+                decodingF+                ( mapM_ (SMP.yield . BC8.singleton) $+                    concat+                      [ "name\n"+                      , "drew\n"+                      , "\"martin, drew\"\n"+                      ]+                )+            )+            @?= (["drew", "martin, drew"] :> Nothing)+      , testCase "Headed Decoding (escaped characters, character per chunk, CRLF)" $+          (runIdentity . SMP.toList)+            ( S.decodeCsvUtf8+                decodingF+                ( mapM_ (SMP.yield . BC8.singleton) $+                    concat+                      [ "name\r\n"+                      , "drew\r\n"+                      , "\"martin, drew\"\r\n"+                      ]+                )+            )+            @?= (["drew", "martin, drew"] :> Nothing)+      , testCase "headedToIndexed" $+          let actual = S.headedToIndexed id (Vector.fromList ["letter", "boolean", "number"]) decodingG+           in case actual of+                Left e -> fail "headedToIndexed failed"+                Right actualInner ->+                  let expected =+                        SiphonAp (Indexed 2 :: Indexed Text) (\_ -> Nothing) $+                          SiphonAp (Indexed 0 :: Indexed Text) (\_ -> Nothing) $+                            SiphonAp (Indexed 1 :: Indexed Text) (\_ -> Nothing) $+                              SiphonPure (\_ _ _ -> ())+                   in case S.eqSiphonHeaders actualInner expected of+                        True -> pure ()+                        False ->+                          fail $+                            "Expected "+                              ++ S.showSiphonHeaders expected+                              ++ " but got "+                              ++ S.showSiphonHeaders actualInner+      , testCase "Indexed Decoding (int,char,bool)" $+          (runIdentity . SMP.toList)+            ( S.decodeIndexedCsvUtf8+                3+                indexedDecodingB+                ( mapM_ (SMP.yield . BC8.singleton) $+                    concat+                      [ "244,z,true\n"+                      ]+                )+            )+            @?= ([(244, intToWord8 (ord 'z'), True)] :> Nothing)+      , testProperty "Headed Isomorphism (int,char,bool)" $+          propIsoStream+            BC8.unpack+            (S.decodeCsvUtf8 decodingB)+            (S.encodeCsvStreamUtf8 encodingB)+      ]   ]  intToWord8 :: Int -> Word8 intToWord8 = fromIntegral  data Foo = FooA | FooB | FooC-  deriving (Generic,Eq,Ord,Show,Read,Bounded,Enum)+  deriving (Generic, Eq, Ord, Show, Read, Bounded, Enum)  instance Arbitrary Foo where-  arbitrary = elements [minBound..maxBound]+  arbitrary = elements [minBound .. maxBound]  fooToString :: Foo -> String fooToString x = case x of@@ -179,118 +202,131 @@ decodeFoo :: (c -> String) -> c -> Maybe Foo decodeFoo f = fooFromString . f -decodingA :: Siphon Headless ByteString (Int,Char,Bool)-decodingA = (,,)-  <$> S.headless dbInt-  <*> S.headless dbChar-  <*> S.headless dbBool+decodingA :: Siphon Headless ByteString (Int, Char, Bool)+decodingA =+  (,,)+    <$> S.headless dbInt+    <*> S.headless dbChar+    <*> S.headless dbBool -decodingB :: Siphon Headed ByteString (Int,Word8,Bool)-decodingB = (,,)-  <$> S.headed "number" dbInt-  <*> S.headed "letter" dbWord8-  <*> S.headed "boolean" dbBool+decodingB :: Siphon Headed ByteString (Int, Word8, Bool)+decodingB =+  (,,)+    <$> S.headed "number" dbInt+    <*> S.headed "letter" dbWord8+    <*> S.headed "boolean" dbBool -indexedDecodingB :: Siphon Indexed ByteString (Int,Word8,Bool)-indexedDecodingB = (,,)-  <$> S.indexed 0 dbInt-  <*> S.indexed 1 dbWord8-  <*> S.indexed 2 dbBool+indexedDecodingB :: Siphon Indexed ByteString (Int, Word8, Bool)+indexedDecodingB =+  (,,)+    <$> S.indexed 0 dbInt+    <*> S.indexed 1 dbWord8+    <*> S.indexed 2 dbBool  decodingG :: Siphon Headed Text () decodingG =   S.headed "number" (\_ -> Nothing)-  <* S.headed "letter" (\_ -> Nothing)-  <* S.headed "boolean" (\_ -> Nothing)+    <* S.headed "letter" (\_ -> Nothing)+    <* S.headed "boolean" (\_ -> Nothing)  decodingF :: Siphon Headed ByteString ByteString decodingF = S.headed "name" Just -decodingGeolite :: Siphon Headed ByteString (Int,Word8,Word8)-decodingGeolite = (,,)-  <$> S.headed "network" dbInt-  <*> S.headed "autonomous_system_number" dbWord8-  <*> S.headed "autonomous_system_organization" dbWord8-+decodingGeolite :: Siphon Headed ByteString (Int, Word8, Word8)+decodingGeolite =+  (,,)+    <$> S.headed "network" dbInt+    <*> S.headed "autonomous_system_number" dbWord8+    <*> S.headed "autonomous_system_organization" dbWord8 -encodingA :: Colonnade Headless (Int,Char,Bool) ByteString-encodingA = mconcat-  [ lmap fst3 (headless ebInt)-  , lmap snd3 (headless ebChar)-  , lmap thd3 (headless ebBool)-  ]+encodingA :: Colonnade Headless (Int, Char, Bool) ByteString+encodingA =+  mconcat+    [ lmap fst3 (headless ebInt)+    , lmap snd3 (headless ebChar)+    , lmap thd3 (headless ebBool)+    ] -encodingW :: Colonnade Headless (Int,Char,Bool) Text-encodingW = mconcat-  [ lmap fst3 (headless etInt)-  , lmap snd3 (headless etChar)-  , lmap thd3 (headless etBool)-  ]+encodingW :: Colonnade Headless (Int, Char, Bool) Text+encodingW =+  mconcat+    [ lmap fst3 (headless etInt)+    , lmap snd3 (headless etChar)+    , lmap thd3 (headless etBool)+    ] -encodingY :: Colonnade Headless (Foo,Foo,Foo) Text-encodingY = mconcat-  [ lmap fst3 (headless $ encodeFoo Text.pack)-  , lmap snd3 (headless $ encodeFoo Text.pack)-  , lmap thd3 (headless $ encodeFoo Text.pack)-  ]+encodingY :: Colonnade Headless (Foo, Foo, Foo) Text+encodingY =+  mconcat+    [ lmap fst3 (headless $ encodeFoo Text.pack)+    , lmap snd3 (headless $ encodeFoo Text.pack)+    , lmap thd3 (headless $ encodeFoo Text.pack)+    ] -decodingY :: Siphon Headless Text (Foo,Foo,Foo)-decodingY = (,,)-  <$> S.headless (decodeFoo Text.unpack)-  <*> S.headless (decodeFoo Text.unpack)-  <*> S.headless (decodeFoo Text.unpack)+decodingY :: Siphon Headless Text (Foo, Foo, Foo)+decodingY =+  (,,)+    <$> S.headless (decodeFoo Text.unpack)+    <*> S.headless (decodeFoo Text.unpack)+    <*> S.headless (decodeFoo Text.unpack)  encodingF :: Colonnade Headed ByteString ByteString encodingF = headed "name" id -encodingB :: Colonnade Headed (Int,Word8,Bool) ByteString-encodingB = mconcat-  [ lmap fst3 (headed "number" ebInt)-  , lmap snd3 (headed "letter" ebWord8)-  , lmap thd3 (headed "boolean" ebBool)-  ]+encodingB :: Colonnade Headed (Int, Word8, Bool) ByteString+encodingB =+  mconcat+    [ lmap fst3 (headed "number" ebInt)+    , lmap snd3 (headed "letter" ebWord8)+    , lmap thd3 (headed "boolean" ebBool)+    ] -encodingC :: Colonnade Headed (Int,Char,Bool) ByteString-encodingC = mconcat-  [ lmap thd3 $ headed "boolean" ebBool-  , lmap snd3 $ headed "letter" ebChar-  ]+encodingC :: Colonnade Headed (Int, Char, Bool) ByteString+encodingC =+  mconcat+    [ lmap thd3 $ headed "boolean" ebBool+    , lmap snd3 $ headed "letter" ebChar+    ] -tripleToPairs :: (a,b,c) -> (a,(b,(c,())))-tripleToPairs (a,b,c) = (a,(b,(c,())))+tripleToPairs :: (a, b, c) -> (a, (b, (c, ())))+tripleToPairs (a, b, c) = (a, (b, (c, ()))) -propIsoStream :: (Eq a, Show a, Monoid c)-  => (c -> String)-  -> (Stream (Of c) Identity () -> Stream (Of a) Identity (Maybe SiphonError))-  -> (Stream (Of a) Identity () -> Stream (Of c) Identity ())-  -> [a]-  -> Result+propIsoStream ::+  (Eq a, Show a, Monoid c) =>+  (c -> String) ->+  (Stream (Of c) Identity () -> Stream (Of a) Identity (Maybe SiphonError)) ->+  (Stream (Of a) Identity () -> Stream (Of c) Identity ()) ->+  [a] ->+  Result propIsoStream toStr decode encode as =   let asNew :> m = runIdentity $ SMP.toList $ decode $ encode $ SMP.each as    in case m of-        Nothing -> if as == asNew-          then succeeded-          else exception ("expected " ++ show as ++ " but got " ++ show asNew) myException+        Nothing ->+          if as == asNew+            then succeeded+            else exception ("expected " ++ show as ++ " but got " ++ show asNew) myException         Just err ->           let csv = toStr $ mconcat $ runIdentity $ SMP.toList_ $ encode $ SMP.each as            in exception (S.humanizeSiphonError err ++ "\nGenerated CSV\n" ++ csv) myException  data MyException = MyException-  deriving (Show,Read,Eq)+  deriving (Show, Read, Eq) instance Exception MyException  myException :: SomeException myException = SomeException MyException -runTestScenario :: (Monoid c, Eq c, Show c, Eq a, Show a)-  => [a]-  -> (Colonnade f a c -> Stream (Of a) Identity () -> Stream (Of c) Identity ())-  -> Colonnade f a c-  -> c-  -> Assertion+runTestScenario ::+  (Monoid c, Eq c, Show c, Eq a, Show a) =>+  [a] ->+  (Colonnade f a c -> Stream (Of a) Identity () -> Stream (Of c) Identity ()) ->+  Colonnade f a c ->+  c ->+  Assertion runTestScenario as p e c =   ( mconcat (runIdentity (SMP.toList_ (p e (mapM_ SMP.yield as))))-  ) @?= c+  )+    @?= c  -- runCustomTestScenario :: (Monoid c, Eq c, Show c) --   => Siphon c@@ -307,25 +343,23 @@ -- testEncodingA :: Assertion -- testEncodingA = runTestScenario encodingA "4,c,false\n" -propEncodeDecodeIso :: Eq a => (a -> b) -> (b -> Maybe a) -> a -> Bool+propEncodeDecodeIso :: (Eq a) => (a -> b) -> (b -> Maybe a) -> a -> Bool propEncodeDecodeIso f g a = g (f a) == Just a -propMatching :: Eq b => (a -> b) -> (a -> b) -> a -> Bool+propMatching :: (Eq b) => (a -> b) -> (a -> b) -> a -> Bool propMatching f g a = f a == g a - -- | Take the first item out of a 3 element tuple-fst3 :: (a,b,c) -> a-fst3 (a,b,c) = a+fst3 :: (a, b, c) -> a+fst3 (a, b, c) = a  -- | Take the second item out of a 3 element tuple-snd3 :: (a,b,c) -> b-snd3 (a,b,c) = b+snd3 :: (a, b, c) -> b+snd3 (a, b, c) = b  -- | Take the third item out of a 3 element tuple-thd3 :: (a,b,c) -> c-thd3 (a,b,c) = c-+thd3 :: (a, b, c) -> c+thd3 (a, b, c) = c  dbChar :: ByteString -> Maybe Char dbChar b = case BC8.length b of@@ -339,7 +373,7 @@  dbInt :: ByteString -> Maybe Int dbInt b = do-  (a,bsRem) <- BC8.readInt b+  (a, bsRem) <- BC8.readInt b   if ByteString.null bsRem     then Just a     else Nothing@@ -357,8 +391,9 @@ ebWord8 = B.singleton  ebInt :: Int -> ByteString-ebInt = LByteString.toStrict-    . Builder.toLazyByteString +ebInt =+  LByteString.toStrict+    . Builder.toLazyByteString     . Builder.intDec  ebBool :: Bool -> ByteString@@ -369,12 +404,12 @@ ebByteString :: ByteString -> ByteString ebByteString = id - etChar :: Char -> Text etChar = Text.singleton  etInt :: Int -> Text-etInt = LText.toStrict+etInt =+  LText.toStrict     . TBuilder.toLazyText     . TBuilder.decimal @@ -385,4 +420,3 @@ etBool x = case x of   True -> Text.pack "true"   False -> Text.pack "false"-