siphon 0.8.1.2 → 0.8.2.0
raw patch · 6 files changed
+126/−80 lines, 6 filesdep −doctestdep ~basedep ~semigroupsdep ~text
Dependencies removed: doctest
Dependency ranges changed: base, semigroups, text, transformers
Files
- CHANGELOG.md +4/−0
- siphon.cabal +12/−21
- src/Siphon.hs +50/−36
- src/Siphon/Types.hs +7/−0
- test/Doctest.hs +0/−8
- test/Test.hs +53/−15
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for siphon +## 0.8.2.0 -- 2022-??-??++* Add+ ## 0.8.1.2 -- 2021-10-25 * Correct handling of CRLF.
siphon.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: siphon-version: 0.8.1.2+version: 0.8.2.0 synopsis: Encode and decode CSV files description: Please see README.md homepage: https://github.com/andrewthad/colonnade#readme@@ -21,7 +21,7 @@ build-depends: base >= 4.8 && < 5 , colonnade >= 1.2 && < 1.3- , text >= 1.0 && < 1.3+ , text >= 1.0 && < 2.1 , bytestring , vector , streaming >= 0.1.4 && < 0.3@@ -30,36 +30,27 @@ , semigroups >= 0.18.2 && < 0.20 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 test type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Test.hs build-depends: base- , either- , siphon- , colonnade- , contravariant- , test-framework- , test-framework-quickcheck2+ , HUnit , QuickCheck- , text , bytestring+ , colonnade+ , contravariant+ , either , pipes- , HUnit- , test-framework-hunit , profunctors+ , siphon , streaming+ , test-framework+ , test-framework-hunit+ , test-framework-quickcheck2+ , text+ , vector default-language: Haskell2010 source-repository head
src/Siphon.hs view
@@ -18,6 +18,8 @@ , encodeCsvStreamUtf8 -- * Decode CSV , decodeCsvUtf8+ , decodeHeadedCsvUtf8+ , decodeIndexedCsvUtf8 -- * Build Siphon , headed , headless@@ -26,8 +28,12 @@ , Siphon , SiphonError(..) , Indexed(..)+ -- * For Testing+ , headedToIndexed -- * Utility , humanizeSiphonError+ , eqSiphonHeaders+ , showSiphonHeaders -- * Imports -- $setup ) where@@ -36,6 +42,7 @@ import Data.Monoid import Control.Applicative import Control.Monad+import Data.Functor.Classes (Eq1,Show1,liftEq,showsPrec1) import qualified Data.ByteString.Char8 as BC8 import qualified Data.Attoparsec.ByteString as A@@ -81,11 +88,19 @@ data CellResult c = CellResultData !c | CellResultNewline !c !Ended deriving (Show) -decodeCsvUtf8 :: Monad m +-- | Backwards-compatibility alias for 'decodeHeadedCsvUtf8'.+decodeCsvUtf8 :: Monad m => Siphon CE.Headed ByteString a -> Stream (Of ByteString) m () -- ^ encoded csv -> Stream (Of a) m (Maybe SiphonError)-decodeCsvUtf8 headedSiphon s1 = do+decodeCsvUtf8 = decodeHeadedCsvUtf8++-- | Decode a CSV whose first row is contains headers identify each column.+decodeHeadedCsvUtf8 :: Monad m+ => Siphon CE.Headed ByteString a+ -> Stream (Of ByteString) m () -- ^ encoded csv+ -> Stream (Of a) m (Maybe SiphonError)+decodeHeadedCsvUtf8 headedSiphon s1 = do e <- lift (consumeHeaderRowUtf8 s1) case e of Left err -> return (Just err)@@ -95,6 +110,15 @@ let requiredLength = V.length v consumeBodyUtf8 1 requiredLength ixedSiphon s2 +-- | Decode a CSV without a header.+decodeIndexedCsvUtf8 :: Monad m+ => Int -- ^ How many columns are there? This number should be greater than any indices referenced by the scheme.+ -> Siphon Indexed ByteString a+ -> Stream (Of ByteString) m () -- ^ encoded csv+ -> Stream (Of a) m (Maybe SiphonError)+decodeIndexedCsvUtf8 !requiredLength ixedSiphon s1 = do+ consumeBodyUtf8 0 requiredLength ixedSiphon s1+ encodeCsvStreamUtf8 :: (Monad m, CE.Headedness h) => CE.Colonnade h a ByteString -> Stream (Of a) m r@@ -222,11 +246,6 @@ 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.@@ -234,7 +253,7 @@ => (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)+ -> Either SiphonError (Siphon Indexed c a) headedToIndexed toStr v = mapLeft (\(HeaderErrors a b c) -> SiphonError 0 (RowErrorHeaders a b c)) . getEitherWrap@@ -242,19 +261,19 @@ where go :: forall b. Siphon CE.Headed c b- -> EitherWrap HeaderErrors (Siphon IndexedHeader c b)+ -> EitherWrap HeaderErrors (Siphon Indexed 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 == 1 = Right (ixs V.! 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)+ in (\ix nextSiphon -> SiphonAp (Indexed ix) decode nextSiphon) <$> EitherWrap rcurrent <*> rnext @@ -444,10 +463,6 @@ 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))- doubleQuote, newline, cr, comma :: Word8 doubleQuote = 34 newline = 10@@ -551,7 +566,7 @@ consumeBodyUtf8 :: forall m a. Monad m => Int -- ^ index of first row, usually zero or one -> Int -- ^ Required row length- -> Siphon IndexedHeader ByteString a+ -> Siphon Indexed ByteString a -> Stream (Of ByteString) m () -> Stream (Of a) m (Maybe SiphonError) consumeBodyUtf8 = consumeBody utf8ToStr@@ -608,7 +623,7 @@ -> (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+ -> Siphon Indexed c a -> Stream (Of c) m r -> Stream (Of a) m (Maybe SiphonError) consumeBody toStr parseCell isNull emptyStr isGood row0 reqLen siphon s0 =@@ -669,13 +684,13 @@ return mv where go1 :: forall s. MVector s c -> ST s ()- go1 !mv = go2 0 sl0+ go1 !mv = go2 (len - 1) 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+ go2 (ix - 1) slNext skipWhile :: forall m a r. Monad m@@ -694,6 +709,8 @@ else return e -- | Strict in the spine and in the values+-- This is built in reverse and then reversed by reverseVectorStrictList+-- when converting to a vector. data StrictList a = StrictListNil | StrictListCons !a !(StrictList a) -- | This function uses 'unsafeIndex' to access@@ -701,7 +718,7 @@ uncheckedRunWithRow :: (c -> T.Text) -> Int- -> Siphon IndexedHeader c a+ -> Siphon Indexed c a -> Vector c -> Either SiphonError a uncheckedRunWithRow toStr i d v =@@ -713,16 +730,16 @@ -- out of the bounds. uncheckedRun :: forall c a. (c -> T.Text)- -> Siphon IndexedHeader c a+ -> Siphon Indexed c a -> Vector c -> Either (Vector CellError) a uncheckedRun toStr dc v = getEitherWrap (go dc) where go :: forall b.- Siphon IndexedHeader c b+ Siphon Indexed c b -> EitherWrap (Vector CellError) b go (SiphonPure b) = EitherWrap (Right b)- go (SiphonAp (IndexedHeader ix _) decode apNext) =+ go (SiphonAp (Indexed ix) decode apNext) = let rnext = go apNext content = v V.! ix -- V.unsafeIndex v ix rcurrent = maybe@@ -731,19 +748,6 @@ (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- -- | 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)@@ -757,6 +761,16 @@ -- 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)++eqSiphonHeaders :: (Eq1 f, Eq c) => Siphon f c a -> Siphon f c b -> Bool+eqSiphonHeaders (SiphonPure _) (SiphonPure _) = True+eqSiphonHeaders (SiphonAp h0 _ s0) (SiphonAp h1 _ s1) =+ liftEq (==) h0 h1 && eqSiphonHeaders s0 s1+eqSiphonHeaders _ _ = False++showSiphonHeaders :: (Show1 f, Show c) => Siphon f c a -> String+showSiphonHeaders (SiphonPure _) = ""+showSiphonHeaders (SiphonAp h0 _ s0) = showsPrec1 10 h0 (" :> " ++ showSiphonHeaders s0) -- $setup --
src/Siphon/Types.hs view
@@ -15,6 +15,7 @@ import Data.Vector (Vector) import Control.Exception (Exception) import Data.Text (Text)+import Data.Functor.Classes (Eq1,Show1,liftEq,liftShowsPrec) data CellError = CellError { cellErrorColumn :: !Int@@ -24,6 +25,12 @@ newtype Indexed a = Indexed { indexedIndex :: Int } deriving (Eq,Ord,Functor,Show,Read)++instance Show1 Indexed where+ liftShowsPrec _ _ p (Indexed i) s = showsPrec p i s++instance Eq1 Indexed where+ liftEq _ (Indexed i) (Indexed j) = i == j data SiphonError = SiphonError { siphonErrorRow :: !Int
− test/Doctest.hs
@@ -1,8 +0,0 @@-import Test.DocTest--main :: IO ()-main = doctest- [ "-isrc"- , "src/Siphon.hs"- ]-
test/Test.hs view
@@ -4,33 +4,35 @@ module Main (main) where -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 Colonnade (headed,headless,Colonnade,Headed,Headless)+import Control.Exception import Data.ByteString (ByteString)-import Data.Text (Text)-import GHC.Generics (Generic)+import Data.Char (ord) import Data.Either.Combinators-import Siphon.Types-import Data.Functor.Identity import Data.Functor.Contravariant (contramap) import Data.Functor.Contravariant.Divisible (divided,conquered)-import Colonnade (headed,headless,Colonnade,Headed,Headless)+import Data.Functor.Identity import Data.Profunctor (lmap)-import Streaming (Stream,Of(..))-import Control.Exception-import Debug.Trace+import Data.Text (Text) import Data.Word (Word8)-import Data.Char (ord)+import Debug.Trace+import GHC.Generics (Generic)+import Siphon.Types+import Streaming (Stream,Of(..))+import Test.Framework (defaultMain, testGroup, Test)+import Test.Framework.Providers.HUnit (testCase)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.HUnit (Assertion,(@?=))+import Test.QuickCheck (Gen, Arbitrary(..), choose, elements, Property)+import Test.QuickCheck.Property (Result, succeeded, exception)+ 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 Data.Vector as Vector import qualified Colonnade as Colonnade import qualified Siphon as S import qualified Streaming.Prelude as SMP@@ -118,6 +120,30 @@ ] ) ) @?= (["drew","martin, drew"] :> Nothing)+ , testCase "headedToIndexed" $+ let actual = S.headedToIndexed id (Vector.fromList ["letter","boolean","number"]) decodingG+ in case actual of+ Left e -> fail "headedToIndexed failed"+ Right actualInner -> + let expected = SiphonAp (Indexed 2 :: Indexed Text) (\_ -> Nothing)+ $ SiphonAp (Indexed 0 :: Indexed Text) (\_ -> Nothing)+ $ SiphonAp (Indexed 1 :: Indexed Text) (\_ -> Nothing)+ $ SiphonPure (\_ _ _ -> ())+ in case S.eqSiphonHeaders actualInner expected of+ True -> pure ()+ False -> fail $+ "Expected " +++ S.showSiphonHeaders expected +++ " but got " +++ S.showSiphonHeaders actualInner+ , testCase "Indexed Decoding (int,char,bool)"+ $ ( runIdentity . SMP.toList )+ ( S.decodeIndexedCsvUtf8 3 indexedDecodingB+ ( mapM_ (SMP.yield . BC8.singleton) $ concat+ [ "244,z,true\n"+ ]+ )+ ) @?= ([(244,intToWord8 (ord 'z'),True)] :> Nothing) , testProperty "Headed Isomorphism (int,char,bool)" $ propIsoStream BC8.unpack (S.decodeCsvUtf8 decodingB)@@ -164,6 +190,18 @@ <$> S.headed "number" dbInt <*> S.headed "letter" dbWord8 <*> S.headed "boolean" dbBool++indexedDecodingB :: Siphon Indexed ByteString (Int,Word8,Bool)+indexedDecodingB = (,,)+ <$> S.indexed 0 dbInt+ <*> S.indexed 1 dbWord8+ <*> S.indexed 2 dbBool++decodingG :: Siphon Headed Text ()+decodingG =+ S.headed "number" (\_ -> Nothing)+ <* S.headed "letter" (\_ -> Nothing)+ <* S.headed "boolean" (\_ -> Nothing) decodingF :: Siphon Headed ByteString ByteString decodingF = S.headed "name" Just