Functions taking a custom record parser

decodeWithP and decodeByNameWithP take a parser function instead of using the
one provided by the FromRecod / FromNamedRecord instances.

Author: tomferon

Data/Csv.hs

@@ -48,7 +48,9 @@ module Data.Csv
     , DecodeOptions(..)
     , defaultDecodeOptions
     , decodeWith
+    , decodeWithP
     , decodeByNameWith
+    , decodeByNameWithP
     , EncodeOptions(..)
     , Quoting(..)
     , defaultEncodeOptions

Data/Csv/Encoding.hs

@@ -24,7 +24,9 @@ module Data.Csv.Encoding
     , DecodeOptions(..)
     , defaultDecodeOptions
     , decodeWith
+    , decodeWithP
     , decodeByNameWith
+    , decodeByNameWithP
     , EncodeOptions(..)
     , defaultEncodeOptions
     , encodeWith
@@ -57,6 +59,7 @@ import Data.Csv.Conversion (FromNamedRecord, FromRecord, ToNamedRecord,
                             ToRecord, parseNamedRecord, parseRecord, runParser,
                             toNamedRecord, toRecord)
 import Data.Csv.Parser hiding (csv, csvWithHeader)
+import qualified Data.Csv.Conversion as Conversion
 import qualified Data.Csv.Parser as Parser
 import Data.Csv.Types hiding (toNamedRecord)
 import qualified Data.Csv.Types as Types
@@ -117,7 +120,7 @@ decodeWith :: FromRecord a
                              -- skipped
            -> L.ByteString   -- ^ CSV data
            -> Either String (Vector a)
-decodeWith = decodeWithC csv
+decodeWith = decodeWithC (csv parseRecord)
 {-# INLINE [1] decodeWith #-}
 
 {-# RULES
@@ -130,12 +133,23 @@ idDecodeWith :: DecodeOptions -> HasHeader -> L.ByteString
              -> Either String (Vector (Vector B.ByteString))
 idDecodeWith = decodeWithC Parser.csv
 
+-- | Like 'decodeWith'', but lets you specify a parser function.
+decodeWithP :: (Record -> Conversion.Parser a)
+            -- ^ Custom parser function
+            -> DecodeOptions -- ^ Decoding options
+            -> HasHeader     -- ^ Data contains header that should be
+                             -- skipped
+            -> L.ByteString  -- ^ CSV data
+            -> Either String (Vector a)
+decodeWithP _parseRecord = decodeWithC (csv _parseRecord)
+{-# INLINE [1] decodeWithP #-}
+
 -- | Decode CSV data using the provided parser, skipping a leading
 -- header if 'hasHeader' is 'HasHeader'. Returns 'Left' @errMsg@ on
 -- failure.
 decodeWithC :: (DecodeOptions -> AL.Parser a) -> DecodeOptions -> HasHeader
             -> BL8.ByteString -> Either String a
-decodeWithC p !opts hasHeader = decodeWithP parser
+decodeWithC p !opts hasHeader = decodeWithP' parser
   where parser = case hasHeader of
             HasHeader -> header (decDelimiter opts) *> p opts
             NoHeader  -> p opts
@@ -147,7 +161,16 @@ decodeByNameWith :: FromNamedRecord a
                  => DecodeOptions  -- ^ Decoding options
                  -> L.ByteString   -- ^ CSV data
                  -> Either String (Header, Vector a)
-decodeByNameWith !opts = decodeWithP (csvWithHeader opts)
+decodeByNameWith !opts = decodeWithP' (csvWithHeader parseNamedRecord opts)
+
+-- | Like 'decodeByNameWith', but lets you specify a parser function.
+decodeByNameWithP :: (NamedRecord -> Conversion.Parser a)
+                  -- ^ Custom parser function
+                  -> DecodeOptions -- ^ Decoding options
+                  -> L.ByteString  -- ^ CSV data
+                  -> Either String (Header, Vector a)
+decodeByNameWithP _parseNamedRecord !opts =
+  decodeWithP' (csvWithHeader _parseNamedRecord opts)
 
 -- | Should quoting be applied to fields, and at which level?
 data Quoting
@@ -328,8 +351,8 @@ prependToAll :: Builder -> [Builder] -> [Builder]
 prependToAll _   []     = []
 prependToAll sep (x:xs) = sep <> x : prependToAll sep xs
 
-decodeWithP :: AL.Parser a -> L.ByteString -> Either String a
-decodeWithP p s =
+decodeWithP' :: AL.Parser a -> L.ByteString -> Either String a
+decodeWithP' p s =
     case AL.parse p s of
       AL.Done _ v     -> Right v
       AL.Fail left _ msg -> Left errMsg
@@ -338,7 +361,7 @@ decodeWithP p s =
                    (if BL8.length left > 100
                     then (take 100 $ BL8.unpack left) ++ " (truncated)"
                     else show (BL8.unpack left))
-{-# INLINE decodeWithP #-}
+{-# INLINE decodeWithP' #-}
 
 -- These alternative implementation of the 'csv' and 'csvWithHeader'
 -- parsers from the 'Parser' module performs the
@@ -351,26 +374,27 @@ decodeWithP p s =
 -- "parse error: conversion error: ...".
 
 -- | Parse a CSV file that does not include a header.
-csv :: FromRecord a => DecodeOptions -> AL.Parser (V.Vector a)
-csv !opts = do
+csv :: (Record -> Conversion.Parser a) -> DecodeOptions
+    -> AL.Parser (V.Vector a)
+csv _parseRecord !opts = do
     vals <- records
     return $! V.fromList vals
   where
     records = do
         !r <- record (decDelimiter opts)
         if blankLine r
             then (endOfInput *> pure []) <|> (endOfLine *> records)
-            else case runParser (parseRecord r) of
+            else case runParser (_parseRecord r) of
                 Left msg  -> fail $ "conversion error: " ++ msg
                 Right val -> do
                     !vals <- (endOfInput *> AP.pure []) <|> (endOfLine *> records)
                     return (val : vals)
 {-# INLINE csv #-}
 
 -- | Parse a CSV file that includes a header.
-csvWithHeader :: FromNamedRecord a => DecodeOptions
+csvWithHeader :: (NamedRecord -> Conversion.Parser a) -> DecodeOptions
               -> AL.Parser (Header, V.Vector a)
-csvWithHeader !opts = do
+csvWithHeader _parseNamedRecord !opts = do
     !hdr <- header (decDelimiter opts)
     vals <- records hdr
     let !v = V.fromList vals
@@ -386,4 +410,4 @@ csvWithHeader !opts = do
                     !vals <- (endOfInput *> pure []) <|> (endOfLine *> records hdr)
                     return (val : vals)
 
-    convert hdr = parseNamedRecord . Types.toNamedRecord hdr
+    convert hdr = _parseNamedRecord . Types.toNamedRecord hdr

Data/Csv/Incremental.hs

@@ -11,6 +11,7 @@
 -- > main = withFile "salaries.csv" ReadMode $ \ csvFile -> do
 -- >     let loop !_ (Fail _ errMsg) = putStrLn errMsg >> exitFailure
 -- >         loop acc (Many rs k)    = loop (acc + sumSalaries rs) =<< feed k
+
 -- >         loop acc (Done rs)      = putStrLn $ "Total salaries: " ++
 -- >                                   show (sumSalaries rs + acc)
 -- >
@@ -55,11 +56,13 @@ module Data.Csv.Incremental
     , HasHeader(..)
     , decode
     , decodeWith
+    , decodeWithP
 
     -- ** Name-based record conversion
     -- $namebased
     , decodeByName
     , decodeByNameWith
+    , decodeByNameWithP
 
     -- * Encoding
     -- ** Index-based record conversion
@@ -247,12 +250,21 @@ decodeWith :: FromRecord a
            -> HasHeader      -- ^ Data contains header that should be
                              -- skipped
            -> Parser a
-decodeWith !opts hasHeader = case hasHeader of
+decodeWith !opts hasHeader = decodeWithP parseRecord opts hasHeader
+
+-- | Like 'decodeWith', but lets you pass an explicit parser value instead of
+-- using a typeclass
+decodeWithP :: (Record -> Conversion.Parser a)
+            -> DecodeOptions  -- ^ Decoding options
+            -> HasHeader      -- ^ Data contains header that should be
+                             -- skipped
+            -> Parser a
+decodeWithP p !opts hasHeader = case hasHeader of
     HasHeader -> go (decodeHeaderWith opts)
-    NoHeader  -> Many [] $ \ s -> decodeWithP parseRecord opts s
+    NoHeader  -> Many [] $ \ s -> decodeWithP' p opts s
   where go (FailH rest msg) = Fail rest msg
         go (PartialH k)     = Many [] $ \ s' -> go (k s')
-        go (DoneH _ rest)   = decodeWithP parseRecord opts rest
+        go (DoneH _ rest)   = decodeWithP' p opts rest
 
 ------------------------------------------------------------------------
 
@@ -269,22 +281,29 @@ decodeByName = decodeByNameWith defaultDecodeOptions
 decodeByNameWith :: FromNamedRecord a
                  => DecodeOptions  -- ^ Decoding options
                  -> HeaderParser (Parser a)
-decodeByNameWith !opts = go (decodeHeaderWith opts)
+decodeByNameWith !opts = decodeByNameWithP parseNamedRecord opts
+
+-- | Like 'decodeByNameWith', but lets you pass an explicit parser value instead
+-- of using a typeclass
+decodeByNameWithP :: (NamedRecord -> Conversion.Parser a)
+                  -> DecodeOptions  -- ^ Decoding options
+                  -> HeaderParser (Parser a)
+decodeByNameWithP p !opts = go (decodeHeaderWith opts)
   where
     go (FailH rest msg) = FailH rest msg
     go (PartialH k)     = PartialH $ \ s -> go (k s)
     go (DoneH hdr rest) =
-        DoneH hdr (decodeWithP (parseNamedRecord . toNamedRecord hdr) opts rest)
+        DoneH hdr (decodeWithP' (p . toNamedRecord hdr) opts rest)
 
 ------------------------------------------------------------------------
 
 -- TODO: 'decodeWithP' should probably not take an initial
 -- 'B.ByteString' input.
 
 -- | Like 'decode', but lets you customize how the CSV data is parsed.
-decodeWithP :: (Record -> Conversion.Parser a) -> DecodeOptions -> B.ByteString
+decodeWithP' :: (Record -> Conversion.Parser a) -> DecodeOptions -> B.ByteString
             -> Parser a
-decodeWithP p !opts = go Incomplete [] . parser
+decodeWithP' p !opts = go Incomplete [] . parser
   where
     go !_ !acc (A.Fail rest _ msg)
         | null acc  = Fail rest err
@@ -294,7 +313,7 @@ decodeWithP p !opts = go Incomplete [] . parser
       where cont s = go m [] (k s)
               where m | B.null s  = Complete
                       | otherwise = Incomplete
-    go Complete _ (A.Partial _) = moduleError "decodeWithP" msg
+    go Complete _ (A.Partial _) = moduleError "decodeWithP'" msg
         where msg = "attoparsec should never return Partial in this case"
     go m acc (A.Done rest r)
         | B.null rest = case m of
@@ -309,7 +328,7 @@ decodeWithP p !opts = go Incomplete [] . parser
 
     parser = A.parse (record (decDelimiter opts) <* (endOfLine <|> endOfInput))
     convert = runParser . p
-{-# INLINE decodeWithP #-}
+{-# INLINE decodeWithP' #-}
 
 blankLine :: V.Vector B.ByteString -> Bool
 blankLine v = V.length v == 1 && (B.null (V.head v))

cassava.cabal

@@ -83,9 +83,9 @@ Library
     Data.Csv.Incremental
     Data.Csv.Parser
     Data.Csv.Streaming
+    Data.Csv.Conversion
 
   Other-modules:
-    Data.Csv.Conversion
     Data.Csv.Conversion.Internal
     Data.Csv.Encoding
     Data.Csv.Types