Merge PR #167 (Parameterized record parsers)

(also tweak changelog & since annotations)

Author: hvr

CHANGES.md

@@ -1,7 +1,7 @@
 ## Version 0.5.2.0
 
  * Add `FromField`/`ToField` instances for `Identity` and `Const` (#158)
-
+ * New `typeclass`-less decoding functions `decodeWithP` and `decodeByNameWithP` (#67,#167)
  * Support for final phase of MFP / base-4.13
 
 ## Version 0.5.1.0

Setup.hs

@@ -1,2 +1,8 @@
 import Distribution.Simple
 main = defaultMain
+
+
+
+
+
+

examples/NamedBasedExplicitDecode.hs

@@ -0,0 +1,21 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import qualified Data.ByteString.Lazy as BL
+import Data.Csv
+import qualified Data.Vector as V
+
+data Person = Person
+    { name   :: String
+    , salary :: Int
+    }
+
+valueParse :: NamedRecord -> Parser Person
+valueParse r = Person <$> r .: "name" <*> r .: "salary"
+
+main :: IO ()
+main = do
+    csvData <- BL.readFile "salaries.csv"
+    case decodeByNameWithP valueParse defaultDecodeOptions csvData of
+        Left err -> putStrLn err
+        Right (_, v) -> V.forM_ v $ \ p ->
+            putStrLn $ name p ++ " earns " ++ show (salary p) ++ " dollars"

examples/cassava-examples.cabal

@@ -42,6 +42,16 @@ executable NamedBasedDecode
     vector
   default-language:    Haskell2010
 
+executable NamedBasedExplicitDecode
+  main-is: NamedBasedExplicitDecode.hs
+  build-depends:
+    base,
+    bytestring,
+    cassava,
+    vector
+  default-language:    Haskell2010
+
+
 executable NamedBasedGeneric
   main-is: NamedBasedGeneric.hs
   build-depends:

src/Data/Csv.hs

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

src/Data/Csv/Encoding.hs

@@ -24,7 +24,9 @@ module Data.Csv.Encoding
     , DecodeOptions(..)
     , defaultDecodeOptions
     , decodeWith
+    , decodeWithP
     , decodeByNameWith
+    , decodeByNameWithP
     , EncodeOptions(..)
     , defaultEncodeOptions
     , encodeWith
@@ -117,7 +119,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 +132,25 @@ idDecodeWith :: DecodeOptions -> HasHeader -> L.ByteString
              -> Either String (Vector (Vector B.ByteString))
 idDecodeWith = decodeWithC Parser.csv
 
+-- | Like 'decodeWith'', but lets you specify a parser function.
+--
+-- @since 0.5.2.0
+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 +162,18 @@ 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.
+--
+-- @since 0.5.2.0
+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 +354,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 +364,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 +377,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 +413,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

src/Data/Csv/Incremental.hs

@@ -55,11 +55,13 @@ module Data.Csv.Incremental
     , HasHeader(..)
     , decode
     , decodeWith
+    , decodeWithP
 
     -- ** Name-based record conversion
     -- $namebased
     , decodeByName
     , decodeByNameWith
+    , decodeByNameWithP
 
     -- * Encoding
     -- ** Index-based record conversion
@@ -247,12 +249,23 @@ 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
+--
+-- @since 0.5.2.0
+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 +282,31 @@ 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
+--
+-- @since 0.5.2.0
+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 +316,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 +331,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))