packages feed

siphon 0.7 → 0.8.0

raw patch · 4 files changed

+213/−66 lines, 4 filesdep +doctestdep ~basedep ~colonnadedep ~streaming

Dependencies added: doctest

Dependency ranges changed: base, colonnade, streaming, text, transformers

Files

siphon.cabal view
@@ -1,5 +1,5 @@ name: siphon-version: 0.7+version: 0.8.0 synopsis: Encode and decode CSV files description: Please see README.md homepage: https://github.com/andrewthad/colonnade#readme@@ -19,13 +19,23 @@     Siphon.Types   build-depends:       base >= 4.9 && < 5-    , colonnade >= 1.1 && < 1.2-    , text+    , colonnade >= 1.1.1 && < 1.3+    , text >= 1.0 && < 1.3     , bytestring     , vector-    , streaming+    , streaming >= 0.1.4 && < 0.3     , attoparsec-    , transformers+    , transformers >= 0.5 && < 0.6+  default-language:    Haskell2010++test-suite doctest+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Doctest.hs+  build-depends:+      base+    , siphon+    , doctest >= 0.10   default-language:    Haskell2010  test-suite siphon-test
src/Siphon.hs view
@@ -3,18 +3,43 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RankNTypes #-} --- {-# OPTIONS_GHC -Wall -Werr -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -Wall -fno-warn-unused-imports #-} +-- | 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 the following+--   setup:+--+--   >>> :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 qualified Data.Text.Lazy.IO as LTIO+--   >>> import qualified Data.Text.Lazy.Builder as LB+--   >>> import Data.Text (Text)+--   >>> import Data.Maybe (fromMaybe)+--   >>> data Person = Person { name :: Text, age :: Int, company :: Maybe Text} module Siphon-  ( Siphon-  , SiphonError-  , Indexed(..)+  ( -- * Encode CSV+    encodeCsv+  , encodeCsvStream+  , encodeCsvUtf8+  , encodeCsvStreamUtf8+    -- * Decode CSV   , decodeHeadedUtf8Csv-  , encodeHeadedUtf8Csv-  , humanizeSiphonError+    -- * Build Siphon   , headed   , headless   , indexed+    -- * Types+  , Siphon+  , SiphonError+  , Indexed(..)+    -- * Utility+  , humanizeSiphonError   ) where  import Siphon.Types@@ -32,6 +57,8 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LByteString import qualified Data.ByteString.Builder as Builder+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 Streaming as SM@@ -39,9 +66,10 @@ 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 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)@@ -53,6 +81,7 @@ import Streaming (Stream,Of(..)) import Data.Vector.Mutable (MVector) import Control.Monad.ST+import Data.Text (Text)  newtype Escaped c = Escaped { getEscaped :: c } data Ended = EndedYes | EndedNo@@ -74,40 +103,104 @@         let requiredLength = V.length v         consumeBodyUtf8 1 requiredLength ixedSiphon s2 -encodeHeadedUtf8Csv :: Monad m -  => CE.Colonnade CE.Headed a ByteString+encodeCsvStreamUtf8 :: (Monad m, CE.Headedness h)+  => CE.Colonnade h a ByteString   -> Stream (Of a) m r   -> Stream (Of ByteString) m r-encodeHeadedUtf8Csv =-  encodeHeadedCsv escapeChar8 (B.singleton comma) (B.singleton newline)+encodeCsvStreamUtf8 =+  encodeCsvInternal escapeChar8 (B.singleton comma) (B.singleton newline) -encodeHeadedCsv :: Monad m+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 = +  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 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)++textStreamToBuilder :: Stream (Of Text) Identity () -> TB.Builder+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 CE.Headed a c+  -> CE.Colonnade h a c   -> Stream (Of a) m r   -> Stream (Of c) m r-encodeHeadedCsv escapeFunc separatorStr newlineStr colonnade s = do-  encodeHeader escapeFunc separatorStr newlineStr colonnade+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-  => (c -> Escaped c)+  => (h c -> c)+  -> (c -> Escaped c)   -> c -- ^ separator   -> c -- ^ newline-  -> CE.Colonnade CE.Headed a c+  -> CE.Colonnade h a c   -> Stream (Of c) m ()-encodeHeader escapeFunc separatorStr newlineStr colonnade = do+encodeHeader toContent 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+  V.forM_ vs $ \(CE.OneColonnade h _) -> do+    SMP.yield (getEscaped (escapeFunc (toContent h)))+  V.forM_ ws $ \(CE.OneColonnade h _) -> do     SMP.yield separatorStr-    SMP.yield (getEscaped (escapeFunc h))+    SMP.yield (getEscaped (escapeFunc (toContent h)))   SMP.yield newlineStr  mapStreamM :: Monad m@@ -189,7 +282,12 @@   Nothing -> Escaped t   Just _  -> escapeAlways t --- | This implementation is definitely suboptimal.+textEscapeChar8 :: Text -> Escaped Text+textEscapeChar8 t = case T.find (\c -> c == '\n' || c == '\r' || c == ',' || c == '"') t of+  Nothing -> Escaped 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.@@ -205,19 +303,18 @@       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' #-}+-- 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 '"'  -- | Parse a record, not including the terminating line separator. The -- terminating line separate is not included as the last record in a@@ -251,8 +348,11 @@   case mb of     Just b       | b == doubleQuote -> do-          bs <- escapedField delim-          return (CellResultData bs)+          (bs,tc) <- escapedField delim+          case tc of+            TrailCharComma -> return (CellResultData bs)+            TrailCharNewline -> return (CellResultNewline bs EndedNo)+            TrailCharEnd -> return (CellResultNewline bs EndedYes)       | b == 10 || b == 13 -> do           _ <- eatNewlines           isEnd <- A.atEnd@@ -271,21 +371,31 @@ eatNewlines :: AL.Parser S.ByteString eatNewlines = A.takeWhile (\x -> x == 10 || x == 13) -escapedField :: Word8 -> AL.Parser S.ByteString+escapedField :: Word8 -> AL.Parser (S.ByteString,TrailChar) 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))+  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+      | b == comma -> A.anyWord8 >> return TrailCharComma+      | b == newline || b == cr -> A.anyWord8 >> return TrailCharNewline+      | otherwise -> fail "encountered double quote after escaped field"+    Nothing -> return TrailCharEnd   if doubleQuote `S.elem` s-      then case Z.parse unescape s of-          Right r  -> return r-          Left err -> fail err-      else return s+    then case Z.parse unescape s of+      Right r  -> return (r,trailChar)+      Left err -> fail err+    else return (s,trailChar)  data TrailChar = TrailCharNewline | TrailCharComma | TrailCharEnd @@ -303,7 +413,7 @@     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"+      | otherwise -> fail "encountered double quote in unescaped field"     Nothing -> return (bs,TrailCharEnd)  dquote :: AL.Parser Char@@ -340,13 +450,6 @@ {-# 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@@ -652,4 +755,21 @@  indexed :: Int -> (c -> Maybe a) -> Siphon Indexed c a indexed ix f = SiphonAp (Indexed ix) f (SiphonPure id)++-- $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}
+ test/Doctest.hs view
@@ -0,0 +1,7 @@+import Test.DocTest++main :: IO ()+main = doctest+  [ "src/Siphon.hs"+  ]+
test/Test.hs view
@@ -43,7 +43,7 @@   [ testGroup "ByteString encode/decode"     [ testCase "Headed Encoding (int,char,bool)"         $ runTestScenario [(4,'c',False)]-            S.encodeHeadedUtf8Csv+            S.encodeCsvStreamUtf8             encodingB             $ ByteString.concat               [ "number,letter,boolean\n"@@ -51,7 +51,7 @@               ]     , testCase "Headed Encoding (int,char,bool) monoidal building"         $ runTestScenario [(4,'c',False)]-            S.encodeHeadedUtf8Csv+            S.encodeCsvStreamUtf8             encodingC             $ ByteString.concat               [ "boolean,letter\n"@@ -59,7 +59,7 @@               ]     , testCase "Headed Encoding (escaped characters)"         $ runTestScenario ["bob","there,be,commas","the \" quote"]-            S.encodeHeadedUtf8Csv+            S.encodeCsvStreamUtf8             encodingF             $ ByteString.concat               [ "name\n"@@ -76,9 +76,19 @@                 ]               )             ) @?= ([(244,'z',True)] :> Nothing)-    , testCase "Headed Decoding (escaped characters)"+    , testCase "Headed Decoding (escaped characters, one big chunk)"         $ ( runIdentity . SMP.toList )             ( S.decodeHeadedUtf8Csv 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.decodeHeadedUtf8Csv decodingF               ( mapM_ (SMP.yield . BC8.singleton) $ concat                 [ "name\n"                 , "drew\n"@@ -89,7 +99,7 @@     , testProperty "Headed Isomorphism (int,char,bool)"         $ propIsoStream BC8.unpack           (S.decodeHeadedUtf8Csv decodingB)-          (S.encodeHeadedUtf8Csv encodingB)+          (S.encodeCsvStreamUtf8 encodingB)     ]   ]