module Data.Csv.Incremental
(
HeaderParser(..)
, decodeHeader
, decodeHeaderWith
, feedChunkH
, feedEndOfInputH
, Parser(..)
, decode
, decodeWith
, decodeByName
, decodeByNameWith
, feedChunk
, feedEndOfInput
) where
import Control.Applicative ((<*), (<|>))
import qualified Data.Attoparsec as A
import Data.Attoparsec.Char8 (endOfInput, endOfLine)
import qualified Data.ByteString as B
import qualified Data.HashMap.Strict as HM
import qualified Data.Vector as V
import Data.Csv.Conversion hiding (Parser, record, toNamedRecord)
import qualified Data.Csv.Conversion as Conversion
import Data.Csv.Parser
import Data.Csv.Types
data HeaderParser a =
FailH !B.ByteString String
| PartialH (B.ByteString -> HeaderParser a)
| DoneH !Header a
deriving Functor
instance Show a => Show (HeaderParser a) where
showsPrec d (FailH rest msg) = showParen (d > appPrec) showStr
where
showStr = showString "FailH " . showsPrec (appPrec+1) rest .
showString " " . showsPrec (appPrec+1) msg
showsPrec _ (PartialH _) = showString "PartialH <function>"
showsPrec d (DoneH hdr x) = showParen (d > appPrec) showStr
where
showStr = showString "DoneH " . showsPrec (appPrec+1) hdr .
showString " " . showsPrec (appPrec+1) x
appPrec :: Int
appPrec = 10
feedChunkH :: HeaderParser a -> B.ByteString -> HeaderParser a
feedChunkH (FailH rest err) s = FailH (B.append rest s) err
feedChunkH (PartialH k) s = k s
feedChunkH d@(DoneH _ _) _s = d
feedEndOfInputH :: HeaderParser a -> HeaderParser a
feedEndOfInputH (PartialH k) = k B.empty
feedEndOfInputH p = p
decodeHeader :: HeaderParser B.ByteString
decodeHeader = decodeHeaderWith defaultDecodeOptions
decodeHeaderWith :: DecodeOptions -> HeaderParser B.ByteString
decodeHeaderWith !opts = PartialH (go . parser)
where
parser = A.parse (header $ decDelimiter opts)
go (A.Fail rest _ msg) = FailH rest err
where err = "parse error (" ++ msg ++ ")"
go (A.Partial k) = PartialH $ \ s -> go (k s)
go (A.Done rest r) = DoneH r rest
data Parser a =
Fail !B.ByteString String
| Partial (B.ByteString -> Parser a)
| Some [Either String a] (B.ByteString -> Parser a)
| Done [Either String a]
deriving Functor
instance Show a => Show (Parser a) where
showsPrec d (Fail rest msg) = showParen (d > appPrec) showStr
where
showStr = showString "Fail " . showsPrec (appPrec+1) rest .
showString " " . showsPrec (appPrec+1) msg
showsPrec _ (Partial _) = showString "Partial <function>"
showsPrec d (Some rs _) = showParen (d > appPrec) showStr
where
showStr = showString "Some " . showsPrec (appPrec+1) rs .
showString " <function>"
showsPrec d (Done rs) = showParen (d > appPrec) showStr
where
showStr = showString "Done " . showsPrec (appPrec+1) rs
feedChunk :: Parser a -> B.ByteString -> Parser a
feedChunk (Fail rest err) s = Fail (B.append rest s) err
feedChunk (Partial k) s = k s
feedChunk (Some xs k) s = Some xs (\ s' -> k s `feedChunk` s')
feedChunk (Done xs) _s = Done xs
feedEndOfInput :: Parser a -> Parser a
feedEndOfInput (Partial k) = k B.empty
feedEndOfInput p = p
data More = Incomplete | Complete
deriving (Eq, Show)
decode :: FromRecord a
=> Bool
-> Parser a
decode = decodeWith defaultDecodeOptions
decodeWith :: FromRecord a
=> DecodeOptions
-> Bool
-> Parser a
decodeWith !opts skipHeader
| skipHeader = Partial $ \ s -> go (decodeHeaderWith opts `feedChunkH` s)
| otherwise = Partial (decodeWithP parseRecord opts)
where go (FailH rest msg) = Fail rest msg
go (PartialH k) = Partial $ \ s' -> go (k s')
go (DoneH _ rest) = decodeWithP parseRecord opts rest
decodeByName :: FromNamedRecord a
=> HeaderParser (Parser a)
decodeByName = decodeByNameWith defaultDecodeOptions
decodeByNameWith :: FromNamedRecord a
=> DecodeOptions
-> HeaderParser (Parser a)
decodeByNameWith !opts =
PartialH (go . (decodeHeaderWith opts `feedChunkH`))
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)
toNamedRecord :: Header -> Record -> NamedRecord
toNamedRecord hdr v = HM.fromList . V.toList $ V.zip hdr v
decodeWithP :: (Record -> Conversion.Parser a) -> DecodeOptions -> B.ByteString
-> Parser a
decodeWithP p !opts = go Incomplete [] . parser
where
go !_ !acc (A.Fail rest _ msg)
| null acc = Fail rest err
| otherwise = Some (reverse acc) (\ s -> Fail (rest `B.append` s) err)
where err = "parse error (" ++ msg ++ ")"
go Incomplete acc (A.Partial k)
| null acc = Partial cont
| otherwise = Some (reverse acc) cont
where cont s = go m [] (k s)
where m | B.null s = Complete
| otherwise = Incomplete
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
Complete -> Done (reverse acc')
Incomplete
| null acc' -> Partial (cont acc')
| otherwise -> Some (reverse acc') (cont [])
| otherwise = go m acc' (parser rest)
where cont acc'' s
| B.null s = Done (reverse acc'')
| otherwise = go Incomplete acc'' (parser s)
acc' | blankLine r = acc
| otherwise = convert r : acc
parser = A.parse (record (decDelimiter opts) <* (endOfLine <|> endOfInput))
convert = runParser . p
blankLine :: V.Vector B.ByteString -> Bool
blankLine v = V.length v == 1 && (B.null (V.head v))
moduleError :: String -> String -> a
moduleError func msg = error $ "Data.Csv.Incremental." ++ func ++ ": " ++ msg