siphon 0.6 → 0.7

raw patch · 11 files changed

+851/−1051 lines, 11 filesdep +streamingdep +transformersdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: streaming, transformers

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• siphon.cabal +22/−29
• src/Siphon.hs +651/−7
• src/Siphon/ByteString/Char8.hs +0/−1
• src/Siphon/Content.hs +0/−8
• src/Siphon/Decoding.hs +0/−339
• src/Siphon/Encoding.hs +0/−30
• src/Siphon/Internal.hs +0/−214
• src/Siphon/Internal/Text.hs +0/−189
• src/Siphon/Text.hs +0/−33
• src/Siphon/Types.hs +53/−98
• test/Test.hs +125/−103

@@ -1,44 +1,37 @@-name:                siphon-version:             0.6-synopsis:            Encode and decode CSV files-description:         Please see README.md-homepage:            https://github.com/andrewthad/colonnade#readme-license:             BSD3-license-file:        LICENSE-author:              Andrew Martin-maintainer:          andrew.thaddeus@gmail.com-copyright:           2016 Andrew Martin-category:            web-build-type:          Simple-cabal-version:       >=1.10+name: siphon+version: 0.7+synopsis: Encode and decode CSV files+description: Please see README.md+homepage: https://github.com/andrewthad/colonnade#readme+license: BSD3+license-file: LICENSE+author: Andrew Martin+maintainer: andrew.thaddeus@gmail.com+copyright: 2016 Andrew Martin+category: web+build-type: Simple+cabal-version: >=1.10  library   hs-source-dirs:      src   exposed-modules:-    Siphon.Text-    Siphon.ByteString.Char8     Siphon     Siphon.Types-    Siphon.Content-    Siphon.Encoding-    Siphon.Decoding-    Siphon.Internal-    Siphon.Internal.Text   build-depends:-      base >= 4.7 && < 5+      base >= 4.9 && < 5     , colonnade >= 1.1 && < 1.2     , text     , bytestring-    , contravariant     , vector-    , pipes+    , streaming     , attoparsec+    , transformers   default-language:    Haskell2010  test-suite siphon-test-  type:                exitcode-stdio-1.0-  hs-source-dirs:      test-  main-is:             Test.hs+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Test.hs   build-depends:       base     , either@@ -54,9 +47,9 @@     , HUnit     , test-framework-hunit     , profunctors-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N-  default-language:    Haskell2010+    , streaming+  default-language: Haskell2010  source-repository head-  type:     git+  type: git   location: https://github.com/andrewthad/colonnade

@@ -1,11 +1,655 @@-module Siphon where+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-} --- encode :: Pipe a (Vector c) m x--- encode--- decode :: Pipe (Vector c) a m x+-- {-# OPTIONS_GHC -Wall -Werr -fno-warn-unused-imports #-} --- encode ::+module Siphon+  ( Siphon+  , SiphonError+  , Indexed(..)+  , decodeHeadedUtf8Csv+  , encodeHeadedUtf8Csv+  , humanizeSiphonError+  , headed+  , headless+  , indexed+  ) where --- row :: Vector (Escaped Text) -> Text--- row = Vector.+import Siphon.Types+import Data.Monoid+import Control.Applicative+import Control.Monad++import qualified Data.ByteString.Char8 as BC8+import qualified Data.Attoparsec.ByteString as A+import qualified Data.Attoparsec.Lazy as AL+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.Builder as Builder+import qualified Data.Text as T+import qualified Data.List as L+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 Control.Monad.Trans.Class+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++newtype Escaped c = Escaped { getEscaped :: c }+data Ended = EndedYes | EndedNo+  deriving (Show)+data CellResult c = CellResultData !c | CellResultNewline !c !Ended+  deriving (Show)++decodeHeadedUtf8Csv :: Monad m +  => Siphon CE.Headed ByteString a+  -> Stream (Of ByteString) m () -- ^ encoded csv+  -> Stream (Of a) m (Maybe SiphonError)+decodeHeadedUtf8Csv headedSiphon s1 = do+  e <- lift (consumeHeaderRowUtf8 s1)+  case e of+    Left err -> return (Just err)+    Right (v :> s2) -> case headedToIndexed utf8ToStr v headedSiphon of+      Left err -> return (Just err)+      Right ixedSiphon -> do+        let requiredLength = V.length v+        consumeBodyUtf8 1 requiredLength ixedSiphon s2++encodeHeadedUtf8Csv :: Monad m +  => CE.Colonnade CE.Headed a ByteString+  -> Stream (Of a) m r+  -> Stream (Of ByteString) m r+encodeHeadedUtf8Csv =+  encodeHeadedCsv escapeChar8 (B.singleton comma) (B.singleton newline)++encodeHeadedCsv :: Monad m+  => (c -> Escaped c)+  -> c -- ^ separator+  -> c -- ^ newline+  -> CE.Colonnade CE.Headed a c+  -> Stream (Of a) m r+  -> Stream (Of c) m r+encodeHeadedCsv escapeFunc separatorStr newlineStr colonnade s = do+  encodeHeader escapeFunc separatorStr newlineStr colonnade+  encodeRows escapeFunc separatorStr newlineStr colonnade s++encodeHeader :: Monad m+  => (c -> Escaped c)+  -> c -- ^ separator+  -> c -- ^ newline+  -> CE.Colonnade CE.Headed a c+  -> Stream (Of c) m ()+encodeHeader escapeFunc separatorStr newlineStr colonnade = do+  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.+  V.forM_ vs $ \(CE.OneColonnade (CE.Headed h) _) -> do+    SMP.yield (getEscaped (escapeFunc h))+  V.forM_ ws $ \(CE.OneColonnade (CE.Headed h) _) -> do+    SMP.yield separatorStr+    SMP.yield (getEscaped (escapeFunc h))+  SMP.yield newlineStr++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 escapeFunc separatorStr newlineStr colonnade = mapStreamM $ \a -> do+  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.+  V.forM_ vs $ \(CE.OneColonnade _ encode) -> SMP.yield (getEscaped (escapeFunc (encode a)))+  V.forM_ ws $ \(CE.OneColonnade _ encode) -> do+    SMP.yield separatorStr+    SMP.yield (getEscaped (escapeFunc (encode a)))+  SMP.yield newlineStr++data IndexedHeader a = IndexedHeader+  { indexedHeaderIndexed :: {-# UNPACK #-} !Int+  , indexedHeaderHeader :: !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)+  -> Vector c -- ^ Headers in the source document+  -> Siphon CE.Headed c a -- ^ Decolonnade that contains expected headers+  -> Either SiphonError (Siphon IndexedHeader 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 IndexedHeader c b)+  go (SiphonPure b) = EitherWrap (Right (SiphonPure b))+  go (SiphonAp (CE.Headed h) decode apNext) =+    let rnext = go apNext+        ixs = V.elemIndices h v+        ixsLen = V.length ixs+        rcurrent+          | ixsLen == 1 = Right (ixs V.! 0) -- (V.unsafeIndex ixs 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)+               in Left (HeaderErrors dups V.empty V.empty)+    in (\ix nextSiphon -> SiphonAp (IndexedHeader ix h) decode nextSiphon)+       <$> EitherWrap rcurrent+       <*> rnext++data HeaderErrors = HeaderErrors !(Vector (Vector CellError)) !(Vector T.Text) !(Vector Int)++instance Monoid HeaderErrors where+  mempty = HeaderErrors mempty mempty mempty+  mappend (HeaderErrors a1 b1 c1) (HeaderErrors a2 b2 c2) = HeaderErrors+    (mappend a1 a2) (mappend b1 b2) (mappend c1 c2)++-- byteStringChar8 :: Siphon ByteString+-- byteStringChar8 = Siphon+--   escape+--   encodeRow+--   (A.parse (row comma))+--   B.null++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++-- | 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++-- | Specialized version of 'sepBy1'' which is faster due to not+-- accepting an arbitrary separator.+sepByDelim1' :: AL.Parser a+             -> Word8  -- ^ Field delimiter+             -> AL.Parser [a]+sepByDelim1' p !delim = liftM2' (:) p loop+  where+    loop = do+        mb <- A.peekWord8+        case mb of+            Just b | b == delim -> liftM2' (:) (A.anyWord8 *> p) loop+            _                   -> pure []+{-# INLINE sepByDelim1' #-}++-- | Parse a record, not including the terminating line separator. The+-- terminating line separate is not included as the last record in a+-- CSV file is allowed to not have a terminating line separator. You+-- most likely want to use the 'endOfLine' parser in combination with+-- this parser.+-- row :: Word8  -- ^ Field delimiter+--     -> 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.+field :: Word8 -> AL.Parser (CellResult ByteString)+field !delim = do+  mb <- A.peekWord8+  -- We purposely don't use <|> as we want to commit to the first+  -- choice if we see a double quote.+  case mb of+    Just b+      | b == doubleQuote -> do+          bs <- escapedField delim+          return (CellResultData bs)+      | b == 10 || b == 13 -> do+          _ <- eatNewlines+          isEnd <- A.atEnd+          if isEnd+            then return (CellResultNewline B.empty EndedYes)+            else return (CellResultNewline B.empty EndedNo)+      | otherwise -> do+          (bs,tc) <- unescapedField delim+          case tc of+            TrailCharComma -> return (CellResultData bs)+            TrailCharNewline -> return (CellResultNewline bs EndedNo)+            TrailCharEnd -> return (CellResultNewline bs EndedYes)+    Nothing -> return (CellResultNewline B.empty EndedYes)+{-# INLINE field #-}++eatNewlines :: AL.Parser S.ByteString+eatNewlines = A.takeWhile (\x -> x == 10 || x == 13)++escapedField :: Word8 -> AL.Parser S.ByteString+escapedField !delim = 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)+  A.option () (A.skip (== delim))+  if doubleQuote `S.elem` s+      then case Z.parse unescape s of+          Right r  -> return r+          Left err -> fail err+      else return s++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)+unescapedField !delim = do+  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 || b == cr -> A.anyWord8 >> return (bs,TrailCharNewline)+      | otherwise -> fail "encounter double quote in unescaped field"+    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.+unescape :: Z.Parser S.ByteString+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"+    done <- Z.atEnd+    if done+      then return (acc `mappend` byteString h)+      else rest++-- | Is this an empty record (i.e. a blank line)?+blankLine :: V.Vector B.ByteString -> Bool+blankLine v = V.length v == 1 && (B.null (V.head v))++-- | A version of 'liftM2' that is strict in the result of its first+-- action.+liftM2' :: (Monad m) => (a -> b -> c) -> m a -> m b -> m c+liftM2' f a b = do+    !x <- a+    y <- b+    return (f x y)+{-# INLINE liftM2' #-}+++-- | Match either a single newline character @\'\\n\'@, or a carriage+-- return followed by a newline character @\"\\r\\n\"@, or a single+-- carriage return @\'\\r\'@.+endOfLine :: A.Parser ()+endOfLine = (A.word8 newline *> return ()) <|> (string (BC8.pack "\r\n") *> return ()) <|> (A.word8 cr *> return ())+{-# INLINE endOfLine #-}++doubleQuote, newline, cr, comma :: Word8+doubleQuote = 34+newline = 10+cr = 13+comma = 44++-- | 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++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 []+    ]+  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+    ]++prettyNamedMissingHeaders :: Vector T.Text -> [String]+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+  f :: Vector CellError -> [String]+  f v+    | not (V.null w) && V.all (== V.head w) (V.tail w) =+        [ "The header ["+        , T.unpack (V.head w)+        , "] 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+    w :: Vector T.Text+    w = V.map cellErrorContent v+    multiMsg :: String+    multiMsg = "Multiple headers matched the same predicate:"++columnNumToLetters :: Int -> String+columnNumToLetters i+  | i >= 0 && i < 25 = [chr (i + 65)]+  | otherwise = "Beyond Z. Fix this."++newtype EitherWrap a b = EitherWrap+  { getEitherWrap :: Either a b+  } deriving (Functor)++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)+  EitherWrap (Right _) <*> EitherWrap (Left a2) = EitherWrap (Left a2)+  EitherWrap (Right f) <*> EitherWrap (Right b) = EitherWrap (Right (f b))++mapLeft :: (a -> b) -> Either a c -> Either b c+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 = consumeHeaderRow utf8ToStr (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 IndexedHeader 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 -> T.Text)+  -> (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 toStr 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)))+  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)+      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 !cellsLen !cells !result s1 = case result of+    ATYP.Fail _ _ _ -> return $ Left $ SiphonError 0 RowErrorParse+    ATYP.Done !c1 !res -> case res of+      -- it might be wrong to ignore whether or not the stream has ended+      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+    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 IndexedHeader 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+  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)+      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 !row !cellsLen !cells !result s1 = case result of+    ATYP.Fail _ _ _ -> return $ Just $ SiphonError row RowErrorParse+    ATYP.Done !c1 !res -> case res of+      CellResultNewline !cd !ended -> do+        case decodeRow row (reverseVectorStrictList (cellsLen + 1) (StrictListCons cd cells)) of+          Left err -> return (Just err)+          Right a -> do+            SMP.yield a+            case ended of+              EndedYes -> do+                e <- lift (SM.inspect s1)+                case e of+                  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+    ATYP.Partial k -> do+      e <- lift (skipWhile isNull s1)+      case e of+        Left r -> handleResult row cellsLen cells (k emptyStr) (return r)+        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++-- | 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+  go1 :: forall s. MVector s c -> ST s ()+  go1 !mv = go2 0 sl0+    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)))+  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++-- | Strict in the spine and in the values+data StrictList a = StrictListNil | StrictListCons !a !(StrictList a)++-- | This function uses 'unsafeIndex' to access+--   elements of the 'Vector'.+uncheckedRunWithRow ::+     (c -> T.Text)+  -> Int+  -> Siphon IndexedHeader 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 IndexedHeader c a+  -> Vector c+  -> Either (Vector CellError) a+uncheckedRun toStr dc v = getEitherWrap (go dc)+  where+  go :: forall b.+        Siphon IndexedHeader c b+     -> EitherWrap (Vector CellError) b+  go (SiphonPure b) = EitherWrap (Right b)+  go (SiphonAp (IndexedHeader 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)++siphonLength :: forall f c a. Siphon f c a -> Int+siphonLength = go 0 where+  go :: forall b. Int -> Siphon f c b -> Int+  go !a (SiphonPure _) = a+  go !a (SiphonAp _ _ apNext) = go (a + 1) apNext++maxIndex :: forall c a. Siphon IndexedHeader c a -> Int+maxIndex = go 0 where+  go :: forall b. Int -> Siphon IndexedHeader c b -> Int+  go !ix (SiphonPure _) = ix+  go !ix1 (SiphonAp (IndexedHeader ix2 _) _ apNext) =+    go (max ix1 ix2) apNext++headless :: (c -> Maybe a) -> Siphon CE.Headless c a+headless f = SiphonAp CE.Headless f (SiphonPure id)++headed :: c -> (c -> Maybe a) -> Siphon CE.Headed c a+headed h f = SiphonAp (CE.Headed h) f (SiphonPure id)++indexed :: Int -> (c -> Maybe a) -> Siphon Indexed c a+indexed ix f = SiphonAp (Indexed ix) f (SiphonPure id) 

@@ -1,1 +0,0 @@-module Siphon.ByteString.Char8 where

@@ -1,8 +0,0 @@-module Siphon.Content-  ( byteStringChar8-  , text-  ) where--import Siphon.Internal (byteStringChar8)-import Siphon.Internal.Text (text)-

@@ -1,339 +0,0 @@-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE DeriveFunctor #-}--module Siphon.Decoding -  ( mkParseError-  , headlessPipe-  , indexedPipe-  , headedPipe-  , consumeGeneral-  , pipeGeneral-  , convertDecodeError-  , headed-  , headless-  , indexed-  ) where--import Siphon.Types-import Colonnade (Headed(..),Headless(..))-import Siphon.Internal (row,comma)-import Data.Text (Text)-import Data.ByteString (ByteString)-import Pipes (yield,Pipe,Consumer',Producer,await)-import Data.Vector (Vector)-import Data.Functor.Contravariant (Contravariant(..))-import Data.Char (chr)-import qualified Data.Vector as Vector-import qualified Data.Attoparsec.ByteString as AttoByteString-import qualified Data.ByteString.Char8 as ByteString-import qualified Data.Attoparsec.Types as Atto--mkParseError :: Int -> [String] -> String -> DecolonnadeRowError f content-mkParseError i ctxs msg = id-  $ DecolonnadeRowError i-  $ RowErrorParse $ concat-    [ "Contexts: ["-    , concat ctxs-    , "], Error Message: ["-    , msg-    , "]"-    ]---- | This is a convenience function for working with @pipes-text@.---   It will convert a UTF-8 decoding error into a `DecolonnadeRowError`,---   so the pipes can be properly chained together.-convertDecodeError :: String -> Either (Producer ByteString m ()) () -> Maybe (DecolonnadeRowError f c)-convertDecodeError encodingName (Left _) = Just (DecolonnadeRowError 0 (RowErrorMalformed encodingName))-convertDecodeError _ (Right ()) = Nothing---- | This is seldom useful but is included for completeness.-headlessPipe :: Monad m-  => Siphon c-  -> Decolonnade Headless c a-  -> Pipe c a m (DecolonnadeRowError Headless c)-headlessPipe sd decoding = uncheckedPipe requiredLength 0 sd indexedDecoding Nothing-  where-  indexedDecoding = headlessToIndexed decoding-  requiredLength = decLength indexedDecoding--indexedPipe :: Monad m-  => Siphon c-  -> Decolonnade (Indexed Headless) c a-  -> Pipe c a m (DecolonnadeRowError Headless c)-indexedPipe sd decoding = do-  e <- consumeGeneral 0 sd mkParseError-  case e of-    Left err -> return err-    Right (firstRow, mleftovers) ->-      let req = maxIndex decoding-          vlen = Vector.length firstRow-       in if vlen < req-            then return (DecolonnadeRowError 0 (RowErrorMinSize req vlen))-            else case uncheckedRun decoding firstRow of-              Left cellErr -> return $ DecolonnadeRowError 0 $ RowErrorDecode cellErr-              Right a -> do-                yield a-                uncheckedPipe vlen 1 sd decoding mleftovers---headedPipe :: (Monad m, Eq c)-  => Siphon c-  -> Decolonnade Headed c a-  -> Pipe c a m (DecolonnadeRowError Headed c)-headedPipe sd decoding = do-  e <- consumeGeneral 0 sd mkParseError-  case e of-    Left err -> return err-    Right (headers, mleftovers) ->-      case headedToIndexed headers decoding of-        Left headingErrs -> return (DecolonnadeRowError 0 (RowErrorHeading headingErrs))-        Right indexedDecoding ->-          let requiredLength = Vector.length headers-           in uncheckedPipe requiredLength 1 sd indexedDecoding mleftovers---uncheckedPipe :: Monad m-  => Int -- ^ expected length of each row-  -> Int -- ^ index of first row, usually zero or one-  -> Siphon c-  -> Decolonnade (Indexed f) c a-  -> Maybe c-  -> Pipe c a m (DecolonnadeRowError f c)-uncheckedPipe requiredLength ix sd d mleftovers =-  pipeGeneral ix sd mkParseError checkedRunWithRow mleftovers-  where-  checkedRunWithRow rowIx v =-    let vlen = Vector.length v in-    if vlen /= requiredLength-      then Left $ DecolonnadeRowError rowIx-                $ RowErrorSize requiredLength vlen-      else uncheckedRunWithRow rowIx d v--consumeGeneral :: Monad m-  => Int-  -> Siphon c-  -> (Int -> [String] -> String -> e)-  -> Consumer' c m (Either e (Vector c, Maybe c))-consumeGeneral ix (Siphon _ _ parse isNull) wrapParseError = do-  c <- awaitSkip isNull-  handleResult (parse c)-  where-  go k = do-    c <- awaitSkip isNull-    handleResult (k c)-  handleResult r = case r of-    Atto.Fail _ ctxs msg -> return $ Left-      $ wrapParseError ix ctxs msg-    Atto.Done c v ->-      let mcontent = if isNull c-            then Nothing-            else Just c-       in return (Right (v,mcontent))-    Atto.Partial k -> go k--pipeGeneral :: Monad m-  => Int -- ^ index of first row, usually zero or one-  -> Siphon c-  -> (Int -> [String] -> String -> e)-  -> (Int -> Vector c -> Either e a)-  -> Maybe c -- ^ leftovers that should be handled first-  -> Pipe c a m e-pipeGeneral initIx (Siphon _ _ parse isNull) wrapParseError decodeRow mleftovers =-  case mleftovers of-    Nothing -> go1 initIx-    Just leftovers -> handleResult initIx (parse leftovers)-  where-  go1 !ix = do-    c1 <- awaitSkip isNull-    handleResult ix (parse c1)-  go2 !ix c1 = handleResult ix (parse c1)-  go3 !ix k = do-    c1 <- awaitSkip isNull-    handleResult ix (k c1)-  handleResult !ix r = case r of-    Atto.Fail _ ctxs msg -> return $ wrapParseError ix ctxs msg-    Atto.Done c1 v -> do-      case decodeRow ix v of-        Left err -> return err-        Right r -> do-          yield r-          let ixNext = ix + 1-          if isNull c1 then go1 ixNext else go2 ixNext c1-    Atto.Partial k -> go3 ix k--awaitSkip :: Monad m-          => (a -> Bool)-          -> Consumer' a m a-awaitSkip f = go where-  go = do-    a <- await-    if f a then go else return a---- | Converts the content type of a 'Decolonnade'. The @'Contravariant' f@--- constraint means that @f@ can be 'Headless' but not 'Headed'.-contramapContent :: forall c1 c2 f a. Contravariant f => (c2 -> c1) -> Decolonnade f c1 a -> Decolonnade f c2 a-contramapContent f = go-  where-  go :: forall b. Decolonnade f c1 b -> Decolonnade f c2 b-  go (DecolonnadePure x) = DecolonnadePure x-  go (DecolonnadeAp h decode apNext) =-    DecolonnadeAp (contramap f h) (decode . f) (go apNext)--headless :: (content -> Either String a) -> Decolonnade Headless content a-headless f = DecolonnadeAp Headless f (DecolonnadePure id)--headed :: content -> (content -> Either String a) -> Decolonnade Headed content a-headed h f = DecolonnadeAp (Headed h) f (DecolonnadePure id)--indexed :: Int -> (content -> Either String a) -> Decolonnade (Indexed Headless) content a-indexed ix f = DecolonnadeAp (Indexed ix Headless) f (DecolonnadePure id)--maxIndex :: forall f c a. Decolonnade (Indexed f) c a -> Int-maxIndex = go 0 where-  go :: forall b. Int -> Decolonnade (Indexed f) c b -> Int-  go !ix (DecolonnadePure _) = ix-  go !ix1 (DecolonnadeAp (Indexed ix2 _) decode apNext) =-    go (max ix1 ix2) apNext---- | This function uses 'unsafeIndex' to access---   elements of the 'Vector'.-uncheckedRunWithRow ::-     Int-  -> Decolonnade (Indexed f) content a-  -> Vector content-  -> Either (DecolonnadeRowError f content) a-uncheckedRunWithRow i d v = mapLeft (DecolonnadeRowError i . RowErrorDecode) (uncheckedRun d v)---- | This function does not check to make sure that the indicies in---   the 'Decolonnade' are in the 'Vector'.-uncheckedRun :: forall content a f.-                Decolonnade (Indexed f) content a-             -> Vector content-             -> Either (DecolonnadeCellErrors f content) a-uncheckedRun dc v = getEitherWrap (go dc)-  where-  go :: forall b.-        Decolonnade (Indexed f) content b-     -> EitherWrap (DecolonnadeCellErrors f content) b-  go (DecolonnadePure b) = EitherWrap (Right b)-  go (DecolonnadeAp ixed@(Indexed ix h) decode apNext) =-    let rnext = go apNext-        content = Vector.unsafeIndex v ix-        rcurrent = mapLeft (DecolonnadeCellErrors . Vector.singleton . DecolonnadeCellError content ixed) (decode content)-    in rnext <*> (EitherWrap rcurrent)--headlessToIndexed :: forall c a.-  Decolonnade Headless c a -> Decolonnade (Indexed Headless) c a-headlessToIndexed = go 0 where-  go :: forall b. Int -> Decolonnade Headless c b -> Decolonnade (Indexed Headless) c b-  go !ix (DecolonnadePure a) = DecolonnadePure a-  go !ix (DecolonnadeAp Headless decode apNext) =-    DecolonnadeAp (Indexed ix Headless) decode (go (ix + 1) apNext)--decLength :: forall f c a. Decolonnade f c a -> Int-decLength = go 0 where-  go :: forall b. Int -> Decolonnade f c b -> Int-  go !a (DecolonnadePure _) = a-  go !a (DecolonnadeAp _ _ apNext) = go (a + 1) apNext---- | Maps over a 'Decolonnade' that expects headers, converting these---   expected headers into the indices of the columns that they---   correspond to.-headedToIndexed :: forall content a. Eq content-                => Vector content -- ^ Headers in the source document-                -> Decolonnade Headed content a -- ^ Decolonnade that contains expected headers-                -> Either (HeadingErrors content) (Decolonnade (Indexed Headed) content a)-headedToIndexed v = getEitherWrap . go-  where-  go :: forall b. Eq content-     => Decolonnade Headed content b-     -> EitherWrap (HeadingErrors content) (Decolonnade (Indexed Headed) content b)-  go (DecolonnadePure b) = EitherWrap (Right (DecolonnadePure b))-  go (DecolonnadeAp hd@(Headed h) decode apNext) =-    let rnext = go apNext-        ixs = Vector.elemIndices h v-        ixsLen = Vector.length ixs-        rcurrent-          | ixsLen == 1 = Right (Vector.unsafeIndex ixs 0)-          | ixsLen == 0 = Left (HeadingErrors (Vector.singleton h) Vector.empty)-          | otherwise   = Left (HeadingErrors Vector.empty (Vector.singleton (h,ixsLen)))-    in (\ix ap -> DecolonnadeAp (Indexed ix hd) decode ap)-       <$> EitherWrap rcurrent-       <*> rnext---- | This adds one to the index because text editors consider---   line number to be one-based, not zero-based.-prettyError :: (c -> String) -> DecolonnadeRowError f c -> String-prettyError toStr (DecolonnadeRowError ix e) = unlines-  $ ("Decolonnade error on line " ++ show (ix + 1) ++ " of file.")-  : ("Error Category: " ++ descr)-  : map ("  " ++) errDescrs-  where (descr,errDescrs) = prettyRowError toStr e--prettyRowError :: (content -> String) -> RowError f content -> (String, [String])-prettyRowError toStr x = case x of-  RowErrorParse err -> (,) "CSV Parsing"-    [ "The line could not be parsed into cells correctly."-    , "Original parser error: " ++ err-    ]-  RowErrorSize reqLen actualLen -> (,) "Row Length"-    [ "Expected the row to have exactly " ++ show reqLen ++ " cells."-    , "The row only has " ++ show actualLen ++ " cells."-    ]-  RowErrorMinSize reqLen actualLen -> (,) "Row Min Length"-    [ "Expected the row to have at least " ++ show reqLen ++ " cells."-    , "The row only has " ++ show actualLen ++ " cells."-    ]-  RowErrorMalformed enc -> (,) "Text Decolonnade"-    [ "Tried to decode the input as " ++ enc ++ " text"-    , "There is a mistake in the encoding of the text."-    ]-  RowErrorHeading errs -> (,) "Header" (prettyHeadingErrors toStr errs)-  RowErrorDecode errs -> (,) "Cell Decolonnade" (prettyCellErrors toStr errs)--prettyCellErrors :: (c -> String) -> DecolonnadeCellErrors f c -> [String]-prettyCellErrors toStr (DecolonnadeCellErrors errs) = drop 1 $-  flip concatMap errs $ \(DecolonnadeCellError content (Indexed ix _) msg) ->-    let str = toStr content in-    [ "-----------"-    , "Column " ++ columnNumToLetters ix-    , "Original parse error: " ++ msg-    , "Cell Content Length: " ++ show (Prelude.length str)-    , "Cell Content: " ++ if null str-        then "[empty cell]"-        else str-    ]--prettyHeadingErrors :: (c -> String) -> HeadingErrors c -> [String]-prettyHeadingErrors conv (HeadingErrors missing duplicates) = concat-  [ concatMap (\h -> ["The header " ++ conv h ++ " was missing."]) missing-  , concatMap (\(h,n) -> ["The header " ++ conv h ++ " occurred " ++ show n ++ " times."]) duplicates-  ]--columnNumToLetters :: Int -> String-columnNumToLetters i-  | i >= 0 && i < 25 = [chr (i + 65)]-  | otherwise = "Beyond Z. Fix this."---newtype EitherWrap a b = EitherWrap-  { getEitherWrap :: Either a b-  } deriving (Functor)--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)-  EitherWrap (Right _) <*> EitherWrap (Left a2) = EitherWrap (Left a2)-  EitherWrap (Right f) <*> EitherWrap (Right b) = EitherWrap (Right (f b))--mapLeft :: (a -> b) -> Either a c -> Either b c-mapLeft _ (Right a) = Right a-mapLeft f (Left a) = Left (f a)-----

@@ -1,30 +0,0 @@-module Siphon.Encoding where--import Siphon.Types-import Colonnade (Colonnade,Headed)-import Pipes (Pipe,yield)-import qualified Pipes.Prelude as Pipes-import qualified Colonnade.Encode as E--row :: Siphon c -> Colonnade f a c -> a -> c-row (Siphon escape intercalate _ _) e =-  intercalate . E.row escape e--header :: Siphon c -> Colonnade Headed a c -> c-header (Siphon escape intercalate _ _) e =-  intercalate (E.header escape e)--pipe :: Monad m-  => Siphon c-  -> Colonnade f a c-  -> Pipe a c m x-pipe siphon encoding = Pipes.map (row siphon encoding)--headedPipe :: Monad m-  => Siphon c-  -> Colonnade Headed a c-  -> Pipe a c m x-headedPipe siphon encoding = do-  yield (header siphon encoding)-  pipe siphon encoding-

@@ -1,214 +0,0 @@-{-# LANGUAGE BangPatterns #-}---- | A CSV parser. The parser defined here is RFC 4180 compliant, with--- the following extensions:------  * Empty lines are ignored.------  * Non-escaped fields may contain any characters except---    double-quotes, commas, carriage returns, and newlines.------  * Escaped fields may contain any characters (but double-quotes---    need to be escaped).------ The functions in this module can be used to implement e.g. a--- resumable parser that is fed input incrementally.-module Siphon.Internal where--import Siphon.Types--import Data.ByteString.Builder (toLazyByteString,byteString)-import qualified Data.ByteString.Char8 as BC8-import Control.Applicative (optional)-import Data.Attoparsec.ByteString.Char8 (char, endOfInput, string)-import qualified Data.Attoparsec.ByteString as A-import qualified Data.Attoparsec.Lazy as AL-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.Builder as Builder-import qualified Data.Text as T-import Data.Word (Word8)-import Data.Vector (Vector)-import Data.ByteString (ByteString)-import Data.Coerce (coerce)-import Siphon.Types--import Control.Applicative-import Data.Monoid--byteStringChar8 :: Siphon ByteString-byteStringChar8 = Siphon-  escape-  encodeRow-  (A.parse (row comma))-  B.null--encodeRow :: Vector (Escaped ByteString) -> ByteString-encodeRow = id-  . flip B.append (B.singleton newline)-  . B.intercalate (B.singleton comma)-  . V.toList-  . coerce--escape :: ByteString -> Escaped ByteString-escape t = case B.find (\c -> c == newline || c == cr || c == comma || c == doubleQuote) t of-  Nothing -> Escaped t-  Just _  -> escapeAlways 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---- | Specialized version of 'sepBy1'' which is faster due to not--- accepting an arbitrary separator.-sepByDelim1' :: AL.Parser a-             -> Word8  -- ^ Field delimiter-             -> AL.Parser [a]-sepByDelim1' p !delim = liftM2' (:) p loop-  where-    loop = do-        mb <- A.peekWord8-        case mb of-            Just b | b == delim -> liftM2' (:) (A.anyWord8 *> p) loop-            _                   -> pure []-{-# INLINE sepByDelim1' #-}---- | Specialized version of 'sepBy1'' which is faster due to not--- accepting an arbitrary separator.-sepByEndOfLine1' :: AL.Parser a-                 -> AL.Parser [a]-sepByEndOfLine1' p = liftM2' (:) p loop-  where-    loop = do-        mb <- A.peekWord8-        case mb of-            Just b | b == cr ->-                liftM2' (:) (A.anyWord8 *> A.word8 newline *> p) loop-                   | b == newline ->-                liftM2' (:) (A.anyWord8 *> p) loop-            _ -> pure []-{-# INLINE sepByEndOfLine1' #-}---- | Parse a record, not including the terminating line separator. The--- terminating line separate is not included as the last record in a--- CSV file is allowed to not have a terminating line separator. You--- most likely want to use the 'endOfLine' parser in combination with--- this parser.-row :: Word8  -- ^ Field delimiter-    -> 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.-field :: Word8 -> AL.Parser ByteString-field !delim = do-    mb <- A.peekWord8-    -- We purposely don't use <|> as we want to commit to the first-    -- choice if we see a double quote.-    case mb of-        Just b | b == doubleQuote -> escapedField-        _                         -> unescapedField delim-{-# INLINE field #-}--escapedField :: AL.Parser S.ByteString-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)-    if doubleQuote `S.elem` s-        then case Z.parse unescape s of-            Right r  -> return r-            Left err -> fail err-        else return s--unescapedField :: Word8 -> AL.Parser S.ByteString-unescapedField !delim = A.takeWhile (\ c -> c /= doubleQuote &&-                                            c /= newline &&-                                            c /= delim &&-                                            c /= cr)--dquote :: AL.Parser Char-dquote = char '"'---- | 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-  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"-    done <- Z.atEnd-    if done-      then return (acc `mappend` byteString h)-      else rest---- | A strict version of 'Data.Functor.<$>' for monads.-(<$!>) :: Monad m => (a -> b) -> m a -> m b-f <$!> m = do-    a <- m-    return $! f a-{-# INLINE (<$!>) #-}--infixl 4 <$!>---- | Is this an empty record (i.e. a blank line)?-blankLine :: V.Vector B.ByteString -> Bool-blankLine v = V.length v == 1 && (B.null (V.head v))---- | A version of 'liftM2' that is strict in the result of its first--- action.-liftM2' :: (Monad m) => (a -> b -> c) -> m a -> m b -> m c-liftM2' f a b = do-    !x <- a-    y <- b-    return (f x y)-{-# INLINE liftM2' #-}----- | Match either a single newline character @\'\\n\'@, or a carriage--- return followed by a newline character @\"\\r\\n\"@, or a single--- carriage return @\'\\r\'@.-endOfLine :: A.Parser ()-endOfLine = (A.word8 newline *> return ()) <|> (string (BC8.pack "\r\n") *> return ()) <|> (A.word8 cr *> return ())-{-# INLINE endOfLine #-}--doubleQuote, newline, cr, comma :: Word8-doubleQuote = 34-newline = 10-cr = 13-comma = 44-

@@ -1,189 +0,0 @@-{-# LANGUAGE BangPatterns #-}--module Siphon.Internal.Text where--import Siphon.Types--import Control.Applicative (optional)-import Data.Attoparsec.Text (char, endOfInput, string)-import qualified Data.Attoparsec.Text as A-import qualified Data.Attoparsec.Text.Lazy as AL-import qualified Data.Attoparsec.Zepto as Z-import qualified Data.Text as T-import qualified Data.Text as Text-import qualified Data.Vector as V-import qualified Data.Text.Lazy as LText-import qualified Data.Text.Lazy.Builder as Builder-import Data.Text.Lazy.Builder (Builder)-import Data.Word (Word8)-import Data.Vector (Vector)-import Data.Text (Text)-import Data.Coerce (coerce)-import Siphon.Types--import Control.Applicative-import Data.Monoid--text :: Siphon Text-text = Siphon-  escape-  encodeRow-  (A.parse (row comma))-  Text.null--encodeRow :: Vector (Escaped Text) -> Text-encodeRow = id-  . flip Text.append (Text.singleton newline)-  . Text.intercalate (Text.singleton comma)-  . V.toList-  . coerce--escape :: Text -> Escaped Text-escape t = case Text.find (\c -> c == newline || c == cr || c == comma || c == doubleQuote) t of-  Nothing -> Escaped t-  Just _  -> escapeAlways 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 text by writing to a buffer directly.-escapeAlways :: Text -> Escaped Text-escapeAlways t = Escaped $ Text.concat-  [ textDoubleQuote-  , Text.replace textDoubleQuote (Text.pack [doubleQuote,doubleQuote]) t-  , textDoubleQuote-  ]---- | Specialized version of 'sepBy1'' which is faster due to not--- accepting an arbitrary separator.-sepByDelim1' :: A.Parser a-             -> Char  -- ^ Field delimiter-             -> A.Parser [a]-sepByDelim1' p !delim = liftM2' (:) p loop-  where-    loop = do-        mb <- A.peekChar-        case mb of-            Just b | b == delim -> liftM2' (:) (A.anyChar *> p) loop-            _                   -> pure []-{-# INLINE sepByDelim1' #-}---- | Specialized version of 'sepBy1'' which is faster due to not--- accepting an arbitrary separator.-sepByEndOfLine1' :: A.Parser a-                 -> A.Parser [a]-sepByEndOfLine1' p = liftM2' (:) p loop-  where-    loop = do-        mb <- A.peekChar-        case mb of-            Just b | b == cr ->-                liftM2' (:) (A.anyChar *> A.char newline *> p) loop-                   | b == newline ->-                liftM2' (:) (A.anyChar *> p) loop-            _ -> pure []-{-# INLINE sepByEndOfLine1' #-}---- | Parse a record, not including the terminating line separator. The--- terminating line separate is not included as the last record in a--- CSV file is allowed to not have a terminating line separator. You--- most likely want to use the 'endOfLine' parser in combination with--- this parser.-row :: Char  -- ^ Field delimiter-    -> A.Parser (Vector Text)-row !delim = rowNoNewline delim <* endOfLine-{-# INLINE row #-}--rowNoNewline :: Char  -- ^ Field delimiter-             -> A.Parser (Vector Text)-rowNoNewline !delim = V.fromList <$!> field delim `sepByDelim1'` delim-{-# INLINE rowNoNewline #-}---- | Parse a field. The field may be in either the escaped or--- non-escaped format. The return value is unescaped.-field :: Char -> A.Parser Text-field !delim = do-    mb <- A.peekChar-    -- We purposely don't use <|> as we want to commit to the first-    -- choice if we see a double quote.-    case mb of-        Just b | b == doubleQuote -> escapedField-        _                         -> unescapedField delim-{-# INLINE field #-}--escapedField :: A.Parser Text-escapedField = do-  _ <- dquote -- This can probably be replaced with anyChar-  b <- escapedFieldInner mempty-  return (LText.toStrict (Builder.toLazyText b))--escapedFieldInner :: Builder -> A.Parser Builder-escapedFieldInner b = do-  t <- A.takeTill (== doubleQuote)-  _ <- A.anyChar -- this will always be a double quote-  c <- A.peekChar'-  if c == doubleQuote-    then do-      _ <- A.anyChar -- this will always be a double quote-      escapedFieldInner (b `mappend` Builder.fromText t `mappend` Builder.fromText textDoubleQuote)-    else return (b `mappend` Builder.fromText t)--unescapedField :: Char -> A.Parser Text-unescapedField !delim = A.takeWhile (\ c -> c /= doubleQuote &&-                                            c /= newline &&-                                            c /= delim &&-                                            c /= cr)--dquote :: A.Parser Char-dquote = char doubleQuote--unescape :: A.Parser Text-unescape = (LText.toStrict . Builder.toLazyText) <$!> go mempty where-  go acc = do-    h <- A.takeWhile (/= doubleQuote)-    let rest = do-          c0 <- A.anyChar-          c1 <- A.anyChar-          if (c0 == doubleQuote && c1 == doubleQuote)-              then go (acc `mappend` Builder.fromText h `mappend` Builder.fromText textDoubleQuote)-              else fail "invalid CSV escape sequence"-    done <- A.atEnd-    if done-      then return (acc `mappend` Builder.fromText h)-      else rest---- | A strict version of 'Data.Functor.<$>' for monads.-(<$!>) :: Monad m => (a -> b) -> m a -> m b-f <$!> m = do-    a <- m-    return $! f a-{-# INLINE (<$!>) #-}--infixl 4 <$!>---- | A version of 'liftM2' that is strict in the result of its first--- action.-liftM2' :: (Monad m) => (a -> b -> c) -> m a -> m b -> m c-liftM2' f a b = do-    !x <- a-    y <- b-    return (f x y)-{-# INLINE liftM2' #-}----- | Match either a single newline character @\'\\n\'@, or a carriage--- return followed by a newline character @\"\\r\\n\"@, or a single--- carriage return @\'\\r\'@.-endOfLine :: A.Parser ()-endOfLine = (A.char newline *> return ()) <|> (string (Text.pack "\r\n") *> return ()) <|> (A.char cr *> return ())-{-# INLINE endOfLine #-}--textDoubleQuote :: Text-textDoubleQuote = Text.singleton doubleQuote--doubleQuote, newline, cr, comma :: Char-doubleQuote = '\"'-newline = '\n'-cr = '\r'-comma = ','-

@@ -1,33 +0,0 @@-module Siphon.Text where--import Siphon.Types-import Data.Text (Text)-import Data.Vector (Vector)-import Data.Coerce (coerce)-import qualified Data.Text   as Text-import qualified Data.Vector as Vector--siphon :: Siphon Text-siphon = Siphon escape encodeRow-  (error "siphon: uhoent") (error "siphon: uheokj")--encodeRow :: Vector (Escaped Text) -> Text-encodeRow = id-  . Text.intercalate (Text.singleton ',')-  . Vector.toList-  . coerce--escape :: Text -> Escaped Text-escape t = case Text.find (\c -> c == '\n' || c == ',' || c == '"') t of-  Nothing -> Escaped t-  Just _  -> escapeAlways t--escapeAlways :: Text -> Escaped Text-escapeAlways t = Escaped $ Text.concat-  [ Text.singleton '"'-  , Text.replace (Text.pack "\"") (Text.pack "\"\"") t-  , Text.singleton '"'-  ]---

@@ -2,121 +2,76 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -module Siphon.Types where+{-# OPTIONS_GHC -Wall -Werror #-} +module Siphon.Types+  ( Siphon(..)+  , Indexed(..)+  , SiphonError(..)+  , RowError(..)+  , CellError(..)+  ) where+ import Data.Vector (Vector) import Control.Exception (Exception)-import Data.Typeable (Typeable)-import qualified Data.Vector as Vector-import qualified Data.Attoparsec.Types as Atto--newtype Escaped c = Escaped { getEscaped :: c }--data Siphon c = Siphon-  { siphonEscape      :: !(c -> Escaped c)-  , siphonIntercalate :: !(Vector (Escaped c) -> c)-  , siphonParseRow    :: c -> Atto.IResult c (Vector c)-  , siphonNull        :: c -> Bool-  }+import Data.Text (Text) -data DecolonnadeCellError f content = DecolonnadeCellError-  { decodingCellErrorContent :: !content-  , decodingCellErrorHeader  :: !(Indexed f content)-  , decodingCellErrorMessage :: !String+data CellError = CellError+  { cellErrorColumn :: !Int+  , cellErrorContent :: !Text   } deriving (Show,Read,Eq) --- instance (Show (f content), Typeable content) => Exception (DecolonnadeError f content)--data Indexed f a = Indexed-  { indexedIndex :: !Int-  , indexedHeading :: !(f a)+newtype Indexed a = Indexed+  { indexedIndex :: Int   } deriving (Eq,Ord,Functor,Show,Read) -newtype DecolonnadeCellErrors f content = DecolonnadeCellErrors-  { getDecolonnadeCellErrors :: Vector (DecolonnadeCellError f content)-  } deriving (Monoid,Show,Read,Eq)---- newtype ParseRowError = ParseRowError String---- TODO: rewrite the instances for this by hand. They--- currently use FlexibleContexts.-data DecolonnadeRowError f content = DecolonnadeRowError-  { decodingRowErrorRow   :: !Int-  , decodingRowErrorError :: !(RowError f content)-  } deriving (Show,Read,Eq)---- TODO: rewrite the instances for this by hand. They--- currently use FlexibleContexts.-data RowError f content-  = RowErrorParse !String -- ^ Error occurred parsing the document into cells-  | RowErrorDecode !(DecolonnadeCellErrors f content) -- ^ Error decoding the content-  | RowErrorSize !Int !Int -- ^ Wrong number of cells in the row-  | RowErrorHeading !(HeadingErrors content)-  | RowErrorMinSize !Int !Int-  | RowErrorMalformed !String -- ^ Error decoding unicode content-  deriving (Show,Read,Eq)--data HeadingErrors content = HeadingErrors-  { headingErrorsMissing   :: Vector content       -- ^ headers that were missing-  , headingErrorsDuplicate :: Vector (content,Int) -- ^ headers that occurred more than once+data SiphonError = SiphonError+  { siphonErrorRow :: !Int+  , siphonErrorCause :: !RowError   } deriving (Show,Read,Eq) -instance (Show content, Typeable content) => Exception (HeadingErrors content)+instance Exception SiphonError -instance Monoid (HeadingErrors content) where-  mempty = HeadingErrors Vector.empty Vector.empty-  mappend (HeadingErrors a1 b1) (HeadingErrors a2 b2) = HeadingErrors-    (a1 Vector.++ a2) (b1 Vector.++ b2)+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, +    --   (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)  -- | 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 Decolonnade f content a where-  DecolonnadePure :: !a -- function-               -> Decolonnade f content a-  DecolonnadeAp :: !(f content) -- header-             -> !(content -> Either String a) -- decoding function-             -> !(Decolonnade f content (a -> b)) -- next decoding-             -> Decolonnade f content b--instance Functor (Decolonnade f content) where-  fmap f (DecolonnadePure a) = DecolonnadePure (f a)-  fmap f (DecolonnadeAp h c apNext) = DecolonnadeAp h c ((f .) <$> apNext)--instance Applicative (Decolonnade f content) where-  pure = DecolonnadePure-  DecolonnadePure f <*> y = fmap f y-  DecolonnadeAp h c y <*> z = DecolonnadeAp h c (flip <$> y <*> z)---- -- | This type is provided for convenience with @pipes-text@--- data CsvResult f c---   = CsvResultSuccess---   | CsvResultTextDecodeError---   | CsvResultDecodeError (DecodingRowError f c)---   deriving (Show,Read,Eq)----- | Consider changing out the use of 'Vector' here--- with the humble list instead. It might fuse away--- better. Not sure though.--- data SiphonX c1 c2 = SiphonX---   { siphonXEscape :: !(c1 -> Escaped c2)---   , siphonXIntercalate :: !(Vector (Escaped c2) -> c2)---   }------ data SiphonDecoding c1 c2 = SiphonDecoding---   { siphonDecodingParse :: c1 -> Atto.IResult c1 (Vector c2)---   , siphonDecodingNull  :: c1 -> Bool---   }+data Siphon f c a where+  SiphonPure ::+       !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 --- data WithEnd c = WithEnd---   { withEndEnded :: !Bool---   , withEndContent :: !c---   }+instance Functor (Siphon f c) where+  fmap f (SiphonPure a) = SiphonPure (f a)+  fmap f (SiphonAp h c apNext) = SiphonAp h c ((f .) <$> apNext) --- data SiphonDecodingError---   { clarify---   }+instance Applicative (Siphon f c) where+  pure = SiphonPure+  SiphonPure f <*> y = fmap f y+  SiphonAp h c y <*> z = SiphonAp h c (flip <$> y <*> z) 

@@ -1,16 +1,18 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveGeneric     #-}  module Main (main) where -import Test.QuickCheck                      (Gen, Arbitrary(..), choose, elements)-import Test.HUnit                           (Assertion,(@?=))-import Test.Framework                       (defaultMain, testGroup, Test)+import Test.QuickCheck (Gen, Arbitrary(..), choose, elements, Property)+import Test.QuickCheck.Property (Result, succeeded, exception)+import Test.HUnit (Assertion,(@?=))+import Test.Framework (defaultMain, testGroup, Test) import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.Framework.Providers.HUnit       (testCase)-import Data.ByteString                      (ByteString)-import Data.Text                            (Text)-import GHC.Generics                         (Generic)+import Test.Framework.Providers.HUnit (testCase)+import Data.ByteString (ByteString)+import Data.Text (Text)+import GHC.Generics (Generic) import Data.Either.Combinators import Siphon.Types import Data.Functor.Identity@@ -18,20 +20,20 @@ import Data.Functor.Contravariant.Divisible (divided,conquered) import Colonnade (headed,headless,Colonnade,Headed,Headless) import Data.Profunctor (lmap)+import Streaming (Stream,Of(..))+import Control.Exception+import Debug.Trace 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 ByteString import qualified Data.ByteString.Char8      as BC8 import qualified Colonnade                  as Colonnade-import qualified Siphon.Encoding            as SE-import qualified Siphon.Decoding            as SD-import qualified Siphon.Content             as SC-import qualified Pipes.Prelude              as Pipes+import qualified Siphon as S+import qualified Streaming.Prelude as SMP 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 Pipes  main :: IO () main = defaultMain tests@@ -39,60 +41,55 @@ tests :: [Test] tests =   [ testGroup "ByteString encode/decode"-    [ testCase "Headless Encoding (int,char,bool)"-        $ runTestScenario-            SC.byteStringChar8-            SE.pipe-            encodingA-            "4,c,false\n"-    , testProperty "Headless Isomorphism (int,char,bool)"-        $ propIsoPipe $-          (SE.pipe SC.byteStringChar8 encodingA)-          >->-          (void $ SD.headlessPipe SC.byteStringChar8 decodingA)-    , testCase "Headed Encoding (int,char,bool)"-        $ runTestScenario-            SC.byteStringChar8-            SE.headedPipe+    [ testCase "Headed Encoding (int,char,bool)"+        $ runTestScenario [(4,'c',False)]+            S.encodeHeadedUtf8Csv             encodingB             $ ByteString.concat               [ "number,letter,boolean\n"               , "4,c,false\n"               ]     , testCase "Headed Encoding (int,char,bool) monoidal building"-        $ runTestScenario-            SC.byteStringChar8-            SE.headedPipe+        $ runTestScenario [(4,'c',False)]+            S.encodeHeadedUtf8Csv             encodingC             $ ByteString.concat               [ "boolean,letter\n"               , "false,c\n"               ]+    , testCase "Headed Encoding (escaped characters)"+        $ runTestScenario ["bob","there,be,commas","the \" quote"]+            S.encodeHeadedUtf8Csv+            encodingF+            $ ByteString.concat+              [ "name\n"+              , "bob\n"+              , "\"there,be,commas\"\n"+              , "\"the \"\" quote\"\n"+              ]+    , testCase "Headed Decoding (int,char,bool)"+        $ ( runIdentity . SMP.toList )+            ( S.decodeHeadedUtf8Csv decodingB+              ( mapM_ (SMP.yield . BC8.singleton) $ concat+                [ "number,letter,boolean\n"+                , "244,z,true\n"+                ]+              )+            ) @?= ([(244,'z',True)] :> Nothing)+    , testCase "Headed Decoding (escaped characters)"+        $ ( runIdentity . SMP.toList )+            ( S.decodeHeadedUtf8Csv decodingF+              ( mapM_ (SMP.yield . BC8.singleton) $ concat+                [ "name\n"+                , "drew\n"+                , "\"martin, drew\"\n"+                ]+              )+            ) @?= (["drew","martin, drew"] :> Nothing)     , testProperty "Headed Isomorphism (int,char,bool)"-        $ propIsoPipe $-          (SE.headedPipe SC.byteStringChar8 encodingB)-          >->-          (void $ SD.headedPipe SC.byteStringChar8 decodingB)-    ]-  , testGroup "Text encode/decode"-    [ testCase "Headless Encoding (int,char,bool)"-        $ runTestScenario-            SC.text-            SE.pipe-            encodingW-            "4,c,false\n"-    , testCase "Headless Encoding (Foo,Foo,Foo)"-        $ runCustomTestScenario-            SC.text-            SE.pipe-            encodingY-            (FooA,FooA,FooC)-            "Simple,Simple,\"More\"\"Escaped,\"\"\"\"Chars\"\n"-    , testProperty "Headless Isomorphism (Foo,Foo,Foo)"-        $ propIsoPipe $-          (SE.pipe SC.text encodingY)-          >->-          (void $ SD.headlessPipe SC.text decodingY)+        $ propIsoStream BC8.unpack+          (S.decodeHeadedUtf8Csv decodingB)+          (S.encodeHeadedUtf8Csv encodingB)     ]   ] @@ -111,28 +108,32 @@ encodeFoo :: (String -> c) -> Foo -> c encodeFoo f = f . fooToString -fooFromString :: String -> Either String Foo+fooFromString :: String -> Maybe Foo fooFromString x = case x of-  "Simple" -> Right FooA-  "With,Escaped\nChars" -> Right FooB-  "More\"Escaped,\"\"Chars" -> Right FooC-  _ -> Left "failed to decode Foo"+  "Simple" -> Just FooA+  "With,Escaped\nChars" -> Just FooB+  "More\"Escaped,\"\"Chars" -> Just FooC+  _ -> Nothing -decodeFoo :: (c -> String) -> c -> Either String Foo+decodeFoo :: (c -> String) -> c -> Maybe Foo decodeFoo f = fooFromString . f -decodingA :: Decolonnade Headless ByteString (Int,Char,Bool)+decodingA :: Siphon Headless ByteString (Int,Char,Bool) decodingA = (,,)-  <$> SD.headless dbInt-  <*> SD.headless dbChar-  <*> SD.headless dbBool+  <$> S.headless dbInt+  <*> S.headless dbChar+  <*> S.headless dbBool -decodingB :: Decolonnade Headed ByteString (Int,Char,Bool)+decodingB :: Siphon Headed ByteString (Int,Char,Bool) decodingB = (,,)-  <$> SD.headed "number" dbInt-  <*> SD.headed "letter" dbChar-  <*> SD.headed "boolean" dbBool+  <$> S.headed "number" dbInt+  <*> S.headed "letter" dbChar+  <*> S.headed "boolean" dbBool +decodingF :: Siphon Headed ByteString ByteString+decodingF = S.headed "name" Just++ encodingA :: Colonnade Headless (Int,Char,Bool) ByteString encodingA = mconcat   [ lmap fst3 (headless ebInt)@@ -154,12 +155,15 @@   , lmap thd3 (headless $ encodeFoo Text.pack)   ] -decodingY :: Decolonnade Headless Text (Foo,Foo,Foo)+decodingY :: Siphon Headless Text (Foo,Foo,Foo) decodingY = (,,)-  <$> SD.headless (decodeFoo Text.unpack)-  <*> SD.headless (decodeFoo Text.unpack)-  <*> SD.headless (decodeFoo Text.unpack)+  <$> 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,Char,Bool) ByteString encodingB = mconcat   [ lmap fst3 (headed "number" ebInt)@@ -176,32 +180,51 @@ tripleToPairs :: (a,b,c) -> (a,(b,(c,()))) tripleToPairs (a,b,c) = (a,(b,(c,()))) -propIsoPipe :: Eq a => Pipe a a Identity () -> [a] -> Bool-propIsoPipe p as = (Pipes.toList $ each as >-> p) == as+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+        Just err ->+          let csv = toStr $ mconcat $ runIdentity $ SMP.toList_ $ encode $ SMP.each as+           in exception (S.humanizeSiphonError err ++ "\nGenerated CSV\n" ++ csv) myException -runTestScenario :: (Monoid c, Eq c, Show c)-  => Siphon c-  -> (Siphon c -> Colonnade f (Int,Char,Bool) c -> Pipe (Int,Char,Bool) c Identity ())-  -> Colonnade f (Int,Char,Bool) c-  -> c-  -> Assertion-runTestScenario s p e c =-  ( mconcat $ Pipes.toList $-    Pipes.yield (4,'c',False) >-> p s e-  ) @?= c+data MyException = MyException+  deriving (Show,Read,Eq)+instance Exception MyException -runCustomTestScenario :: (Monoid c, Eq c, Show c)-  => Siphon c-  -> (Siphon c -> Colonnade f a c -> Pipe a c Identity ())+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-  -> a   -> c   -> Assertion-runCustomTestScenario s p e a c =-  ( mconcat $ Pipes.toList $-    Pipes.yield a >-> p s e+runTestScenario as p e c =+  ( mconcat (runIdentity (SMP.toList_ (p e (mapM_ SMP.yield as))))   ) @?= c +-- runCustomTestScenario :: (Monoid c, Eq c, Show c)+--   => Siphon c+--   -> (Siphon c -> Colonnade f a c -> Pipe a c Identity ())+--   -> Colonnade f a c+--   -> a+--   -> c+--   -> Assertion+-- runCustomTestScenario s p e a c =+--   ( mconcat $ Pipes.toList $+--     Pipes.yield a >-> p s e+--   ) @?= c+ -- testEncodingA :: Assertion -- testEncodingA = runTestScenario encodingA "4,c,false\n" @@ -225,24 +248,23 @@ thd3 (a,b,c) = c  -dbChar :: ByteString -> Either String Char+dbChar :: ByteString -> Maybe Char dbChar b = case BC8.length b of-  1 -> Right (BC8.head b)-  0 -> Left "cannot decode Char from empty bytestring"-  _ -> Left "cannot decode Char from multi-character bytestring"+  1 -> Just (BC8.head b)+  _ -> Nothing -dbInt :: ByteString -> Either String Int+dbInt :: ByteString -> Maybe Int dbInt b = do-  (a,bsRem) <- maybe (Left "could not parse int") Right (BC8.readInt b)+  (a,bsRem) <- BC8.readInt b   if ByteString.null bsRem-    then Right a-    else Left "found extra characters after int"+    then Just a+    else Nothing -dbBool :: ByteString -> Either String Bool+dbBool :: ByteString -> Maybe Bool dbBool b-  | b == BC8.pack "true" = Right True-  | b == BC8.pack "false" = Right False-  | otherwise = Left "must be true or false"+  | b == BC8.pack "true" = Just True+  | b == BC8.pack "false" = Just False+  | otherwise = Nothing  ebChar :: Char -> ByteString ebChar = BC8.singleton