mirror of
https://github.com/byteverse/colonnade.git
synced 2026-04-18 22:24:23 +02:00
clean up siphon a little more
This commit is contained in:
parent
17b1473359
commit
a3d4c36bfa
@ -8,20 +8,8 @@
|
|||||||
-- | Build CSVs using the abstractions provided in the @colonnade@ library, and
|
-- | Build CSVs using the abstractions provided in the @colonnade@ library, and
|
||||||
-- parse CSVs using 'Siphon', which is the dual of 'Colonnade'.
|
-- parse CSVs using 'Siphon', which is the dual of 'Colonnade'.
|
||||||
-- Read the documentation for @colonnade@ before reading the documentation
|
-- Read the documentation for @colonnade@ before reading the documentation
|
||||||
-- for @siphon@. All of the examples on this page assume the following
|
-- for @siphon@. All of the examples on this page assume a common set of
|
||||||
-- setup:
|
-- imports that are provided at the bottom of this page.
|
||||||
--
|
|
||||||
-- >>> :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
|
module Siphon
|
||||||
( -- * Encode CSV
|
( -- * Encode CSV
|
||||||
encodeCsv
|
encodeCsv
|
||||||
@ -29,7 +17,7 @@ module Siphon
|
|||||||
, encodeCsvUtf8
|
, encodeCsvUtf8
|
||||||
, encodeCsvStreamUtf8
|
, encodeCsvStreamUtf8
|
||||||
-- * Decode CSV
|
-- * Decode CSV
|
||||||
, decodeHeadedUtf8Csv
|
, decodeCsvUtf8
|
||||||
-- * Build Siphon
|
-- * Build Siphon
|
||||||
, headed
|
, headed
|
||||||
, headless
|
, headless
|
||||||
@ -40,6 +28,8 @@ module Siphon
|
|||||||
, Indexed(..)
|
, Indexed(..)
|
||||||
-- * Utility
|
-- * Utility
|
||||||
, humanizeSiphonError
|
, humanizeSiphonError
|
||||||
|
-- * Imports
|
||||||
|
-- $setup
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Siphon.Types
|
import Siphon.Types
|
||||||
@ -89,11 +79,11 @@ data Ended = EndedYes | EndedNo
|
|||||||
data CellResult c = CellResultData !c | CellResultNewline !c !Ended
|
data CellResult c = CellResultData !c | CellResultNewline !c !Ended
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
decodeHeadedUtf8Csv :: Monad m
|
decodeCsvUtf8 :: Monad m
|
||||||
=> Siphon CE.Headed ByteString a
|
=> Siphon CE.Headed ByteString a
|
||||||
-> Stream (Of ByteString) m () -- ^ encoded csv
|
-> Stream (Of ByteString) m () -- ^ encoded csv
|
||||||
-> Stream (Of a) m (Maybe SiphonError)
|
-> Stream (Of a) m (Maybe SiphonError)
|
||||||
decodeHeadedUtf8Csv headedSiphon s1 = do
|
decodeCsvUtf8 headedSiphon s1 = do
|
||||||
e <- lift (consumeHeaderRowUtf8 s1)
|
e <- lift (consumeHeaderRowUtf8 s1)
|
||||||
case e of
|
case e of
|
||||||
Left err -> return (Just err)
|
Left err -> return (Just err)
|
||||||
@ -351,7 +341,7 @@ field !delim = do
|
|||||||
case mb of
|
case mb of
|
||||||
Just b
|
Just b
|
||||||
| b == doubleQuote -> do
|
| b == doubleQuote -> do
|
||||||
(bs,tc) <- escapedField delim
|
(bs,tc) <- escapedField
|
||||||
case tc of
|
case tc of
|
||||||
TrailCharComma -> return (CellResultData bs)
|
TrailCharComma -> return (CellResultData bs)
|
||||||
TrailCharNewline -> return (CellResultNewline bs EndedNo)
|
TrailCharNewline -> return (CellResultNewline bs EndedNo)
|
||||||
@ -374,8 +364,8 @@ field !delim = do
|
|||||||
eatNewlines :: AL.Parser S.ByteString
|
eatNewlines :: AL.Parser S.ByteString
|
||||||
eatNewlines = A.takeWhile (\x -> x == 10 || x == 13)
|
eatNewlines = A.takeWhile (\x -> x == 10 || x == 13)
|
||||||
|
|
||||||
escapedField :: Word8 -> AL.Parser (S.ByteString,TrailChar)
|
escapedField :: AL.Parser (S.ByteString,TrailChar)
|
||||||
escapedField !delim = do
|
escapedField = do
|
||||||
_ <- dquote
|
_ <- dquote
|
||||||
-- The scan state is 'True' if the previous character was a double
|
-- The scan state is 'True' if the previous character was a double
|
||||||
-- quote. We need to drop a trailing double quote left by scan.
|
-- quote. We need to drop a trailing double quote left by scan.
|
||||||
@ -443,16 +433,6 @@ unescape = (LByteString.toStrict . toLazyByteString) <$!> go mempty where
|
|||||||
blankLine :: V.Vector B.ByteString -> Bool
|
blankLine :: V.Vector B.ByteString -> Bool
|
||||||
blankLine v = V.length v == 1 && (B.null (V.head v))
|
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' #-}
|
|
||||||
|
|
||||||
|
|
||||||
doubleQuote, newline, cr, comma :: Word8
|
doubleQuote, newline, cr, comma :: Word8
|
||||||
doubleQuote = 34
|
doubleQuote = 34
|
||||||
newline = 10
|
newline = 10
|
||||||
|
|||||||
@ -69,7 +69,7 @@ tests =
|
|||||||
]
|
]
|
||||||
, testCase "Headed Decoding (int,char,bool)"
|
, testCase "Headed Decoding (int,char,bool)"
|
||||||
$ ( runIdentity . SMP.toList )
|
$ ( runIdentity . SMP.toList )
|
||||||
( S.decodeHeadedUtf8Csv decodingB
|
( S.decodeCsvUtf8 decodingB
|
||||||
( mapM_ (SMP.yield . BC8.singleton) $ concat
|
( mapM_ (SMP.yield . BC8.singleton) $ concat
|
||||||
[ "number,letter,boolean\n"
|
[ "number,letter,boolean\n"
|
||||||
, "244,z,true\n"
|
, "244,z,true\n"
|
||||||
@ -78,7 +78,7 @@ tests =
|
|||||||
) @?= ([(244,'z',True)] :> Nothing)
|
) @?= ([(244,'z',True)] :> Nothing)
|
||||||
, testCase "Headed Decoding (escaped characters, one big chunk)"
|
, testCase "Headed Decoding (escaped characters, one big chunk)"
|
||||||
$ ( runIdentity . SMP.toList )
|
$ ( runIdentity . SMP.toList )
|
||||||
( S.decodeHeadedUtf8Csv decodingF
|
( S.decodeCsvUtf8 decodingF
|
||||||
( SMP.yield $ BC8.pack $ concat
|
( SMP.yield $ BC8.pack $ concat
|
||||||
[ "name\n"
|
[ "name\n"
|
||||||
, "drew\n"
|
, "drew\n"
|
||||||
@ -88,7 +88,7 @@ tests =
|
|||||||
) @?= (["drew","martin, drew"] :> Nothing)
|
) @?= (["drew","martin, drew"] :> Nothing)
|
||||||
, testCase "Headed Decoding (escaped characters, character per chunk)"
|
, testCase "Headed Decoding (escaped characters, character per chunk)"
|
||||||
$ ( runIdentity . SMP.toList )
|
$ ( runIdentity . SMP.toList )
|
||||||
( S.decodeHeadedUtf8Csv decodingF
|
( S.decodeCsvUtf8 decodingF
|
||||||
( mapM_ (SMP.yield . BC8.singleton) $ concat
|
( mapM_ (SMP.yield . BC8.singleton) $ concat
|
||||||
[ "name\n"
|
[ "name\n"
|
||||||
, "drew\n"
|
, "drew\n"
|
||||||
@ -98,7 +98,7 @@ tests =
|
|||||||
) @?= (["drew","martin, drew"] :> Nothing)
|
) @?= (["drew","martin, drew"] :> Nothing)
|
||||||
, testProperty "Headed Isomorphism (int,char,bool)"
|
, testProperty "Headed Isomorphism (int,char,bool)"
|
||||||
$ propIsoStream BC8.unpack
|
$ propIsoStream BC8.unpack
|
||||||
(S.decodeHeadedUtf8Csv decodingB)
|
(S.decodeCsvUtf8 decodingB)
|
||||||
(S.encodeCsvStreamUtf8 encodingB)
|
(S.encodeCsvStreamUtf8 encodingB)
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user