siphon 0.8.0 → 0.8.1
raw patch · 3 files changed
+64/−56 lines, 3 filesdep ~base
Dependency ranges changed: base
Files
- siphon.cabal +2/−2
- src/Siphon.hs +32/−38
- test/Test.hs +30/−16
siphon.cabal view
@@ -1,5 +1,5 @@ name: siphon-version: 0.8.0+version: 0.8.1 synopsis: Encode and decode CSV files description: Please see README.md homepage: https://github.com/andrewthad/colonnade#readme@@ -19,7 +19,7 @@ Siphon.Types build-depends: base >= 4.9 && < 5- , colonnade >= 1.1.1 && < 1.3+ , colonnade >= 1.2 && < 1.3 , text >= 1.0 && < 1.3 , bytestring , vector
src/Siphon.hs view
@@ -8,20 +8,8 @@ -- | 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}+-- for @siphon@. All of the examples on this page assume a common set of+-- imports that are provided at the bottom of this page. module Siphon ( -- * Encode CSV encodeCsv@@ -29,17 +17,19 @@ , encodeCsvUtf8 , encodeCsvStreamUtf8 -- * Decode CSV- , decodeHeadedUtf8Csv+ , decodeCsvUtf8 -- * Build Siphon , headed , headless , indexed -- * Types , Siphon- , SiphonError+ , SiphonError(..) , Indexed(..) -- * Utility , humanizeSiphonError+ -- * Imports+ -- $setup ) where import Siphon.Types@@ -67,6 +57,7 @@ import qualified Colonnade.Encode as CE import qualified Data.Vector.Mutable as MV import qualified Data.ByteString.Builder as BB+import qualified Data.Semigroup as SG import Control.Monad.Trans.Class import Data.Functor.Identity (Identity(..))@@ -82,6 +73,7 @@ import Data.Vector.Mutable (MVector) import Control.Monad.ST import Data.Text (Text)+import Data.Semigroup (Semigroup) newtype Escaped c = Escaped { getEscaped :: c } data Ended = EndedYes | EndedNo@@ -89,11 +81,11 @@ data CellResult c = CellResultData !c | CellResultNewline !c !Ended deriving (Show) -decodeHeadedUtf8Csv :: Monad m +decodeCsvUtf8 :: Monad m => Siphon CE.Headed ByteString a -> Stream (Of ByteString) m () -- ^ encoded csv -> Stream (Of a) m (Maybe SiphonError)-decodeHeadedUtf8Csv headedSiphon s1 = do+decodeCsvUtf8 headedSiphon s1 = do e <- lift (consumeHeaderRowUtf8 s1) case e of Left err -> return (Just err)@@ -110,6 +102,9 @@ encodeCsvStreamUtf8 = encodeCsvInternal escapeChar8 (B.singleton comma) (B.singleton newline) +-- | Streaming variant of 'encodeCsv'. This is particularly useful+-- when you need to produce millions of rows without having them+-- all loaded into memory at the same time. encodeCsvStream :: (Monad m, CE.Headedness h) => CE.Colonnade h a Text -> Stream (Of a) m r@@ -265,10 +260,13 @@ data HeaderErrors = HeaderErrors !(Vector (Vector CellError)) !(Vector T.Text) !(Vector Int) +instance Semigroup HeaderErrors where+ HeaderErrors a1 b1 c1 <> HeaderErrors a2 b2 c2 = HeaderErrors+ (mappend a1 a2) (mappend b1 b2) (mappend c1 c2)+ 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)+ mappend = (SG.<>) -- byteStringChar8 :: Siphon ByteString -- byteStringChar8 = Siphon@@ -316,11 +314,12 @@ t <> TB.singleton '"' --- | Parse a record, not including the terminating line separator. The+-- 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@@ -334,6 +333,7 @@ -- 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@@ -348,7 +348,7 @@ case mb of Just b | b == doubleQuote -> do- (bs,tc) <- escapedField delim+ (bs,tc) <- escapedField case tc of TrailCharComma -> return (CellResultData bs) TrailCharNewline -> return (CellResultNewline bs EndedNo)@@ -371,8 +371,8 @@ eatNewlines :: AL.Parser S.ByteString eatNewlines = A.takeWhile (\x -> x == 10 || x == 13) -escapedField :: Word8 -> AL.Parser (S.ByteString,TrailChar)-escapedField !delim = do+escapedField :: AL.Parser (S.ByteString,TrailChar)+escapedField = do _ <- dquote -- The scan state is 'True' if the previous character was a double -- quote. We need to drop a trailing double quote left by scan.@@ -440,16 +440,6 @@ 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' #-}-- doubleQuote, newline, cr, comma :: Word8 doubleQuote = 34 newline = 10@@ -548,7 +538,7 @@ 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)+consumeHeaderRowUtf8 = consumeHeaderRow (A.parse (field comma)) B.null B.empty (\() -> True) consumeBodyUtf8 :: forall m a. Monad m => Int -- ^ index of first row, usually zero or one@@ -563,14 +553,13 @@ utf8ToStr = either (\_ -> T.empty) id . decodeUtf8' consumeHeaderRow :: forall m r c. Monad m- => (c -> T.Text)- -> (c -> ATYP.IResult c (CellResult c))+ => (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+consumeHeaderRow parseCell isNull emptyStr isGood s0 = go 0 StrictListNil s0 where go :: Int -> StrictList c@@ -747,12 +736,17 @@ go !ix1 (SiphonAp (IndexedHeader ix2 _) _ apNext) = go (max ix1 ix2) apNext +-- | Uses the argument to parse a CSV column. headless :: (c -> Maybe a) -> Siphon CE.Headless c a headless f = SiphonAp CE.Headless f (SiphonPure id) +-- | Uses the second argument to parse a CSV column whose +-- header content matches the first column exactly. headed :: c -> (c -> Maybe a) -> Siphon CE.Headed c a headed h f = SiphonAp (CE.Headed h) f (SiphonPure id) +-- | Uses the second argument to parse a CSV column that+-- is positioned at the index given by the first argument. indexed :: Int -> (c -> Maybe a) -> Siphon Indexed c a indexed ix f = SiphonAp (Indexed ix) f (SiphonPure id)
test/Test.hs view
@@ -23,12 +23,15 @@ 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 Data.Word (Word8)+import Data.Char (ord)+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 Data.ByteString as B+import qualified Colonnade as Colonnade import qualified Siphon as S import qualified Streaming.Prelude as SMP import qualified Data.Text.Lazy as LText@@ -42,7 +45,7 @@ tests = [ testGroup "ByteString encode/decode" [ testCase "Headed Encoding (int,char,bool)"- $ runTestScenario [(4,'c',False)]+ $ runTestScenario [(4,intToWord8 (ord 'c'),False)] S.encodeCsvStreamUtf8 encodingB $ ByteString.concat@@ -69,16 +72,16 @@ ] , testCase "Headed Decoding (int,char,bool)" $ ( runIdentity . SMP.toList )- ( S.decodeHeadedUtf8Csv decodingB+ ( S.decodeCsvUtf8 decodingB ( mapM_ (SMP.yield . BC8.singleton) $ concat [ "number,letter,boolean\n" , "244,z,true\n" ] )- ) @?= ([(244,'z',True)] :> Nothing)+ ) @?= ([(244,intToWord8 (ord 'z'),True)] :> Nothing) , testCase "Headed Decoding (escaped characters, one big chunk)" $ ( runIdentity . SMP.toList )- ( S.decodeHeadedUtf8Csv decodingF+ ( S.decodeCsvUtf8 decodingF ( SMP.yield $ BC8.pack $ concat [ "name\n" , "drew\n"@@ -88,7 +91,7 @@ ) @?= (["drew","martin, drew"] :> Nothing) , testCase "Headed Decoding (escaped characters, character per chunk)" $ ( runIdentity . SMP.toList )- ( S.decodeHeadedUtf8Csv decodingF+ ( S.decodeCsvUtf8 decodingF ( mapM_ (SMP.yield . BC8.singleton) $ concat [ "name\n" , "drew\n"@@ -98,11 +101,14 @@ ) @?= (["drew","martin, drew"] :> Nothing) , testProperty "Headed Isomorphism (int,char,bool)" $ propIsoStream BC8.unpack- (S.decodeHeadedUtf8Csv decodingB)+ (S.decodeCsvUtf8 decodingB) (S.encodeCsvStreamUtf8 encodingB) ] ] +intToWord8 :: Int -> Word8+intToWord8 = fromIntegral+ data Foo = FooA | FooB | FooC deriving (Generic,Eq,Ord,Show,Read,Bounded,Enum) @@ -134,10 +140,10 @@ <*> S.headless dbChar <*> S.headless dbBool -decodingB :: Siphon Headed ByteString (Int,Char,Bool)+decodingB :: Siphon Headed ByteString (Int,Word8,Bool) decodingB = (,,) <$> S.headed "number" dbInt- <*> S.headed "letter" dbChar+ <*> S.headed "letter" dbWord8 <*> S.headed "boolean" dbBool decodingF :: Siphon Headed ByteString ByteString@@ -174,10 +180,10 @@ encodingF :: Colonnade Headed ByteString ByteString encodingF = headed "name" id -encodingB :: Colonnade Headed (Int,Char,Bool) ByteString+encodingB :: Colonnade Headed (Int,Word8,Bool) ByteString encodingB = mconcat [ lmap fst3 (headed "number" ebInt)- , lmap snd3 (headed "letter" ebChar)+ , lmap snd3 (headed "letter" ebWord8) , lmap thd3 (headed "boolean" ebBool) ] @@ -263,6 +269,11 @@ 1 -> Just (BC8.head b) _ -> Nothing +dbWord8 :: ByteString -> Maybe Word8+dbWord8 b = case B.length b of+ 1 -> Just (B.head b)+ _ -> Nothing+ dbInt :: ByteString -> Maybe Int dbInt b = do (a,bsRem) <- BC8.readInt b@@ -278,6 +289,9 @@ ebChar :: Char -> ByteString ebChar = BC8.singleton++ebWord8 :: Word8 -> ByteString+ebWord8 = B.singleton ebInt :: Int -> ByteString ebInt = LByteString.toStrict