diff --git a/box-csv.cabal b/box-csv.cabal --- a/box-csv.cabal +++ b/box-csv.cabal @@ -1,67 +1,37 @@ cabal-version: 2.4 -name: box-csv -version: 0.0.3 -synopsis: See readme.md -description: See readme.md for description. -category: project -author: Tony Day -maintainer: tonyday567@gmail.com -copyright: Tony Day (c) AfterTimes -license: BSD-3-Clause -homepage: https://github.com/tonyday567/box-csv#readme -bug-reports: https://github.com/tonyday567/box-csv/issues -build-type: Simple +name: box-csv +version: 0.2.0 +synopsis: CSV parsing in a box. +description: CSV parsing using attoparsec and the box library. +category: project +author: Tony Day +maintainer: tonyday567@gmail.com +copyright: Tony Day (c) 2018-2022 +license: BSD-3-Clause +homepage: https://github.com/tonyday567/box-csv#readme +bug-reports: https://github.com/tonyday567/box-csv/issues +build-type: Simple +tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.2.1 + source-repository head - type: git + type: git location: https://github.com/tonyday567/box-csv library - hs-source-dirs: - src + hs-source-dirs: src default-extensions: - NoImplicitPrelude - NegativeLiterals - OverloadedStrings - UnicodeSyntax ghc-options: - -Wall - -Wcompat - -Wincomplete-record-updates - -Wincomplete-uni-patterns - -Wredundant-constraints - build-depends: - attoparsec >= 0.13, - base >=4.7 && <5, - box >= 0.6 && < 0.7, - generic-lens, - lens >= 4.19, - numhask >= 0.6 && < 0.7, - scientific >= 0.3, - text >= 1.2, - time >= 1.9, - exposed-modules: - Box.Csv - other-modules: - default-language: Haskell2010 + -Wall -Wcompat -Wincomplete-record-updates + -Wincomplete-uni-patterns -Wredundant-constraints -fwrite-ide-info + -hiedir=.hie -Wunused-packages -test-suite test - type: exitcode-stdio-1.0 - main-is: test.hs - hs-source-dirs: - test - default-extensions: - NoImplicitPrelude - NegativeLiterals - OverloadedStrings - UnicodeSyntax - ghc-options: - -Wall - -Wcompat - -Wincomplete-record-updates - -Wincomplete-uni-patterns - -Wredundant-constraints build-depends: - base >=4.7 && <5, - doctest >= 0.16, - numhask >= 0.6 && < 0.7 - default-language: Haskell2010 + , attoparsec >=0.13 && <0.16 + , base >=4.7 && <5 + , box ^>=0.8 + , text ^>=1.2 + , time ^>=1.9 + + exposed-modules: Box.Csv + other-modules: + default-language: Haskell2010 diff --git a/src/Box/Csv.hs b/src/Box/Csv.hs --- a/src/Box/Csv.hs +++ b/src/Box/Csv.hs @@ -1,16 +1,13 @@ {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StrictData #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE NoImplicitPrelude #-} -- | A csv process based on attoparsec and the box library --- module Box.Csv ( CsvConfig (..), defaultCsvConfig, - file, Header (..), rowEmitter, rowCommitter, @@ -27,7 +24,6 @@ A.double, double', fields, - scis, ints, doubles, day', @@ -37,81 +33,70 @@ where import Box -import Control.Lens +import Control.Monad import qualified Data.Attoparsec.Text as A -import Data.Generics.Labels () -import Data.Scientific +import Data.Functor.Contravariant +import Data.Text (Text, unpack) import qualified Data.Text as Text -import NumHask.Prelude import Data.Time +import GHC.Generics -- $setup -- >>> :set -XOverloadedStrings +-- >>> import Box +-- >>> import Box.Csv +-- >>> import qualified Data.Text as Text +-- >>> import qualified Data.Attoparsec.Text as A -- | csv file configuration -data CsvConfig - = CsvConfig - { -- | file name stem - name :: Text, - -- | file suffix - suffix :: Text, - -- | directory - dir :: Text, - -- | field separator - fsep :: Char, - -- | nature of header row(s) - header :: Header - } +data CsvConfig = CsvConfig + { -- | file name + file :: FilePath, + -- | field separator + fsep :: Char, + -- | nature of header row(s) + header :: Header + } deriving (Show, Generic, Eq) -- | default csv file details -- -- >>> defaultCsvConfig --- CsvConfig {name = "time_series_covid19_deaths_global_narrow", suffix = ".csv", dir = "./other", fsep = ',', header = HasHXL} +-- CsvConfig {file = "./other/time_series_covid19_deaths_global_narrow.csv", fsep = ',', header = HasHXL} -- -- test data from https://data.humdata.org/dataset/novel-coronavirus-2019-ncov-cases defaultCsvConfig :: CsvConfig defaultCsvConfig = CsvConfig - "time_series_covid19_deaths_global_narrow" - ".csv" - "./other" + "./other/time_series_covid19_deaths_global_narrow.csv" ',' HasHXL --- | filepath for the config. --- --- >>> file defaultCsvConfig --- "./other/time_series_covid19_deaths_global_narrow.csv" -file :: CsvConfig -> FilePath -file cfg = - cfg ^. #dir - <> "/" - <> cfg ^. #name - <> cfg ^. #suffix - & unpack - -- | Type of header rows. Note the modern propensity for multiple header rows. data Header = HasHeader | HasHXL | NoHeader deriving (Show, Eq) +-- | attoparsec parse emitter which returns the original text on failure +parseE :: (Functor m) => A.Parser a -> Emitter m Text -> Emitter m (Either Text a) +parseE parser e = (\t -> either (const $ Left t) Right (A.parseOnly parser t)) <$> e + -- | A continuation emitter of parsed csv rows from a CsvConfig, returning the original text on failure --- >>> rowEmitter defaultCsvConfig fields `with` emit +-- >>> emit <$|> rowEmitter defaultCsvConfig fields -- Just (Right ["Province/State","Country/Region","Lat","Long","Date","Value","ISO 3166-1 Alpha 3-Codes","Region Code","Sub-region Code","Intermediate Region Code\r"]) -rowEmitter :: CsvConfig -> (Char -> A.Parser a) -> Cont IO (Emitter IO (Either Text a)) -rowEmitter cfg p = parseE (p (view #fsep cfg)) <$> fileE (file cfg) +rowEmitter :: CsvConfig -> (Char -> A.Parser a) -> CoEmitter IO (Either Text a) +rowEmitter cfg p = parseE (p (fsep cfg)) <$> fileE (file cfg) -- | commits printed csv rows -- --- >>> let testConfig = CsvConfig "test" ".csv" "./test" ',' NoHeader --- >>> let ctest = rowCommitter testConfig (fmap (Text.intercalate "," . fmap show)) --- >>> ctest `with` (\c -> commit c [[1..10::Int]]) +-- >>> let testConfig = CsvConfig "./test/test.csv" ',' NoHeader +-- >>> let ctest = rowCommitter testConfig (fmap (Text.intercalate "," . fmap (Text.pack . show))) +-- +-- >>> (\c -> commit c [[1..10::Int]]) <$|> ctest -- True -- --- >>> rowEmitter testConfig ints `with` emit +-- >>> emit <$|> rowEmitter testConfig ints -- Just (Right [1,2,3,4,5,6,7,8,9,10]) --- -rowCommitter :: CsvConfig -> (a -> [Text]) -> Cont IO (Committer IO a) -rowCommitter cfg f = contramap (Text.intercalate (Text.singleton $ view #fsep cfg) . f) <$> fileWriteC (file cfg) +rowCommitter :: CsvConfig -> (a -> [Text]) -> CoCommitter IO a +rowCommitter cfg f = contramap (Text.intercalate (Text.singleton $ fsep cfg) . f) <$> fileWriteC (file cfg) -- | Run a parser across all lines of a file. -- @@ -125,7 +110,7 @@ -- >>> take 2 $ drop 2 [x | (Right x) <- r1] -- [["","Afghanistan","33.0","65.0","2020-06-29","733","AFG","142","34","\r"],["","Afghanistan","33.0","65.0","2020-06-28","721","AFG","142","34","\r"]] runCsv :: CsvConfig -> (Char -> A.Parser a) -> IO [Either Text a] -runCsv cfg p = with (rowEmitter cfg p) toListE +runCsv cfg p = toListM <$|> rowEmitter cfg p -- * low-level generic csv parser helpers @@ -223,22 +208,14 @@ pure d' -- * Block list parsers + -- | Parser for a csv row of [Text]. --- TODO: deal with potential for an extra '\r' -- -- >>> A.parseOnly (fields ',') "field1,field2\r" -- Right ["field1","field2\r"] --- fields :: Char -> A.Parser [Text] fields c = field_ c `A.sepBy1` sep c - --- | parser for a csv row of [Scientific] --- --- >>> A.parseOnly (scis ',') "1,2.2,3.3" --- Right [1.0,2.2,3.3] -scis :: Char -> A.Parser [Scientific] -scis c = A.scientific `A.sepBy1` sep c -- | parser for a csv row of [Double] -- diff --git a/test/test.hs b/test/test.hs deleted file mode 100644 --- a/test/test.hs +++ /dev/null @@ -1,19 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# OPTIONS_GHC -Wall #-} - -module Main where - -import NumHask.Prelude -import Test.DocTest - -main :: IO () -main = - doctest - [ "src/Box/Csv.hs" - ]