diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,13 @@ +# 0.6.0 +Support external CSV tokenizers + +Internal functionality is now defined more cleanly atop a stream of rows already broken into columns (rather than a stream of rows that we quietly break into columns ourself). This permits the use of external parsers such as provided by the new [Frames-dsv](https://hackage.haskell.org/package/Frames-dsv) package that supplies a CSV parser built atop `hw-dsv`. + +The built-in CSV parser remains for ease of installation. + +# 0.5.1 +GHC 8.6 compatibility + # 0.5.0 - Renamed the `rgetf` and `rputf` exported by the `Frames` module to `rgetField` and `rputField`. This avoids clashing with the same names exported by `vinyl` and further advances the process of eliminating the old `Frames` `Col` type in favor of `vinyl`'s `ElField`. diff --git a/Frames.cabal b/Frames.cabal --- a/Frames.cabal +++ b/Frames.cabal @@ -1,5 +1,5 @@ name: Frames -version: 0.5.1 +version: 0.6.0 synopsis: Data frames For working with tabular data files description: User-friendly, type safe, runtime efficient tooling for working with tabular data deserialized from @@ -11,7 +11,7 @@ license-file: LICENSE author: Anthony Cowley maintainer: acowley@gmail.com -copyright: Copyright (C) 2014-2015 Anthony Cowley +copyright: Copyright (C) 2014-2018 Anthony Cowley category: Data build-type: Simple extra-source-files: benchmarks/*.hs benchmarks/*.py @@ -25,6 +25,7 @@ test/data/prestigeNoHeader.csv test/data/prestigePartial.csv test/data/catSmall.csv test/data/catLarge.csv + test/data/multiline.csv data/left1.csv data/right1.csv data/left_summary.csv data/FL2.csv cabal-version: >=1.10 diff --git a/data/GetData.hs b/data/GetData.hs --- a/data/GetData.hs +++ b/data/GetData.hs @@ -2,6 +2,7 @@ import Codec.Archive.Zip import qualified Data.ByteString.Lazy.Char8 as B import Data.Maybe (fromJust) +import Data.Monoid (First(..)) import Network.HTTP.Client import System.Directory (createDirectoryIfMissing) @@ -28,6 +29,13 @@ httpLbs req m >>= B.writeFile "data/adult.csv" . B.append colNames + . B.unlines + . map (\ln -> maybe ln id + . getFirst + $ foldMap (First . ($ ln)) + [ B.stripSuffix ", <=50K" + , B.stripSuffix ", >50K" ]) + . B.lines . responseBody where Just req = parseUrlThrow "http://archive.ics.uci.edu/ml/machine-learning-databases/adult/adult.data" colNames = "age, workclass, fnlwgt, education, education-num, \ diff --git a/src/Frames/CSV.hs b/src/Frames/CSV.hs --- a/src/Frames/CSV.hs +++ b/src/Frames/CSV.hs @@ -8,7 +8,7 @@ -- to those types. module Frames.CSV where import Control.Exception (try, IOException) -import Control.Monad (when) +import Control.Monad (when, unless) import qualified Data.ByteString.Char8 as B8 import qualified Data.Foldable as F import Data.List (intercalate) @@ -140,25 +140,35 @@ -- | Infer column types from a prefix (up to 1000 lines) of a CSV -- file. prefixInference :: (ColumnTypeable a, Monoid a, Monad m) - => ParserOptions - -> P.Parser T.Text m [a] -prefixInference opts = P.draw >>= \case + => P.Parser [T.Text] m [a] +prefixInference = P.draw >>= \case Nothing -> return [] Just row1 -> P.foldAll (\ts -> zipWith (<>) ts . inferCols) (inferCols row1) id - where inferCols = map inferType . tokenizeRow opts + where inferCols = map inferType -- | Extract column names and inferred types from a CSV file. readColHeaders :: (ColumnTypeable a, Monoid a, Monad m) - => ParserOptions -> P.Producer T.Text m () -> m [(T.Text, a)] + => ParserOptions -> P.Producer [T.Text] m () -> m [(T.Text, a)] readColHeaders opts = P.evalStateT $ - do headerRow <- maybe ((tokenizeRow opts - . fromMaybe (error "Empty Producer has no header row")) <$> P.draw) + do headerRow <- maybe (fromMaybe err <$> P.draw) pure (headerOverride opts) - colTypes <- prefixInference opts + colTypes <- prefixInference + unless (length headerRow == length colTypes) (error errNumColumns) return (zip headerRow colTypes) + where err = error "Empty Producer has no header row" + errNumColumns = + unlines + [ "" + , "Error parsing CSV: " + , " Number of columns in header differs from number of columns" + , " found in the remaining file. This may be due to newlines" + , " being present within the data itself (not just separating" + , " rows). If support for embedded newlines is required, " + , " consider using the Frames-dsv package in conjunction with" + , " Frames to make use of a different CSV parser."] -- * Loading CSV Data @@ -194,6 +204,16 @@ produceTextLines :: P.MonadSafe m => FilePath -> P.Producer T.Text m () produceTextLines = pipeLines (try . T.hGetLine) +-- | Produce lines of tokens that were separated by the given +-- separator. +produceTokens :: P.MonadSafe m + => FilePath + -> Separator + -> P.Producer [T.Text] m () +produceTokens fp sep = produceTextLines fp >-> P.map tokenize + where tokenize = tokenizeRow popts + popts = defaultParser { columnSeparator = sep } + -- | Consume lines of 'T.Text', writing them to a file. consumeTextLines :: P.MonadSafe m => FilePath -> P.Consumer T.Text m r consumeTextLines fp = Safe.withFile fp WriteMode $ \h -> @@ -202,8 +222,9 @@ -- | Produce the lines of a latin1 (or ISO8859 Part 1) encoded file as -- ’T.Text’ values. -readFileLatin1Ln :: P.MonadSafe m => FilePath -> P.Producer T.Text m () -readFileLatin1Ln = pipeLines (try . fmap T.decodeLatin1 . B8.hGetLine) +readFileLatin1Ln :: P.MonadSafe m => FilePath -> P.Producer [T.Text] m () +readFileLatin1Ln fp = pipeLines (try . fmap T.decodeLatin1 . B8.hGetLine) fp + >-> P.map (tokenizeRow defaultParser) -- | Read a 'RecF' from one line of CSV. readRow :: ReadRec rs @@ -216,17 +237,19 @@ -> FilePath -> P.Producer (Rec (Maybe :. ElField) rs) m () readTableMaybeOpt opts csvFile = - produceTextLines csvFile >-> pipeTableMaybeOpt opts + produceTokens csvFile (columnSeparator opts) >-> pipeTableMaybeOpt opts {-# INLINE readTableMaybeOpt #-} -- | Stream lines of CSV data into rows of ’Rec’ values values where -- any given entry can fail to parse. pipeTableMaybeOpt :: (Monad m, ReadRec rs, RMap rs) => ParserOptions - -> P.Pipe T.Text (Rec (Maybe :. ElField) rs) m () + -> P.Pipe [T.Text] (Rec (Maybe :. ElField) rs) m () pipeTableMaybeOpt opts = do when (isNothing (headerOverride opts)) (() <$ P.await) - P.map (rmap (either (const (Compose Nothing)) (Compose . Just) . getCompose) . readRow opts) + P.map (rmap (either (const (Compose Nothing)) + (Compose . Just) . getCompose) + . readRec) {-# INLINE pipeTableMaybeOpt #-} -- | Stream lines of CSV data into rows of ’Rec’ values values where @@ -249,7 +272,7 @@ -- | Stream lines of CSV data into rows of ’Rec’ values where any -- given entry can fail to parse. pipeTableMaybe :: (Monad m, ReadRec rs, RMap rs) - => P.Pipe T.Text (Rec (Maybe :. ElField) rs) m () + => P.Pipe [T.Text] (Rec (Maybe :. ElField) rs) m () pipeTableMaybe = pipeTableMaybeOpt defaultParser {-# INLINE pipeTableMaybe #-} @@ -296,7 +319,7 @@ -- | Pipe lines of CSV text into rows for which each column was -- successfully parsed. pipeTableOpt :: (ReadRec rs, RMap rs, Monad m) - => ParserOptions -> P.Pipe T.Text (Record rs) m () + => ParserOptions -> P.Pipe [T.Text] (Record rs) m () pipeTableOpt opts = pipeTableMaybeOpt opts >-> P.map recMaybe >-> P.concat {-# INLINE pipeTableOpt #-} @@ -310,7 +333,7 @@ -- | Pipe lines of CSV text into rows for which each column was -- successfully parsed. pipeTable :: (ReadRec rs, RMap rs, Monad m) - => P.Pipe T.Text (Record rs) m () + => P.Pipe [T.Text] (Record rs) m () pipeTable = pipeTableOpt defaultParser {-# INLINE pipeTable #-} diff --git a/src/Frames/InCore.hs b/src/Frames/InCore.hs --- a/src/Frames/InCore.hs +++ b/src/Frames/InCore.hs @@ -1,13 +1,6 @@ -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE BangPatterns, - CPP, - DataKinds, - EmptyCase, - FlexibleInstances, - ScopedTypeVariables, - TupleSections, - TypeFamilies, - TypeOperators, +{-# LANGUAGE BangPatterns, CPP, DataKinds, EmptyCase, + FlexibleInstances, PolyKinds, ScopedTypeVariables, + TupleSections, TypeFamilies, TypeOperators, UndecidableInstances #-} -- | Efficient in-memory (in-core) storage of tabular data. module Frames.InCore where diff --git a/src/Frames/TH.hs b/src/Frames/TH.hs --- a/src/Frames/TH.hs +++ b/src/Frames/TH.hs @@ -150,8 +150,9 @@ -- ^ A record field that mentions the phantom type list of -- possible column types. Having this field prevents record -- update syntax from losing track of the type argument. - , lineReader :: P.Producer T.Text (P.SafeT IO) () - -- ^ A producer of lines of ’T.Text’xs + , lineReader :: Separator -> P.Producer [T.Text] (P.SafeT IO) () + -- ^ A producer of rows of ’T.Text’ values that were + -- separated by a 'Separator' value. } -- -- | Shorthand for a 'Proxy' value of 'ColumnUniverse' applied to the @@ -164,12 +165,12 @@ -- separator (a comma), infer column types from the default 'Columns' -- set of types, and produce a row type with name @Row@. rowGen :: FilePath -> RowGen CommonColumns -rowGen = RowGen [] "" defaultSep "Row" Proxy . produceTextLines +rowGen = RowGen [] "" defaultSep "Row" Proxy . produceTokens -- | Like 'rowGen', but will also generate custom data types for -- 'Categorical' variables with up to 8 distinct variants. rowGenCat :: FilePath -> RowGen CommonColumnsCat -rowGenCat = RowGen [] "" defaultSep "Row" Proxy . produceTextLines +rowGenCat = RowGen [] "" defaultSep "Row" Proxy . produceTokens -- -- | Generate a type for each row of a table. This will be something -- -- like @Record ["x" :-> a, "y" :-> b, "z" :-> c]@. @@ -202,12 +203,11 @@ -- colNames' | null columnNames = Nothing -- | otherwise = Just (map T.pack columnNames) -- opts = ParserOptions colNames' separator (RFC4180Quoting '\"') --- lineSource = lineReader >-> P.take prefixSize +-- lineSource = lineReader separator >-> P.take prefixSize -- | Tokenize the first line of a ’P.Producer’. -colNamesP :: Monad m - => ParserOptions -> P.Producer T.Text m () -> m [T.Text] -colNamesP opts src = either (const []) (tokenizeRow opts . fst) <$> P.next src +colNamesP :: Monad m => P.Producer [T.Text] m () -> m [T.Text] +colNamesP src = either (const []) fst <$> P.next src -- | Generate a type for a row of a table all of whose columns remain -- unparsed 'Text' values. @@ -216,7 +216,7 @@ => RowGen a -> DecsQ tableTypesText' (RowGen {..}) = do colNames <- runIO . P.runSafeT $ - maybe (colNamesP opts lineReader) + maybe (colNamesP (lineReader separator)) pure (headerOverride opts) let headers = zip colNames (repeat (ConT ''T.Text)) @@ -266,7 +266,7 @@ where colNames' | null columnNames = Nothing | otherwise = Just (map T.pack columnNames) opts = ParserOptions colNames' separator (RFC4180Quoting '\"') - lineSource = lineReader P.>-> P.take prefixSize + lineSource = lineReader separator P.>-> P.take prefixSize mkColDecs :: T.Text -> Either (String -> Q [Dec]) Type -> Q (Type, [Dec]) mkColDecs colNm colTy = do let safeName = tablePrefix ++ (T.unpack . sanitizeTypeName $ colNm) diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,6 +1,8 @@ {-# LANGUAGE CPP, DataKinds, OverloadedStrings, QuasiQuotes, - TemplateHaskell, TypeOperators #-} + ScopedTypeVariables, TemplateHaskell, TypeApplications, + TypeOperators #-} module Main (manualGeneration, main) where +import Control.Exception (ErrorCall, catch) import Control.Monad (unless) import Data.Functor.Identity import Data.Char @@ -12,6 +14,7 @@ import Language.Haskell.TH.Syntax (addDependentFile) import Frames import Frames.CSV (produceCSV) +import Frames.CSV (defaultParser, produceTokens, defaultSep, readColHeaders) import DataCSV import Pipes.Prelude (toListM) import PrettyTH @@ -189,3 +192,12 @@ mCustom <- H.runIO Categorical.fifthMonthCustom it "Can parse into manually-specified categorical variables" $ mCustom `shouldBe` Just Categorical.MyMay + describe "Detects parse failures" $ do + caught <- H.runIO $ + (runSafeT $ do + _ <- readColHeaders @Columns + defaultParser + (produceTokens "test/data/multiline.csv" defaultSep) + return False) + `catch` \(_ :: ErrorCall) -> return True + it "Fails on embedded newlines" caught diff --git a/test/data/multiline.csv b/test/data/multiline.csv new file mode 100644 --- /dev/null +++ b/test/data/multiline.csv @@ -0,0 +1,8 @@ +RowNum,Description,X,Y +1,"simple",10,10 +2,"""quoted""",20,20 +3,"multi +line +text +field",30,30 +4,"simple again",40,40