cassava-megaparsec (empty) → 0.1.0
raw patch · 7 files changed
+620/−0 lines, 7 filesdep +basedep +bytestringdep +cassavasetup-changed
Dependencies added: base, bytestring, cassava, cassava-megaparsec, containers, hspec, hspec-megaparsec, megaparsec, unordered-containers, vector
Files
- CHANGELOG.md +3/−0
- Data/Csv/Parser/Megaparsec.hs +286/−0
- LICENSE.md +21/−0
- README.md +65/−0
- Setup.hs +6/−0
- cassava-megaparsec.cabal +80/−0
- tests/Spec.hs +159/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+## Cassava Megaparsec 0.1.0++* Initial release.
+ Data/Csv/Parser/Megaparsec.hs view
@@ -0,0 +1,286 @@+-- |+-- Module : Data.Csv.Parser.Megaparsec+-- Copyright : © 2016 Stack Builders+-- License : MIT+--+-- Maintainer : Mark Karpov <markkarpov@openmailbox.org>+-- Stability : experimental+-- Portability : portable+--+-- A CSV parser. The parser here is RFC 4180 compliant, with the following+-- extensions:+--+-- * Non-escaped fields may contain any characters except double-quotes,+-- commas (or generally delimiter characters), carriage returns, and+-- newlines.+-- * Escaped fields may contain any characters, but double-quotes need+-- to be escaped.+--+-- 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 CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE RecordWildCards #-}++module Data.Csv.Parser.Megaparsec+ ( Cec (..)+ , decode+ , decodeWith+ , decodeByName+ , decodeByNameWith )+where++import Control.Monad+import Data.ByteString (ByteString)+import Data.Char (chr)+import Data.Csv hiding+ ( Parser+ , record+ , namedRecord+ , header+ , toNamedRecord+ , decode+ , decodeWith+ , decodeByName+ , decodeByNameWith )+import Data.Data+import Data.Vector (Vector)+import Data.Word (Word8)+import Text.Megaparsec+import qualified Data.ByteString.Char8 as BC8+import qualified Data.ByteString.Lazy as BL+import qualified Data.Csv as C+import qualified Data.HashMap.Strict as H+import qualified Data.Set as S+import qualified Data.Vector as V++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((*>), (<*), (<$))++infixl 4 <$!>++(<$!>) :: Monad m => (a -> b) -> m a -> m b+f <$!> m = do+ x <- m+ let z = f x+ z `seq` return z+{-# INLINE (<$!>) #-}+#endif++----------------------------------------------------------------------------+-- Custom error component and other types++-- | Custom error component for CSV parsing. It allows typed reporting of+-- conversion errors.++data Cec+ = CecFail String+ | CecIndentation Ordering Pos Pos+ | CecConversionError String+ deriving (Eq, Data, Typeable, Ord, Read, Show)++instance ShowErrorComponent Cec where+ showErrorComponent (CecFail msg) = msg+ showErrorComponent (CecIndentation ord ref actual) =+ "incorrect indentation (got " ++ show (unPos actual) +++ ", should be " ++ p ++ show (unPos ref) ++ ")"+ where p = case ord of+ LT -> "less than "+ EQ -> "equal to "+ GT -> "greater than "+ showErrorComponent (CecConversionError msg) =+ "conversion error: " ++ msg++instance ErrorComponent Cec where+ representFail = CecFail+ representIndentation = CecIndentation++-- | Parser type that uses “custom error component” 'Cec'.++type Parser = Parsec Cec BL.ByteString++----------------------------------------------------------------------------+-- Top level interface++-- | Deserialize CSV records form a lazy 'BL.ByteString'. If this fails due+-- to incomplete or invalid input, 'Left' is returned. Equivalent to+-- 'decodeWith' 'defaultDecodeOptions'.++decode :: FromRecord a+ => HasHeader+ -- ^ Whether the data contains header that should be skipped+ -> FilePath+ -- ^ File name (use empty string if you have none)+ -> BL.ByteString+ -- ^ CSV data+ -> Either (ParseError Char Cec) (Vector a)+decode = decodeWith defaultDecodeOptions+{-# INLINE decode #-}++-- | Like 'decode', but lets you customize how the CSV data is parsed.++decodeWith :: FromRecord a+ => DecodeOptions+ -- ^ Decoding options+ -> HasHeader+ -- ^ Whether the data contains header that should be skipped+ -> FilePath+ -- ^ File name (use empty string if you have none)+ -> BL.ByteString+ -- ^ CSV data+ -> Either (ParseError Char Cec) (Vector a)+decodeWith = decodeWithC csv+{-# INLINE decodeWith #-}++-- | Deserialize CSV records from a lazy 'BL.ByteString'. If this fails due+-- to incomplete or invalid input, 'Left' is returned. The data is assumed+-- to be preceded by a header. Equivalent to 'decodeByNameWith'+-- 'defaultDecodeOptions'.++decodeByName :: FromNamedRecord a+ => FilePath -- ^ File name (use empty string if you have none)+ -> BL.ByteString -- ^ CSV data+ -> Either (ParseError Char Cec) (Header, Vector a)+decodeByName = decodeByNameWith defaultDecodeOptions+{-# INLINE decodeByName #-}++-- | Like 'decodeByName', but lets you customize how the CSV data is parsed.++decodeByNameWith :: FromNamedRecord a+ => DecodeOptions -- ^ Decoding options+ -> FilePath -- ^ File name (use empty string if you have none)+ -> BL.ByteString -- ^ CSV data+ -> Either (ParseError Char Cec) (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 (use empty string if you have none)+ -> BL.ByteString+ -- ^ CSV data+ -> Either (ParseError Char Cec) 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)++-- | Parse a header, including the terminating line separator.++header :: Word8 -> Parser Header+header del = V.fromList <$!> p <* eol+ where+ p = sepBy1 (name del) (blindByte 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) (blindByte del) <?> "a record")+ case C.runParser (f r) of+ Left msg -> 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 "a field" (escapedField <|> unescapedField del)+{-# INLINE field #-}++-- | Parse an escaped field.++escapedField :: Parser ByteString+escapedField =+ BC8.pack <$!> between (char '"') (char '"') (many $ normalChar <|> escapedDq)+ where+ normalChar = noneOf "\"" <?> "unescaped character"+ escapedDq = label "escaped double-quote" ('"' <$ string "\"\"")+{-# INLINE escapedField #-}++-- | Parse an unescaped field (up to first)++unescapedField :: Word8 -> Parser ByteString+unescapedField del = BC8.pack <$!> many (noneOf es) -- anyChar (lookAhead $ oneOf es)+ where+ es = chr (fromIntegral del) : "\"\n\r"+{-# INLINE unescapedField #-}++----------------------------------------------------------------------------+-- Helpers++-- | End parsing signaling a “conversion error”.++conversionError :: String -> Parser a+conversionError msg = failure S.empty S.empty (S.singleton err)+ where+ err = CecConversionError msg+{-# INLINE conversionError #-}++-- | 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 byte of specified value and return unit.++blindByte :: Word8 -> Parser ()+blindByte = void . char . chr . fromIntegral+{-# INLINE blindByte #-}
+ LICENSE.md view
@@ -0,0 +1,21 @@+# MIT License++Copyright (c) 2016 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+deal in the Software without restriction, including without limitation the+rights to use, copy, modify, merge, publish, distribute, sublicense, and/or+sell copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS+IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,65 @@+# Cassava Megaparsec++[](http://opensource.org/licenses/MIT)+[](https://hackage.haskell.org/package/cassava-megaparsec)+[](http://stackage.org/nightly/package/cassava-megaparsec)+[](http://stackage.org/lts/package/cassava-megaparsec)+[](https://travis-ci.org/stackbuilders/cassava-megaparsec)++The package provides alternative parser for the+[Cassava](https://hackage.haskell.org/package/cassava) package written with+[Megaparsec](https://hackage.haskell.org/package/megaparsec) so you can get+better error messages at expense of some speed.++## Quick start++The package works seamlessly with Cassava by replacing the following+functions:++* `decode`+* `decodeWith`+* `decodeByName`+* `decodeByNameWith`++The functions work just the same as Cassava's equivalents, but also take+name of file they parse (to include into error messages) and return typed+high-quality error messages produced by+[Megaparsec](https://hackage.haskell.org/package/megaparsec).++The import section typically looks like this:++```haskell+import Data.Csv hiding (decode, decodeWith, decodeByName, decodeByNameWith)+import Data.Csv.Parser.Megaparsec (decode, decodeWith, decodeByName, decodeByNameWith)+```++Next you call appropriate function and get either result of parsing+identical to that of Cassava or error message. The error message is+well-typed so you can examine it in Haskell code easily. Conversion error+are considered parsing errors by the `cassava-megaparsec` package and are+reported via custom error message component `Cec` supported by Megaparsec 5.+Since Cassava's conversion errors are plain strings, we have no choice but+to represent them as strings too:++```haskell+-- | Custom error component for CSV parsing. It allows typed reporting of+-- conversion errors.++data Cec+ = CecFail String+ | CecIndentation Ordering Pos Pos+ | CecConversionError String+ deriving (Eq, Data, Typeable, Ord, Read, Show)+```++To pretty print a error message use the `parseErrorPretty` function from+`Text.Megaparsec`.++This should be enough to start using the package, please consult Haddocks+for detailed per-function documentation.++## License++Copyright © 2016 Stack Builders++Distributed under MIT license.
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ cassava-megaparsec.cabal view
@@ -0,0 +1,80 @@+--+-- Cabal configuration for ‘cassava-megaparsec’ package.+--+-- Copyright © 2016 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 deal in the Software without restriction, including+-- without limitation the rights to use, copy, modify, merge, publish,+-- distribute, sublicense, and/or sell copies of the Software, and to permit+-- persons to whom the Software is furnished to do so, subject to the+-- following conditions:+--+-- The above copyright notice and this permission notice shall be included+-- in all copies or substantial portions of the Software.+--+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN+-- NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE+-- USE OR OTHER DEALINGS IN THE SOFTWARE.++name: cassava-megaparsec+version: 0.1.0+cabal-version: >= 1.10+license: MIT+license-file: LICENSE.md+author: Mark Karpov <markkarpov@openmailbox.org>+maintainer: Mark Karpov <markkarpov@openmailbox.org>+homepage: https://github.com/mrkkrp/cassava-megaparsec+bug-reports: https://github.com/mrkkrp/cassava-megaparsec/issues+category: Text, Web, CSV, Parsing+synopsis: Megaparsec parser of CSV files that plays nicely with Cassava+build-type: Simple+description: Megaparsec parser of CSV files that plays nicely with Cassava.+extra-source-files: CHANGELOG.md+ , README.md++source-repository head+ type: git+ location: https://github.com/stack-builders/cassava-megaparsec.git++flag dev+ description: Turn on development settings.+ manual: True+ default: False++library+ build-depends: base >= 4.7 && < 5.0+ , bytestring >= 0.9 && < 0.11+ , cassava >= 0.4.2 && < 0.5+ , containers >= 0.5 && < 0.6+ , megaparsec >= 5.0 && < 6.0+ , unordered-containers >= 0.2.7 && < 0.3+ , vector >= 0.11 && < 0.12+ exposed-modules: Data.Csv.Parser.Megaparsec+ if flag(dev)+ ghc-options: -Wall -Werror+ else+ ghc-options: -O2 -Wall+ default-language: Haskell2010++test-suite tests+ main-is: Spec.hs+ hs-source-dirs: tests+ type: exitcode-stdio-1.0+ build-depends: base >= 4.7 && < 5.0+ , bytestring >= 0.9 && < 0.11+ , cassava >= 0.4.2 && < 0.5+ , cassava-megaparsec >= 0.1+ , hspec >= 2.0 && < 3.0+ , hspec-megaparsec >= 0.2 && < 0.3+ , vector >= 0.11 && < 0.12+ if flag(dev)+ ghc-options: -Wall -Werror+ else+ ghc-options: -O2 -Wall+ default-language: Haskell2010
+ tests/Spec.hs view
@@ -0,0 +1,159 @@+--+-- Tests for the ‘cassava-megaparsec’ package.+--+-- Copyright © 2016 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 deal in the Software without restriction, including+-- without limitation the rights to use, copy, modify, merge, publish,+-- distribute, sublicense, and/or sell copies of the Software, and to permit+-- persons to whom the Software is furnished to do so, subject to the+-- following conditions:+--+-- The above copyright notice and this permission notice shall be included+-- in all copies or substantial portions of the Software.+--+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN+-- NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE+-- USE OR OTHER DEALINGS IN THE SOFTWARE.++{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import Data.ByteString (ByteString)+import Data.Csv hiding (decode, decodeWith, decodeByName, decodeByNameWith)+import Data.Csv.Parser.Megaparsec+import Data.Vector (Vector)+import Test.Hspec+import Test.Hspec.Megaparsec+import qualified Data.ByteString.Lazy as BL+import qualified Data.Vector as V++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>))+#endif++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "decode" decodeSpec+ describe "decodeWith" decodeWithSpec+ describe "decodeByName" decodeByNameSpec+ describe "decodeByNameWith" decodeByNameWithSpec++decodeSpec :: Spec+decodeSpec = do+ let dec = decode NoHeader ""+ it "decodes simple data" $+ dec "a,b,c\n" `shouldParse`+ φ [["a", "b", "c"]]+ it "decodes simple data skipping header" $+ decode HasHeader "" "field1,field2,field3\na,b,c\n" `shouldParse`+ φ [["a", "b", "c"]]+ it "handles CRLF sequence correctly" $+ dec "a,b\r\nc,d\r\n" `shouldParse`+ φ [["a", "b"], ["c", "d"]]+ it "handles missing end of line" $+ dec "a,b,c" `shouldParse`+ φ [["a", "b", "c"]]+ it "parses the empty line all right" $+ dec "a,b,c\n\nd,e,f\n\n" `shouldParse`+ φ [["a", "b", "c"], [""], ["d", "e", "f"], [""]]+ it "handles leading space" $+ dec " a, b, c\n" `shouldParse`+ φ [[" a", " b", " c"]]+ it "parses the RFC 4180 test data correctly" $+ dec rfc4180Input `shouldParse`+ φ rfc4180Output++decodeWithSpec :: Spec+decodeWithSpec =+ context "using tab as delimiter" $ do+ let dec = decodeWith defaultDecodeOptions { decDelimiter = 9 } NoHeader ""+ it "works fine with tab as delimiter" $+ dec "a\tb\tc\n" `shouldParse`+ φ [["a", "b", "c"]]+ it "handles CRLF sequence correctly" $+ dec "a\tb\r\nc\td\r\n" `shouldParse`+ φ [["a", "b"], ["c", "d"]]+ it "handles missing end of line" $+ dec "a\tb\tc" `shouldParse`+ φ [["a", "b", "c"]]+ it "parses the empty line all right" $+ dec "a\tb\tc\n\nd\te\tf\n\n" `shouldParse`+ φ [["a", "b", "c"], [""], ["d", "e", "f"], [""]]+ it "handles leading space" $+ dec " a\t b\t c\n" `shouldParse`+ φ [[" a", " b", " c"]]++decodeByNameSpec :: Spec+decodeByNameSpec = do+ let dec = decodeByName ""+ it "decodes simple data" $+ dec "field\r\nabc\r\n" `shouldParse`+ χ ["field"] [[("field", "abc")]]+ it "decodes entries with two fields" $+ dec "field1,field2\r\nabc,def\r\n" `shouldParse`+ χ ["field1", "field2"] [[("field1", "abc"), ("field2", "def")]]+ it "decodes header ending with CRLF" $+ dec "field\r\nabc" `shouldParse`+ χ ["field"] [[("field", "abc")]]+ it "decodes data with training CRLF" $+ dec "field\r\nabc\r\n" `shouldParse`+ χ ["field"] [[("field", "abc")]]+ it "decodes multiply entries (CRLF separated)" $+ dec "field\r\nabc\r\ndef" `shouldParse`+ χ ["field"] [[("field", "abc")],[("field","def")]]++decodeByNameWithSpec :: Spec+decodeByNameWithSpec =+ context "using tab as delimiter" $ do+ let dec = decodeByNameWith defaultDecodeOptions { decDelimiter = 9 } ""+ it "decodes simple data" $+ dec "field\r\nabc\r\n" `shouldParse`+ χ ["field"] [[("field", "abc")]]+ it "decodes entries with two fields" $+ dec "field1\tfield2\r\nabc\tdef\r\n" `shouldParse`+ χ ["field1", "field2"] [[("field1", "abc"), ("field2", "def")]]+ it "decodes header ending with CRLF" $+ dec "field\r\nabc" `shouldParse`+ χ ["field"] [[("field", "abc")]]+ it "decodes data with training CRLF" $+ dec "field\r\nabc\r\n" `shouldParse`+ χ ["field"] [[("field", "abc")]]+ it "decodes multiply entries (CRLF separated)" $+ dec "field\r\nabc\r\ndef" `shouldParse`+ χ ["field"] [[("field", "abc")],[("field","def")]]++----------------------------------------------------------------------------+-- Helpers++φ :: [[ByteString]] -> Vector [ByteString]+φ = V.fromList++χ :: [ByteString] -> [[(ByteString, ByteString)]] -> (Header, Vector NamedRecord)+χ h xs = (header h, V.fromList (namedRecord <$> xs))++rfc4180Input :: BL.ByteString+rfc4180Input = BL.concat+ [ "#field1,field2,field3\n"+ , "\"aaa\",\"bb\n"+ , "b\",\"ccc\"\n"+ , "\"a,a\",\"b\"\"bb\",\"ccc\"\n"+ , "zzz,yyy,xxx\n" ]++rfc4180Output :: [[ByteString]]+rfc4180Output =+ [ ["#field1", "field2", "field3"]+ , ["aaa", "bb\nb", "ccc"]+ , ["a,a", "b\"bb", "ccc"]+ , ["zzz", "yyy", "xxx"] ]