diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,6 +1,12 @@ # Revision history for sv +## 1.1 -- 2018-07-25 + +* Add column-name-based decoding by adding parseDecodeNamed and associated functions +* Support sv-core 0.2 + ## 1.0 -- 2018-07-19 + * Split the package into sv, sv-core, svfactor. This removes Data.Sv.{Parse,Print,Syntax} and changes types in Data.Sv.Decode and Data.Sv.Encode. Compatibility with version 0.1 is minimal diff --git a/src/Data/Sv.hs b/src/Data/Sv.hs --- a/src/Data/Sv.hs +++ b/src/Data/Sv.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} + {-| Module : Data.Sv Copyright : (C) CSIRO 2017-2018 @@ -22,6 +25,9 @@ parseDecode , parseDecodeFromFile , parseDecodeFromDsvCursor + , parseDecodeNamed + , parseDecodeNamedFromFile + , parseDecodeNamedFromDsvCursor , decode , decodeMay , decodeEither @@ -87,6 +93,17 @@ cursor = DSV.makeCursor sep bs in parseDecodeFromDsvCursor d opts cursor +-- | Parse a 'ByteString' as an Sv, and then decode it with the given colum +-- based decoder. +parseDecodeNamed :: + NameDecode' ByteString a + -> ParseOptions + -> LBS.ByteString + -> DecodeValidation ByteString [a] +parseDecodeNamed d opts bs = + parseDecodeNamedFromDsvCursor d opts + (DSV.makeCursor (_separator opts) bs) + -- | Load a file, parse it, and decode it. parseDecodeFromFile :: MonadIO m @@ -97,11 +114,41 @@ parseDecodeFromFile d opts fp = parseDecode d opts <$> liftIO (LBS.readFile fp) +-- | Load a file, parse it, and decode it by column. +parseDecodeNamedFromFile :: + MonadIO m + => NameDecode' ByteString a + -> ParseOptions + -> FilePath + -> m (DecodeValidation ByteString [a]) +parseDecodeNamedFromFile d opts fp = + parseDecodeNamed d opts <$> liftIO (LBS.readFile fp) + -- | Decode from a 'DsvCursor' parseDecodeFromDsvCursor :: Decode' ByteString a -> ParseOptions -> DsvCursor -> DecodeValidation ByteString [a] parseDecodeFromDsvCursor d opts cursor = - let toField = Prelude.either badParse pure . parse - parse = first UTF8.fromString . AL.eitherResult . AL.parse field - in flip bindValidation (decode d) . traverse (traverse toField) . DSV.toListVector $ case _headedness opts of - Unheaded -> cursor - Headed -> nextPosition (nextRow cursor) + flip bindValidation (decode d) . traverse (traverse toField) . DSV.toListVector $ case _headedness opts of + Unheaded -> cursor + Headed -> nextPosition (nextRow cursor) + +-- | Decode from a 'DsvCursor' +parseDecodeNamedFromDsvCursor :: NameDecode' ByteString a -> ParseOptions -> DsvCursor -> DecodeValidation ByteString [a] +parseDecodeNamedFromDsvCursor n opts cursor = + let parts = + case DSV.toListVector cursor of + [] -> missingHeader + (header:body) -> + let header' = traverse toField header + in case _headedness opts of + Unheaded -> + badConfig $ mconcat + [ "Your ParseOptions indicates a CSV with no header (Unheaded),\n" + , "but your decoder requires column names." + ] + Headed -> + (,body) <$> bindValidation header' (flip makePositional n) + in bindValidation parts $ \(d,b) -> + flip bindValidation (decode d) $ traverse (traverse toField) b + +toField :: LBS.ByteString -> DecodeValidation ByteString ByteString +toField = Prelude.either badParse pure . first UTF8.fromString . AL.eitherResult . AL.parse field diff --git a/sv.cabal b/sv.cabal --- a/sv.cabal +++ b/sv.cabal @@ -1,5 +1,5 @@ name: sv -version: 1.0 +version: 1.1 license: BSD3 license-file: LICENCE author: George Wilson @@ -44,6 +44,7 @@ Examples: . * Decoding a real CSV: + * Decoding by column name: * Encoding data to a CSV: * Handling NULL and Unknown occuring in a column of numbers: * Dealing with non-rectangular data: @@ -96,7 +97,7 @@ , contravariant >= 1.2 && < 1.6 , hw-dsv >= 0.2.1 && < 0.3 , semigroupoids >= 5 && <6 - , sv-core >= 0.1 && < 0.2 + , sv-core >= 0.2 && < 0.3 , transformers >= 0.2 && < 0.6 , utf8-string >= 1 && < 1.1 , validation >= 1 && < 1.1 diff --git a/test/Data/Sv/DecodeTest.hs b/test/Data/Sv/DecodeTest.hs --- a/test/Data/Sv/DecodeTest.hs +++ b/test/Data/Sv/DecodeTest.hs @@ -28,6 +28,7 @@ intOrStringTest , varyingLengthTest , semigroupoidTest + , namedTest ] data IntOrString = @@ -120,4 +121,84 @@ , testCase "Does the right thing in the case of right failure" $ parseDecode semiD opts semiTestString3 @?= Failure (DecodeErrors (pure (BadDecode "Couldn't parse \"false\" as a double"))) + ] + +-- This CSV has enough columns to make an Item, it has more columns than a +-- SemiItem/SemiItem2, and not enough columns for a SuperItem/SuperItem2 +namedCsv :: LBS.ByteString +namedCsv = + LBS.intercalate "\n" [ + "id,name,cost,units" + , "1,fridge,600,5" + , "2,stereo,1499.99,2" + , "3,dryer,748.95,3" + ] + +data Item = Item Int Text Double Int deriving (Eq, Show) +data SemiItem = SemiItem Text Double deriving (Eq, Show) +data SemiItem2 = SemiItem2 Int Double deriving (Eq, Show) +data SuperItem = SuperItem Int Text Text Double Int deriving (Eq, Show) +data SuperItem2 = SuperItem2 Int Text Text Double Int Double deriving (Eq, Show) + +inOrder :: NameDecode' ByteString Item +inOrder = + Item <$> D.column "id" D.int <*> D.column "name" D.utf8 + <*> D.column "cost" D.double <*> D.column "units" D.int + +outOrder :: NameDecode' ByteString Item +outOrder = + (\n u c i -> Item i n c u) <$> D.column "name" D.utf8 + <*> D.column "units" D.int <*> D.column "cost" D.double + <*> D.column "id" D.int + +inOrderSemi :: NameDecode' ByteString SemiItem +inOrderSemi = + SemiItem <$> D.column "name" D.utf8 <*> D.column "cost" D.double + +outOrderSemi :: NameDecode' ByteString SemiItem2 +outOrderSemi = + SemiItem2 <$> D.column "units" D.int <*> D.column "cost" D.double + +super :: NameDecode' ByteString SuperItem +super = + SuperItem <$> D.column "id" D.int <*> D.column "name" D.utf8 + <*> D.column "manufacturer" D.utf8 + <*> D.column "cost" D.double <*> D.column "units" D.int + +super2 :: NameDecode' ByteString SuperItem2 +super2 = + SuperItem2 <$> D.column "id" D.int <*> D.column "name" D.utf8 + <*> D.column "manufacturer" D.utf8 + <*> D.column "cost" D.double <*> D.column "units" D.int + <*> D.column "profit" D.double + +namedTest :: TestTree +namedTest = testGroup "Named decodes" + [ testCase "columns in order" $ + parseDecodeNamed inOrder defaultParseOptions namedCsv @?= + pure [Item 1 "fridge" 600 5, Item 2 "stereo" 1499.99 2, Item 3 "dryer" 748.95 3] + , testCase "columns out of order" $ + parseDecodeNamed outOrder defaultParseOptions namedCsv @?= + pure [Item 1 "fridge" 600 5, Item 2 "stereo" 1499.99 2, Item 3 "dryer" 748.95 3] + , testCase "columns in order, with some skipped" $ + parseDecodeNamed inOrderSemi defaultParseOptions namedCsv @?= + pure [SemiItem "fridge" 600, SemiItem "stereo" 1499.99, SemiItem "dryer" 748.95] + , testCase "columns out of order, with some skipped" $ + parseDecodeNamed outOrderSemi defaultParseOptions namedCsv @?= + pure [SemiItem2 5 600, SemiItem2 2 1499.99, SemiItem2 3 748.95] + , testCase "one missing column" $ + parseDecodeNamed super defaultParseOptions namedCsv @?= + Failure (DecodeErrors (MissingColumn "manufacturer":|[])) + , testCase "multiple missing columns" $ + parseDecodeNamed super2 defaultParseOptions namedCsv @?= + Failure (DecodeErrors (MissingColumn "manufacturer":|[MissingColumn "profit"])) + , testCase "empty document (missing header)" $ + parseDecodeNamed inOrder defaultParseOptions "" @?= + Failure (DecodeErrors (MissingHeader:|[])) + , testCase "misconfigured" $ + parseDecodeNamed inOrder opts namedCsv @?= + Failure (DecodeErrors ( + BadConfig "Your ParseOptions indicates a CSV with no header (Unheaded),\nbut your decoder requires column names." + :|[] + )) ]