diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +## Cassava Megaparsec 2.0.3 + +* Exposing Internals + ## Cassava Megaparsec 2.0.2 * Add suppport for `megaparsec-9.0.0` diff --git a/Data/Csv/Parser/Megaparsec.hs b/Data/Csv/Parser/Megaparsec.hs --- a/Data/Csv/Parser/Megaparsec.hs +++ b/Data/Csv/Parser/Megaparsec.hs @@ -1,6 +1,6 @@ -- | -- Module : Data.Csv.Parser.Megaparsec --- Copyright : © 2016–2018 Stack Builders +-- Copyright : © 2016–2021 Stack Builders -- License : MIT -- -- Maintainer : Mark Karpov @@ -19,58 +19,27 @@ -- The parser provides better error messages than the parser that comes with -- Cassava library, while being compatible with the rest of the library. -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} - module Data.Csv.Parser.Megaparsec ( ConversionError (..) , decode , decodeWith , decodeByName - , decodeByNameWith ) + , decodeByNameWith) where -import Control.Monad -import Data.ByteString (ByteString) import Data.Csv hiding - ( Parser - , record - , namedRecord - , header - , toNamedRecord - , decode + ( decode , decodeWith , decodeByName , decodeByNameWith ) -import Data.Data import Data.Vector (Vector) -import Data.Word (Word8) import Text.Megaparsec -import Text.Megaparsec.Byte -import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL -import qualified Data.Csv as C -import qualified Data.HashMap.Strict as H -import qualified Data.Vector as V - ----------------------------------------------------------------------------- --- Custom error component and other types - --- | Custom error component for CSV parsing. It allows typed reporting of --- conversion errors. - -newtype ConversionError = ConversionError String - deriving (Eq, Data, Typeable, Ord, Read, Show) - -instance ShowErrorComponent ConversionError where - showErrorComponent (ConversionError msg) = - "conversion error: " ++ msg - --- | Parser type that uses “custom error component” 'ConversionError'. - -type Parser = Parsec ConversionError BL.ByteString +import Data.Csv.Parser.Megaparsec.Internals + ( ConversionError (..) + , csv + , csvWithHeader + , decodeWithC) ---------------------------------------------------------------------------- -- Top level interface @@ -135,116 +104,3 @@ -> Either (ParseErrorBundle BL.ByteString ConversionError) (Header, Vector a) decodeByNameWith opts = parse (csvWithHeader opts) {-# INLINE decodeByNameWith #-} - --- | Decode CSV data using the provided parser, skipping a leading header if --- necessary. - -decodeWithC - :: (DecodeOptions -> Parser a) - -- ^ Parsing function parametrized by 'DecodeOptions' - -> DecodeOptions - -- ^ Decoding options - -> HasHeader - -- ^ Whether to expect a header in the input - -> FilePath - -- ^ File name (only for displaying in parse error messages, use empty - -- string if you have none) - -> BL.ByteString - -- ^ CSV data - -> Either (ParseErrorBundle BL.ByteString ConversionError) a -decodeWithC p opts@DecodeOptions {..} hasHeader = parse parser - where - parser = case hasHeader of - HasHeader -> header decDelimiter *> p opts - NoHeader -> p opts -{-# INLINE decodeWithC #-} - ----------------------------------------------------------------------------- --- The parser - --- | Parse a CSV file that does not include a header. - -csv :: FromRecord a - => DecodeOptions -- ^ Decoding options - -> Parser (Vector a) -- ^ The parser that parses collection of records -csv DecodeOptions {..} = do - xs <- sepEndBy1 (record decDelimiter parseRecord) eol - eof - return $! V.fromList xs - --- | Parse a CSV file that includes a header. - -csvWithHeader :: FromNamedRecord a - => DecodeOptions -- ^ Decoding options - -> Parser (Header, Vector a) - -- ^ The parser that parser collection of named records -csvWithHeader DecodeOptions {..} = do - !hdr <- header decDelimiter - let f = parseNamedRecord . toNamedRecord hdr - xs <- sepEndBy1 (record decDelimiter f) eol - eof - return $ let !v = V.fromList xs in (hdr, v) - --- | Convert a 'Record' to a 'NamedRecord' by attaching column names. The --- 'Header' and 'Record' must be of the same length. - -toNamedRecord :: Header -> Record -> NamedRecord -toNamedRecord hdr v = H.fromList . V.toList $ V.zip hdr v -{-# INLINE toNamedRecord #-} - --- | Parse a header, including the terminating line separator. - -header :: Word8 -> Parser Header -header del = V.fromList <$!> p <* eol - where - p = sepBy1 (name del) (void $ char del) "file header" -{-# INLINE header #-} - --- | Parse a header name. Header names have the same format as regular --- 'field's. - -name :: Word8 -> Parser Name -name del = field del "name in header" -{-# INLINE name #-} - --- | 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. - -record - :: Word8 -- ^ Field delimiter - -> (Record -> C.Parser a) - -- ^ How to “parse” record to get the data of interest - -> Parser a -record del f = do - notFollowedBy eof -- to prevent reading empty line at the end of file - r <- V.fromList <$!> (sepBy1 (field del) (void $ char del) "record") - case C.runParser (f r) of - Left msg -> customFailure (ConversionError msg) - Right x -> return x -{-# INLINE record #-} - --- | Parse a field. The field may be in either the escaped or non-escaped --- format. The returned value is unescaped. - -field :: Word8 -> Parser Field -field del = label "field" (escapedField <|> unescapedField del) -{-# INLINE field #-} - --- | Parse an escaped field. - -escapedField :: Parser ByteString -escapedField = - B.pack <$!> between (char 34) (char 34) (many $ normalChar <|> escapedDq) - where - normalChar = anySingleBut 34 "unescaped character" - escapedDq = label "escaped double-quote" (34 <$ string "\"\"") -{-# INLINE escapedField #-} - --- | Parse an unescaped field. - -unescapedField :: Word8 -> Parser ByteString -unescapedField del = BL.toStrict <$> takeWhileP (Just "unescaped character") f - where - f x = x /= del && x /= 34 && x /= 10 && x /= 13 -{-# INLINE unescapedField #-} diff --git a/Data/Csv/Parser/Megaparsec/Internals.hs b/Data/Csv/Parser/Megaparsec/Internals.hs new file mode 100644 --- /dev/null +++ b/Data/Csv/Parser/Megaparsec/Internals.hs @@ -0,0 +1,173 @@ +-- | +-- Module : Data.Csv.Parser.Megaparsec.Internals +-- Copyright : © 2016–2021 Stack Builders +-- License : MIT +-- + +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Data.Csv.Parser.Megaparsec.Internals + ( ConversionError (..) + , Parser + , csv + , csvWithHeader + , decodeWithC + , toNamedRecord + , header + , name + , record + , field + , escapedField + , unescapedField) +where + +import Control.Monad +import Data.ByteString (ByteString) +import Data.Csv hiding + ( Parser + , record + , header + , toNamedRecord ) +import Data.Data +import Data.Vector (Vector) +import Data.Word (Word8) +import Text.Megaparsec +import Text.Megaparsec.Byte +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL +import qualified Data.Csv as C +import qualified Data.HashMap.Strict as H +import qualified Data.Vector as V + +---------------------------------------------------------------------------- +-- Custom error component and other types + +-- | Custom error component for CSV parsing. It allows typed reporting of +-- conversion errors. + +newtype ConversionError = ConversionError String + deriving (Eq, Data, Typeable, Ord, Read, Show) + +instance ShowErrorComponent ConversionError where + showErrorComponent (ConversionError msg) = + "conversion error: " ++ msg + +-- | Parser type that uses “custom error component” 'ConversionError'. + +type Parser = Parsec ConversionError BL.ByteString + +---------------------------------------------------------------------------- +-- The parser + +-- | Parse a CSV file that does not include a header. + +csv :: FromRecord a + => DecodeOptions -- ^ Decoding options + -> Parser (Vector a) -- ^ The parser that parses collection of records +csv DecodeOptions {..} = do + xs <- sepEndBy1 (record decDelimiter parseRecord) eol + eof + return $! V.fromList xs + +-- | Parse a CSV file that includes a header. + +csvWithHeader :: FromNamedRecord a + => DecodeOptions -- ^ Decoding options + -> Parser (Header, Vector a) + -- ^ The parser that parser collection of named records +csvWithHeader DecodeOptions {..} = do + !hdr <- header decDelimiter + let f = parseNamedRecord . toNamedRecord hdr + xs <- sepEndBy1 (record decDelimiter f) eol + eof + return $ let !v = V.fromList xs in (hdr, v) + +-- | Decode CSV data using the provided parser, skipping a leading header if +-- necessary. + +decodeWithC + :: (DecodeOptions -> Parser a) + -- ^ Parsing function parametrized by 'DecodeOptions' + -> DecodeOptions + -- ^ Decoding options + -> HasHeader + -- ^ Whether to expect a header in the input + -> FilePath + -- ^ File name (only for displaying in parse error messages, use empty + -- string if you have none) + -> BL.ByteString + -- ^ CSV data + -> Either (ParseErrorBundle BL.ByteString ConversionError) a +decodeWithC p opts@DecodeOptions {..} hasHeader = parse parser + where + parser = case hasHeader of + HasHeader -> header decDelimiter *> p opts + NoHeader -> p opts +{-# INLINE decodeWithC #-} + +-- | Convert a 'Record' to a 'NamedRecord' by attaching column names. The +-- 'Header' and 'Record' must be of the same length. + +toNamedRecord :: Header -> Record -> NamedRecord +toNamedRecord hdr v = H.fromList . V.toList $ V.zip hdr v +{-# INLINE toNamedRecord #-} + +-- | Parse a header, including the terminating line separator. + +header :: Word8 -> Parser Header +header del = V.fromList <$!> p <* eol + where + p = sepBy1 (name del) (void $ char del) "file header" +{-# INLINE header #-} + +-- | Parse a header name. Header names have the same format as regular +-- 'field's. + +name :: Word8 -> Parser Name +name del = field del "name in header" +{-# INLINE name #-} + +-- | 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. + +record + :: Word8 -- ^ Field delimiter + -> (Record -> C.Parser a) + -- ^ How to “parse” record to get the data of interest + -> Parser a +record del f = do + notFollowedBy eof -- to prevent reading empty line at the end of file + r <- V.fromList <$!> (sepBy1 (field del) (void $ char del) "record") + case C.runParser (f r) of + Left msg -> customFailure (ConversionError msg) + Right x -> return x +{-# INLINE record #-} + +-- | Parse a field. The field may be in either the escaped or non-escaped +-- format. The returned value is unescaped. + +field :: Word8 -> Parser Field +field del = label "field" (escapedField <|> unescapedField del) +{-# INLINE field #-} + +-- | Parse an escaped field. + +escapedField :: Parser ByteString +escapedField = + B.pack <$!> between (char 34) (char 34) (many $ normalChar <|> escapedDq) + where + normalChar = anySingleBut 34 "unescaped character" + escapedDq = label "escaped double-quote" (34 <$ string "\"\"") +{-# INLINE escapedField #-} + +-- | Parse an unescaped field. + +unescapedField :: Word8 -> Parser ByteString +unescapedField del = BL.toStrict <$> takeWhileP (Just "unescaped character") f + where + f x = x /= del && x /= 34 && x /= 10 && x /= 13 +{-# INLINE unescapedField #-} diff --git a/LICENSE.md b/LICENSE.md --- a/LICENSE.md +++ b/LICENSE.md @@ -1,6 +1,6 @@ # MIT License -Copyright © 2016–2018 Stack Builders +Copyright © 2016–2021 Stack Builders Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -60,6 +60,6 @@ ## License -Copyright © 2016–2018 Stack Builders +Copyright © 2016–2021 Stack Builders Distributed under MIT license. diff --git a/cassava-megaparsec.cabal b/cassava-megaparsec.cabal --- a/cassava-megaparsec.cabal +++ b/cassava-megaparsec.cabal @@ -1,5 +1,5 @@ name: cassava-megaparsec -version: 2.0.2 +version: 2.0.3 cabal-version: 1.18 tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3, GHC==8.6.1 license: MIT @@ -26,12 +26,13 @@ library build-depends: base >= 4.8 && < 5.0 - , bytestring >= 0.9 && < 0.11 + , bytestring >= 0.9 && < 0.12 , cassava >= 0.4.2 && < 0.6 , megaparsec >= 7.0 && < 10.0 , unordered-containers >= 0.2.7 && < 0.3 , vector >= 0.11 && < 0.13 exposed-modules: Data.Csv.Parser.Megaparsec + , Data.Csv.Parser.Megaparsec.Internals if flag(dev) ghc-options: -Wall -Werror else @@ -49,7 +50,7 @@ hs-source-dirs: tests type: exitcode-stdio-1.0 build-depends: base >= 4.8 && < 5.0 - , bytestring >= 0.9 && < 0.11 + , bytestring >= 0.9 && < 0.12 , cassava >= 0.4.2 && < 0.6 , cassava-megaparsec , hspec >= 2.0 && < 3.0