diff --git a/siphon.cabal b/siphon.cabal --- a/siphon.cabal +++ b/siphon.cabal @@ -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 diff --git a/src/Siphon.hs b/src/Siphon.hs --- a/src/Siphon.hs +++ b/src/Siphon.hs @@ -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} diff --git a/test/Doctest.hs b/test/Doctest.hs new file mode 100644 --- /dev/null +++ b/test/Doctest.hs @@ -0,0 +1,7 @@ +import Test.DocTest + +main :: IO () +main = doctest + [ "src/Siphon.hs" + ] + diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -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) ] ]