{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}

{-# OPTIONS_GHC -Wall -fno-warn-unused-imports #-}

-- | Build CSVs using the abstractions provided in the @colonnade@ library, and 
--   parse CSVs using 'Siphon', which is the dual of 'Colonnade'.
--   Read the documentation for @colonnade@ before reading the documentation
--   for @siphon@. All of the examples on this page assume a common set of
--   imports that are provided at the bottom of this page.
module Siphon
  ( -- * Encode CSV
    encodeCsv
  , encodeCsvStream
  , encodeCsvUtf8
  , encodeCsvStreamUtf8
    -- * Decode CSV
  , decodeCsvUtf8
    -- * Build Siphon
  , headed
  , headless
  , indexed
    -- * Types
  , Siphon
  , SiphonError(..)
  , Indexed(..)
    -- * Utility
  , humanizeSiphonError
    -- * Imports
    -- $setup
  ) where

import Siphon.Types
import Data.Monoid
import Control.Applicative
import Control.Monad

import qualified Data.ByteString.Char8 as BC8
import qualified Data.Attoparsec.ByteString as A
import qualified Data.Attoparsec.Lazy as AL
import qualified Data.Attoparsec.Zepto as Z
import qualified Data.ByteString as S
import qualified Data.ByteString.Unsafe as S
import qualified Data.Vector as V
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LByteString
import qualified Data.ByteString.Builder as Builder
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Builder as TB
import qualified Data.Text as T
import qualified Data.List as L
import qualified Streaming as SM
import qualified Streaming.Prelude as SMP
import qualified Data.Attoparsec.Types as ATYP
import qualified Colonnade.Encode as CE
import qualified Data.Vector.Mutable as MV
import qualified Data.ByteString.Builder as BB
import qualified Data.Semigroup as SG

import Control.Monad.Trans.Class
import Data.Functor.Identity (Identity(..))
import Data.ByteString.Builder (toLazyByteString,byteString)
import Data.Attoparsec.ByteString.Char8 (char, endOfInput, string)
import Data.Word (Word8)
import Data.Vector (Vector)
import Data.ByteString (ByteString)
import Data.Coerce (coerce)
import Data.Char (chr)
import Data.Text.Encoding (decodeUtf8')
import Streaming (Stream,Of(..))
import Data.Vector.Mutable (MVector)
import Control.Monad.ST
import Data.Text (Text)
import Data.Semigroup (Semigroup)

newtype Escaped c = Escaped { Escaped c -> c
getEscaped :: c }
data Ended = EndedYes | EndedNo
  deriving (Int -> Ended -> ShowS
[Ended] -> ShowS
Ended -> String
(Int -> Ended -> ShowS)
-> (Ended -> String) -> ([Ended] -> ShowS) -> Show Ended
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ended] -> ShowS
$cshowList :: [Ended] -> ShowS
show :: Ended -> String
$cshow :: Ended -> String
showsPrec :: Int -> Ended -> ShowS
$cshowsPrec :: Int -> Ended -> ShowS
Show)
data CellResult c = CellResultData !c | CellResultNewline !c !Ended
  deriving (Int -> CellResult c -> ShowS
[CellResult c] -> ShowS
CellResult c -> String
(Int -> CellResult c -> ShowS)
-> (CellResult c -> String)
-> ([CellResult c] -> ShowS)
-> Show (CellResult c)
forall c. Show c => Int -> CellResult c -> ShowS
forall c. Show c => [CellResult c] -> ShowS
forall c. Show c => CellResult c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CellResult c] -> ShowS
$cshowList :: forall c. Show c => [CellResult c] -> ShowS
show :: CellResult c -> String
$cshow :: forall c. Show c => CellResult c -> String
showsPrec :: Int -> CellResult c -> ShowS
$cshowsPrec :: forall c. Show c => Int -> CellResult c -> ShowS
Show)

decodeCsvUtf8 :: Monad m 
  => Siphon CE.Headed ByteString a
  -> Stream (Of ByteString) m () -- ^ encoded csv
  -> Stream (Of a) m (Maybe SiphonError)
decodeCsvUtf8 :: Siphon Headed ByteString a
-> Stream (Of ByteString) m ()
-> Stream (Of a) m (Maybe SiphonError)
decodeCsvUtf8 Siphon Headed ByteString a
headedSiphon Stream (Of ByteString) m ()
s1 = do
  Either
  SiphonError (Of (Vector ByteString) (Stream (Of ByteString) m ()))
e <- m (Either
     SiphonError (Of (Vector ByteString) (Stream (Of ByteString) m ())))
-> Stream
     (Of a)
     m
     (Either
        SiphonError (Of (Vector ByteString) (Stream (Of ByteString) m ())))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Stream (Of ByteString) m ()
-> m (Either
        SiphonError (Of (Vector ByteString) (Stream (Of ByteString) m ())))
forall (m :: * -> *).
Monad m =>
Stream (Of ByteString) m ()
-> m (Either
        SiphonError (Of (Vector ByteString) (Stream (Of ByteString) m ())))
consumeHeaderRowUtf8 Stream (Of ByteString) m ()
s1)
  case Either
  SiphonError (Of (Vector ByteString) (Stream (Of ByteString) m ()))
e of
    Left SiphonError
err -> Maybe SiphonError -> Stream (Of a) m (Maybe SiphonError)
forall (m :: * -> *) a. Monad m => a -> m a
return (SiphonError -> Maybe SiphonError
forall a. a -> Maybe a
Just SiphonError
err)
    Right (Vector ByteString
v :> Stream (Of ByteString) m ()
s2) -> case (ByteString -> Text)
-> Vector ByteString
-> Siphon Headed ByteString a
-> Either SiphonError (Siphon IndexedHeader ByteString a)
forall c a.
Eq c =>
(c -> Text)
-> Vector c
-> Siphon Headed c a
-> Either SiphonError (Siphon IndexedHeader c a)
headedToIndexed ByteString -> Text
utf8ToStr Vector ByteString
v Siphon Headed ByteString a
headedSiphon of
      Left SiphonError
err -> Maybe SiphonError -> Stream (Of a) m (Maybe SiphonError)
forall (m :: * -> *) a. Monad m => a -> m a
return (SiphonError -> Maybe SiphonError
forall a. a -> Maybe a
Just SiphonError
err)
      Right Siphon IndexedHeader ByteString a
ixedSiphon -> do
        let requiredLength :: Int
requiredLength = Vector ByteString -> Int
forall a. Vector a -> Int
V.length Vector ByteString
v
        Int
-> Int
-> Siphon IndexedHeader ByteString a
-> Stream (Of ByteString) m ()
-> Stream (Of a) m (Maybe SiphonError)
forall (m :: * -> *) a.
Monad m =>
Int
-> Int
-> Siphon IndexedHeader ByteString a
-> Stream (Of ByteString) m ()
-> Stream (Of a) m (Maybe SiphonError)
consumeBodyUtf8 Int
1 Int
requiredLength Siphon IndexedHeader ByteString a
ixedSiphon Stream (Of ByteString) m ()
s2

encodeCsvStreamUtf8 :: (Monad m, CE.Headedness h)
  => CE.Colonnade h a ByteString
  -> Stream (Of a) m r
  -> Stream (Of ByteString) m r
encodeCsvStreamUtf8 :: Colonnade h a ByteString
-> Stream (Of a) m r -> Stream (Of ByteString) m r
encodeCsvStreamUtf8 =
  (ByteString -> Escaped ByteString)
-> ByteString
-> ByteString
-> Colonnade h a ByteString
-> Stream (Of a) m r
-> Stream (Of ByteString) m r
forall (m :: * -> *) (h :: * -> *) c a r.
(Monad m, Headedness h) =>
(c -> Escaped c)
-> c
-> c
-> Colonnade h a c
-> Stream (Of a) m r
-> Stream (Of c) m r
encodeCsvInternal ByteString -> Escaped ByteString
escapeChar8 (Word8 -> ByteString
B.singleton Word8
comma) (Word8 -> ByteString
B.singleton Word8
newline)

-- | Streaming variant of 'encodeCsv'. This is particularly useful
--   when you need to produce millions of rows without having them
--   all loaded into memory at the same time.
encodeCsvStream :: (Monad m, CE.Headedness h)
  => CE.Colonnade h a Text
  -> Stream (Of a) m r
  -> Stream (Of Text) m r
encodeCsvStream :: Colonnade h a Text -> Stream (Of a) m r -> Stream (Of Text) m r
encodeCsvStream =
  (Text -> Escaped Text)
-> Text
-> Text
-> Colonnade h a Text
-> Stream (Of a) m r
-> Stream (Of Text) m r
forall (m :: * -> *) (h :: * -> *) c a r.
(Monad m, Headedness h) =>
(c -> Escaped c)
-> c
-> c
-> Colonnade h a c
-> Stream (Of a) m r
-> Stream (Of c) m r
encodeCsvInternal Text -> Escaped Text
textEscapeChar8 (Char -> Text
T.singleton Char
',') (Char -> Text
T.singleton Char
'\n')

-- | Encode a collection to a CSV as a text 'TB.Builder'. For example,
--   we can take the following columnar encoding of a person:
--
-- >>> :{
-- let colPerson :: Colonnade Headed Person Text
--     colPerson = mconcat
--       [ C.headed "Name" name
--       , C.headed "Age" (T.pack . show . age)
--       , C.headed "Company" (fromMaybe "N/A" . company)
--       ]
-- :}
--
-- And we have the following people whom we wish to encode
-- in this way:
--
-- >>> :{
-- let people :: [Person]
--     people =
--       [ Person "Chao" 26 (Just "Tectonic, Inc.")
--       , Person "Elsie" 41 (Just "Globex Corporation")
--       , Person "Arabella" 19 Nothing
--       ]
-- :}
--
-- We pair the encoding with the rows to get a CSV:
--
-- >>> LTIO.putStr (TB.toLazyText (encodeCsv colPerson people))
-- Name,Age,Company
-- Chao,26,"Tectonic, Inc."
-- Elsie,41,Globex Corporation
-- Arabella,19,N/A
encodeCsv :: (Foldable f, CE.Headedness h)
  => CE.Colonnade h a Text -- ^ Tablular encoding
  -> f a -- ^ Value of each row
  -> TB.Builder
encodeCsv :: Colonnade h a Text -> f a -> Builder
encodeCsv Colonnade h a Text
enc = 
  Stream (Of Text) Identity () -> Builder
textStreamToBuilder (Stream (Of Text) Identity () -> Builder)
-> (f a -> Stream (Of Text) Identity ()) -> f a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Colonnade h a Text
-> Stream (Of a) Identity () -> Stream (Of Text) Identity ()
forall (m :: * -> *) (h :: * -> *) a r.
(Monad m, Headedness h) =>
Colonnade h a Text -> Stream (Of a) m r -> Stream (Of Text) m r
encodeCsvStream Colonnade h a Text
enc (Stream (Of a) Identity () -> Stream (Of Text) Identity ())
-> (f a -> Stream (Of a) Identity ())
-> f a
-> Stream (Of Text) Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Stream (Of a) Identity ()
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Foldable f) =>
f a -> Stream (Of a) m ()
SMP.each

-- | Encode a collection to a CSV as a bytestring 'BB.Builder'.
encodeCsvUtf8 :: (Foldable f, CE.Headedness h)
  => CE.Colonnade h a ByteString -- ^ Tablular encoding
  -> f a -- ^ Value of each row
  -> BB.Builder
encodeCsvUtf8 :: Colonnade h a ByteString -> f a -> Builder
encodeCsvUtf8 Colonnade h a ByteString
enc =
  Stream (Of ByteString) Identity () -> Builder
streamToBuilder (Stream (Of ByteString) Identity () -> Builder)
-> (f a -> Stream (Of ByteString) Identity ()) -> f a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Colonnade h a ByteString
-> Stream (Of a) Identity () -> Stream (Of ByteString) Identity ()
forall (m :: * -> *) (h :: * -> *) a r.
(Monad m, Headedness h) =>
Colonnade h a ByteString
-> Stream (Of a) m r -> Stream (Of ByteString) m r
encodeCsvStreamUtf8 Colonnade h a ByteString
enc (Stream (Of a) Identity () -> Stream (Of ByteString) Identity ())
-> (f a -> Stream (Of a) Identity ())
-> f a
-> Stream (Of ByteString) Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Stream (Of a) Identity ()
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Foldable f) =>
f a -> Stream (Of a) m ()
SMP.each

streamToBuilder :: Stream (Of ByteString) Identity () -> BB.Builder
streamToBuilder :: Stream (Of ByteString) Identity () -> Builder
streamToBuilder Stream (Of ByteString) Identity ()
s = Stream (Of ByteString) Identity ()
-> (Of ByteString Builder -> Builder)
-> (Identity Builder -> Builder)
-> (() -> Builder)
-> Builder
forall (f :: * -> *) (m :: * -> *) r b.
(Functor f, Monad m) =>
Stream f m r -> (f b -> b) -> (m b -> b) -> (r -> b) -> b
SM.destroy Stream (Of ByteString) Identity ()
s
  (\(ByteString
bs :> Builder
bb) -> ByteString -> Builder
BB.byteString ByteString
bs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
bb) Identity Builder -> Builder
forall a. Identity a -> a
runIdentity (\() -> Builder
forall a. Monoid a => a
mempty)

textStreamToBuilder :: Stream (Of Text) Identity () -> TB.Builder
textStreamToBuilder :: Stream (Of Text) Identity () -> Builder
textStreamToBuilder Stream (Of Text) Identity ()
s = Stream (Of Text) Identity ()
-> (Of Text Builder -> Builder)
-> (Identity Builder -> Builder)
-> (() -> Builder)
-> Builder
forall (f :: * -> *) (m :: * -> *) r b.
(Functor f, Monad m) =>
Stream f m r -> (f b -> b) -> (m b -> b) -> (r -> b) -> b
SM.destroy Stream (Of Text) Identity ()
s
  (\(Text
bs :> Builder
bb) -> Text -> Builder
TB.fromText Text
bs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
bb) Identity Builder -> Builder
forall a. Identity a -> a
runIdentity (\() -> Builder
forall a. Monoid a => a
mempty)

encodeCsvInternal :: (Monad m, CE.Headedness h)
  => (c -> Escaped c)
  -> c -- ^ separator
  -> c -- ^ newline
  -> CE.Colonnade h a c
  -> Stream (Of a) m r
  -> Stream (Of c) m r
encodeCsvInternal :: (c -> Escaped c)
-> c
-> c
-> Colonnade h a c
-> Stream (Of a) m r
-> Stream (Of c) m r
encodeCsvInternal c -> Escaped c
escapeFunc c
separatorStr c
newlineStr Colonnade h a c
colonnade Stream (Of a) m r
s = do
  case Maybe (h c -> c)
forall (h :: * -> *) a. Headedness h => Maybe (h a -> a)
CE.headednessExtract of
    Just h c -> c
toContent -> (h c -> c)
-> (c -> Escaped c)
-> c
-> c
-> Colonnade h a c
-> Stream (Of c) m ()
forall (m :: * -> *) (h :: * -> *) c a.
Monad m =>
(h c -> c)
-> (c -> Escaped c)
-> c
-> c
-> Colonnade h a c
-> Stream (Of c) m ()
encodeHeader h c -> c
toContent c -> Escaped c
escapeFunc c
separatorStr c
newlineStr Colonnade h a c
colonnade
    Maybe (h c -> c)
Nothing -> () -> Stream (Of c) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  (c -> Escaped c)
-> c
-> c
-> Colonnade h a c
-> Stream (Of a) m r
-> Stream (Of c) m r
forall (m :: * -> *) c (f :: * -> *) a r.
Monad m =>
(c -> Escaped c)
-> c
-> c
-> Colonnade f a c
-> Stream (Of a) m r
-> Stream (Of c) m r
encodeRows c -> Escaped c
escapeFunc c
separatorStr c
newlineStr Colonnade h a c
colonnade Stream (Of a) m r
s

encodeHeader :: Monad m
  => (h c -> c)
  -> (c -> Escaped c)
  -> c -- ^ separator
  -> c -- ^ newline
  -> CE.Colonnade h a c
  -> Stream (Of c) m ()
encodeHeader :: (h c -> c)
-> (c -> Escaped c)
-> c
-> c
-> Colonnade h a c
-> Stream (Of c) m ()
encodeHeader h c -> c
toContent c -> Escaped c
escapeFunc c
separatorStr c
newlineStr Colonnade h a c
colonnade = do
  let (Vector (OneColonnade h a c)
vs,Vector (OneColonnade h a c)
ws) = Int
-> Vector (OneColonnade h a c)
-> (Vector (OneColonnade h a c), Vector (OneColonnade h a c))
forall a. Int -> Vector a -> (Vector a, Vector a)
V.splitAt Int
1 (Colonnade h a c -> Vector (OneColonnade h a c)
forall (h :: * -> *) a c.
Colonnade h a c -> Vector (OneColonnade h a c)
CE.getColonnade Colonnade h a c
colonnade)
  -- we only need to do this split because the first cell
  -- gets treated differently than the others. It does not
  -- get a separator added before it.
  Vector (OneColonnade h a c)
-> (OneColonnade h a c -> Stream (Of c) m ()) -> Stream (Of c) m ()
forall (m :: * -> *) a b. Monad m => Vector a -> (a -> m b) -> m ()
V.forM_ Vector (OneColonnade h a c)
vs ((OneColonnade h a c -> Stream (Of c) m ()) -> Stream (Of c) m ())
-> (OneColonnade h a c -> Stream (Of c) m ()) -> Stream (Of c) m ()
forall a b. (a -> b) -> a -> b
$ \(CE.OneColonnade h c
h a -> c
_) -> do
    c -> Stream (Of c) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
SMP.yield (Escaped c -> c
forall c. Escaped c -> c
getEscaped (c -> Escaped c
escapeFunc (h c -> c
toContent h c
h)))
  Vector (OneColonnade h a c)
-> (OneColonnade h a c -> Stream (Of c) m ()) -> Stream (Of c) m ()
forall (m :: * -> *) a b. Monad m => Vector a -> (a -> m b) -> m ()
V.forM_ Vector (OneColonnade h a c)
ws ((OneColonnade h a c -> Stream (Of c) m ()) -> Stream (Of c) m ())
-> (OneColonnade h a c -> Stream (Of c) m ()) -> Stream (Of c) m ()
forall a b. (a -> b) -> a -> b
$ \(CE.OneColonnade h c
h a -> c
_) -> do
    c -> Stream (Of c) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
SMP.yield c
separatorStr
    c -> Stream (Of c) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
SMP.yield (Escaped c -> c
forall c. Escaped c -> c
getEscaped (c -> Escaped c
escapeFunc (h c -> c
toContent h c
h)))
  c -> Stream (Of c) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
SMP.yield c
newlineStr

mapStreamM :: Monad m
  => (a -> Stream (Of b) m x)
  -> Stream (Of a) m r
  -> Stream (Of b) m r
mapStreamM :: (a -> Stream (Of b) m x) -> Stream (Of a) m r -> Stream (Of b) m r
mapStreamM a -> Stream (Of b) m x
f = Stream (Stream (Of b) m) m r -> Stream (Of b) m r
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
Stream (Stream f m) m r -> Stream f m r
SM.concats (Stream (Stream (Of b) m) m r -> Stream (Of b) m r)
-> (Stream (Of a) m r -> Stream (Stream (Of b) m) m r)
-> Stream (Of a) m r
-> Stream (Of b) m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. Of a x -> m (Stream (Of b) m x))
-> Stream (Of a) m r -> Stream (Stream (Of b) m) m r
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) r.
(Monad m, Functor f) =>
(forall x. f x -> m (g x)) -> Stream f m r -> Stream g m r
SM.mapsM (\(a :> s) -> Stream (Of b) m x -> m (Stream (Of b) m x)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Stream (Of b) m x
f a
a Stream (Of b) m x -> Stream (Of b) m x -> Stream (Of b) m x
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> x -> Stream (Of b) m x
forall (m :: * -> *) a. Monad m => a -> m a
return x
s))

encodeRows :: Monad m
  => (c -> Escaped c)
  -> c -- ^ separator
  -> c -- ^ newline
  -> CE.Colonnade f a c
  -> Stream (Of a) m r
  -> Stream (Of c) m r
encodeRows :: (c -> Escaped c)
-> c
-> c
-> Colonnade f a c
-> Stream (Of a) m r
-> Stream (Of c) m r
encodeRows c -> Escaped c
escapeFunc c
separatorStr c
newlineStr Colonnade f a c
colonnade = (a -> Stream (Of c) m ()) -> Stream (Of a) m r -> Stream (Of c) m r
forall (m :: * -> *) a b x r.
Monad m =>
(a -> Stream (Of b) m x) -> Stream (Of a) m r -> Stream (Of b) m r
mapStreamM ((a -> Stream (Of c) m ())
 -> Stream (Of a) m r -> Stream (Of c) m r)
-> (a -> Stream (Of c) m ())
-> Stream (Of a) m r
-> Stream (Of c) m r
forall a b. (a -> b) -> a -> b
$ \a
a -> do
  let (Vector (OneColonnade f a c)
vs,Vector (OneColonnade f a c)
ws) = Int
-> Vector (OneColonnade f a c)
-> (Vector (OneColonnade f a c), Vector (OneColonnade f a c))
forall a. Int -> Vector a -> (Vector a, Vector a)
V.splitAt Int
1 (Colonnade f a c -> Vector (OneColonnade f a c)
forall (h :: * -> *) a c.
Colonnade h a c -> Vector (OneColonnade h a c)
CE.getColonnade Colonnade f a c
colonnade)
  -- we only need to do this split because the first cell
  -- gets treated differently than the others. It does not
  -- get a separator added before it.
  Vector (OneColonnade f a c)
-> (OneColonnade f a c -> Stream (Of c) m ()) -> Stream (Of c) m ()
forall (m :: * -> *) a b. Monad m => Vector a -> (a -> m b) -> m ()
V.forM_ Vector (OneColonnade f a c)
vs ((OneColonnade f a c -> Stream (Of c) m ()) -> Stream (Of c) m ())
-> (OneColonnade f a c -> Stream (Of c) m ()) -> Stream (Of c) m ()
forall a b. (a -> b) -> a -> b
$ \(CE.OneColonnade f c
_ a -> c
encode) -> c -> Stream (Of c) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
SMP.yield (Escaped c -> c
forall c. Escaped c -> c
getEscaped (c -> Escaped c
escapeFunc (a -> c
encode a
a)))
  Vector (OneColonnade f a c)
-> (OneColonnade f a c -> Stream (Of c) m ()) -> Stream (Of c) m ()
forall (m :: * -> *) a b. Monad m => Vector a -> (a -> m b) -> m ()
V.forM_ Vector (OneColonnade f a c)
ws ((OneColonnade f a c -> Stream (Of c) m ()) -> Stream (Of c) m ())
-> (OneColonnade f a c -> Stream (Of c) m ()) -> Stream (Of c) m ()
forall a b. (a -> b) -> a -> b
$ \(CE.OneColonnade f c
_ a -> c
encode) -> do
    c -> Stream (Of c) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
SMP.yield c
separatorStr
    c -> Stream (Of c) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
SMP.yield (Escaped c -> c
forall c. Escaped c -> c
getEscaped (c -> Escaped c
escapeFunc (a -> c
encode a
a)))
  c -> Stream (Of c) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
SMP.yield c
newlineStr

data IndexedHeader a = IndexedHeader
  { IndexedHeader a -> Int
indexedHeaderIndexed :: {-# UNPACK #-} !Int
  , IndexedHeader a -> a
indexedHeaderHeader :: !a
  } 

-- | Maps over a 'Decolonnade' that expects headers, converting these
--   expected headers into the indices of the columns that they
--   correspond to.
headedToIndexed :: forall c a. Eq c
  => (c -> T.Text)
  -> Vector c -- ^ Headers in the source document
  -> Siphon CE.Headed c a -- ^ Decolonnade that contains expected headers
  -> Either SiphonError (Siphon IndexedHeader c a)
headedToIndexed :: (c -> Text)
-> Vector c
-> Siphon Headed c a
-> Either SiphonError (Siphon IndexedHeader c a)
headedToIndexed c -> Text
toStr Vector c
v =
    (HeaderErrors -> SiphonError)
-> Either HeaderErrors (Siphon IndexedHeader c a)
-> Either SiphonError (Siphon IndexedHeader c a)
forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft (\(HeaderErrors Vector (Vector CellError)
a Vector Text
b Vector Int
c) -> Int -> RowError -> SiphonError
SiphonError Int
0 (Vector (Vector CellError) -> Vector Text -> Vector Int -> RowError
RowErrorHeaders Vector (Vector CellError)
a Vector Text
b Vector Int
c)) 
  (Either HeaderErrors (Siphon IndexedHeader c a)
 -> Either SiphonError (Siphon IndexedHeader c a))
-> (Siphon Headed c a
    -> Either HeaderErrors (Siphon IndexedHeader c a))
-> Siphon Headed c a
-> Either SiphonError (Siphon IndexedHeader c a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EitherWrap HeaderErrors (Siphon IndexedHeader c a)
-> Either HeaderErrors (Siphon IndexedHeader c a)
forall a b. EitherWrap a b -> Either a b
getEitherWrap
  (EitherWrap HeaderErrors (Siphon IndexedHeader c a)
 -> Either HeaderErrors (Siphon IndexedHeader c a))
-> (Siphon Headed c a
    -> EitherWrap HeaderErrors (Siphon IndexedHeader c a))
-> Siphon Headed c a
-> Either HeaderErrors (Siphon IndexedHeader c a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Siphon Headed c a
-> EitherWrap HeaderErrors (Siphon IndexedHeader c a)
forall b.
Siphon Headed c b
-> EitherWrap HeaderErrors (Siphon IndexedHeader c b)
go
  where
  go :: forall b.
        Siphon CE.Headed c b
     -> EitherWrap HeaderErrors (Siphon IndexedHeader c b)
  go :: Siphon Headed c b
-> EitherWrap HeaderErrors (Siphon IndexedHeader c b)
go (SiphonPure b
b) = Either HeaderErrors (Siphon IndexedHeader c b)
-> EitherWrap HeaderErrors (Siphon IndexedHeader c b)
forall a b. Either a b -> EitherWrap a b
EitherWrap (Siphon IndexedHeader c b
-> Either HeaderErrors (Siphon IndexedHeader c b)
forall a b. b -> Either a b
Right (b -> Siphon IndexedHeader c b
forall a (f :: * -> *) c. a -> Siphon f c a
SiphonPure b
b))
  go (SiphonAp (CE.Headed c
h) c -> Maybe a
decode Siphon Headed c (a -> b)
apNext) =
    let rnext :: EitherWrap HeaderErrors (Siphon IndexedHeader c (a -> b))
rnext = Siphon Headed c (a -> b)
-> EitherWrap HeaderErrors (Siphon IndexedHeader c (a -> b))
forall b.
Siphon Headed c b
-> EitherWrap HeaderErrors (Siphon IndexedHeader c b)
go Siphon Headed c (a -> b)
apNext
        ixs :: Vector Int
ixs = c -> Vector c -> Vector Int
forall a. Eq a => a -> Vector a -> Vector Int
V.elemIndices c
h Vector c
v
        ixsLen :: Int
ixsLen = Vector Int -> Int
forall a. Vector a -> Int
V.length Vector Int
ixs
        rcurrent :: Either HeaderErrors Int
rcurrent
          | Int
ixsLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Int -> Either HeaderErrors Int
forall a b. b -> Either a b
Right (Vector Int
ixs Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
V.! Int
0) -- (V.unsafeIndex ixs 0)
          | Int
ixsLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = HeaderErrors -> Either HeaderErrors Int
forall a b. a -> Either a b
Left (Vector (Vector CellError)
-> Vector Text -> Vector Int -> HeaderErrors
HeaderErrors Vector (Vector CellError)
forall a. Vector a
V.empty (Text -> Vector Text
forall a. a -> Vector a
V.singleton (c -> Text
toStr c
h)) Vector Int
forall a. Vector a
V.empty)
          | Bool
otherwise =
              let dups :: Vector (Vector CellError)
dups = Vector CellError -> Vector (Vector CellError)
forall a. a -> Vector a
V.singleton ((Int -> CellError) -> Vector Int -> Vector CellError
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\Int
ix -> Int -> Text -> CellError
CellError Int
ix (c -> Text
toStr (Vector c
v Vector c -> Int -> c
forall a. Vector a -> Int -> a
V.! Int
ix) {- (V.unsafeIndex v ix) -} )) Vector Int
ixs)
               in HeaderErrors -> Either HeaderErrors Int
forall a b. a -> Either a b
Left (Vector (Vector CellError)
-> Vector Text -> Vector Int -> HeaderErrors
HeaderErrors Vector (Vector CellError)
dups Vector Text
forall a. Vector a
V.empty Vector Int
forall a. Vector a
V.empty)
    in (\Int
ix Siphon IndexedHeader c (a -> b)
nextSiphon -> IndexedHeader c
-> (c -> Maybe a)
-> Siphon IndexedHeader c (a -> b)
-> Siphon IndexedHeader c b
forall (f :: * -> *) c a b.
f c -> (c -> Maybe a) -> Siphon f c (a -> b) -> Siphon f c b
SiphonAp (Int -> c -> IndexedHeader c
forall a. Int -> a -> IndexedHeader a
IndexedHeader Int
ix c
h) c -> Maybe a
decode Siphon IndexedHeader c (a -> b)
nextSiphon)
       (Int
 -> Siphon IndexedHeader c (a -> b) -> Siphon IndexedHeader c b)
-> EitherWrap HeaderErrors Int
-> EitherWrap
     HeaderErrors
     (Siphon IndexedHeader c (a -> b) -> Siphon IndexedHeader c b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either HeaderErrors Int -> EitherWrap HeaderErrors Int
forall a b. Either a b -> EitherWrap a b
EitherWrap Either HeaderErrors Int
rcurrent
       EitherWrap
  HeaderErrors
  (Siphon IndexedHeader c (a -> b) -> Siphon IndexedHeader c b)
-> EitherWrap HeaderErrors (Siphon IndexedHeader c (a -> b))
-> EitherWrap HeaderErrors (Siphon IndexedHeader c b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EitherWrap HeaderErrors (Siphon IndexedHeader c (a -> b))
rnext

data HeaderErrors = HeaderErrors !(Vector (Vector CellError)) !(Vector T.Text) !(Vector Int)

instance Semigroup HeaderErrors where
  HeaderErrors Vector (Vector CellError)
a1 Vector Text
b1 Vector Int
c1 <> :: HeaderErrors -> HeaderErrors -> HeaderErrors
<> HeaderErrors Vector (Vector CellError)
a2 Vector Text
b2 Vector Int
c2 = Vector (Vector CellError)
-> Vector Text -> Vector Int -> HeaderErrors
HeaderErrors
    (Vector (Vector CellError)
-> Vector (Vector CellError) -> Vector (Vector CellError)
forall a. Monoid a => a -> a -> a
mappend Vector (Vector CellError)
a1 Vector (Vector CellError)
a2) (Vector Text -> Vector Text -> Vector Text
forall a. Monoid a => a -> a -> a
mappend Vector Text
b1 Vector Text
b2) (Vector Int -> Vector Int -> Vector Int
forall a. Monoid a => a -> a -> a
mappend Vector Int
c1 Vector Int
c2)

instance Monoid HeaderErrors where
  mempty :: HeaderErrors
mempty = Vector (Vector CellError)
-> Vector Text -> Vector Int -> HeaderErrors
HeaderErrors Vector (Vector CellError)
forall a. Monoid a => a
mempty Vector Text
forall a. Monoid a => a
mempty Vector Int
forall a. Monoid a => a
mempty
  mappend :: HeaderErrors -> HeaderErrors -> HeaderErrors
mappend = HeaderErrors -> HeaderErrors -> HeaderErrors
forall a. Semigroup a => a -> a -> a
(SG.<>)

-- byteStringChar8 :: Siphon ByteString
-- byteStringChar8 = Siphon
--   escape
--   encodeRow
--   (A.parse (row comma))
--   B.null

escapeChar8 :: ByteString -> Escaped ByteString
escapeChar8 :: ByteString -> Escaped ByteString
escapeChar8 ByteString
t = case (Word8 -> Bool) -> ByteString -> Maybe Word8
B.find (\Word8
c -> Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
newline Bool -> Bool -> Bool
|| Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
cr Bool -> Bool -> Bool
|| Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
comma Bool -> Bool -> Bool
|| Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
doubleQuote) ByteString
t of
  Maybe Word8
Nothing -> ByteString -> Escaped ByteString
forall c. c -> Escaped c
Escaped ByteString
t
  Just Word8
_  -> ByteString -> Escaped ByteString
escapeAlways ByteString
t

textEscapeChar8 :: Text -> Escaped Text
textEscapeChar8 :: Text -> Escaped Text
textEscapeChar8 Text
t = case (Char -> Bool) -> Text -> Maybe Char
T.find (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"') Text
t of
  Maybe Char
Nothing -> Text -> Escaped Text
forall c. c -> Escaped c
Escaped Text
t
  Just Char
_  -> Text -> Escaped Text
textEscapeAlways Text
t

-- This implementation is definitely suboptimal.
-- A better option (which would waste a little space
-- but would be much faster) would be to build the
-- new bytestring by writing to a buffer directly.
escapeAlways :: ByteString -> Escaped ByteString
escapeAlways :: ByteString -> Escaped ByteString
escapeAlways ByteString
t = ByteString -> Escaped ByteString
forall c. c -> Escaped c
Escaped (ByteString -> Escaped ByteString)
-> ByteString -> Escaped ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LByteString.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
Builder.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
     Word8 -> Builder
Builder.word8 Word8
doubleQuote
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Builder -> Word8 -> Builder) -> Builder -> ByteString -> Builder
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl
      (\ Builder
acc Word8
b -> Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> if Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
doubleQuote
          then ByteString -> Builder
Builder.byteString
            ([Word8] -> ByteString
B.pack [Word8
doubleQuote,Word8
doubleQuote])
          else Word8 -> Builder
Builder.word8 Word8
b)
      Builder
forall a. Monoid a => a
mempty
      ByteString
t
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
Builder.word8 Word8
doubleQuote

-- Suboptimal for similar reason as escapeAlways.
textEscapeAlways :: Text -> Escaped Text
textEscapeAlways :: Text -> Escaped Text
textEscapeAlways Text
t = Text -> Escaped Text
forall c. c -> Escaped c
Escaped (Text -> Escaped Text) -> Text -> Escaped Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
LT.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> Text
TB.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$
     Char -> Builder
TB.singleton Char
'"'
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Builder -> Char -> Builder) -> Builder -> Text -> Builder
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl
      (\ Builder
acc Char
b -> Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> if Char
b Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"'
          then String -> Builder
TB.fromString String
"\"\""
          else Char -> Builder
TB.singleton Char
b
      )
      Builder
forall a. Monoid a => a
mempty
      Text
t
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
TB.singleton Char
'"'

-- 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. You
-- most likely want to use the 'endOfLine' parser in combination with
-- this parser.
--
-- row :: Word8  -- ^ Field delimiter
--     -> AL.Parser (Vector ByteString)
-- row !delim = rowNoNewline delim <* endOfLine
-- {-# INLINE row #-}
-- 
-- rowNoNewline :: Word8  -- ^ Field delimiter
--              -> AL.Parser (Vector ByteString)
-- rowNoNewline !delim = V.fromList <$!> field delim `sepByDelim1'` delim
-- {-# INLINE rowNoNewline #-}
-- 
-- removeBlankLines :: [Vector ByteString] -> [Vector ByteString]
-- removeBlankLines = filter (not . blankLine)


-- | Parse a field. The field may be in either the escaped or
--   non-escaped format. The return value is unescaped. This
--   parser will consume the comma that comes after a field
--   but not a newline that follows a field. If we are positioned
--   at a newline when it starts, that newline will be consumed
--   and we return CellResultNewline.
field :: Word8 -> AL.Parser (CellResult ByteString)
field :: Word8 -> Parser (CellResult ByteString)
field !Word8
delim = do
  Maybe Word8
mb <- Parser (Maybe Word8)
A.peekWord8
  -- We purposely don't use <|> as we want to commit to the first
  -- choice if we see a double quote.
  case Maybe Word8
mb of
    Just Word8
b
      | Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
doubleQuote -> do
          (ByteString
bs,TrailChar
tc) <- Parser (ByteString, TrailChar)
escapedField
          case TrailChar
tc of
            TrailChar
TrailCharComma -> CellResult ByteString -> Parser (CellResult ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> CellResult ByteString
forall c. c -> CellResult c
CellResultData ByteString
bs)
            TrailChar
TrailCharNewline -> CellResult ByteString -> Parser (CellResult ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Ended -> CellResult ByteString
forall c. c -> Ended -> CellResult c
CellResultNewline ByteString
bs Ended
EndedNo)
            TrailChar
TrailCharEnd -> CellResult ByteString -> Parser (CellResult ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Ended -> CellResult ByteString
forall c. c -> Ended -> CellResult c
CellResultNewline ByteString
bs Ended
EndedYes)
      | Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
10 Bool -> Bool -> Bool
|| Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
13 -> do
          ByteString
_ <- Parser ByteString
eatNewlines
          Bool
isEnd <- Parser ByteString Bool
forall t. Chunk t => Parser t Bool
A.atEnd
          if Bool
isEnd
            then CellResult ByteString -> Parser (CellResult ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Ended -> CellResult ByteString
forall c. c -> Ended -> CellResult c
CellResultNewline ByteString
B.empty Ended
EndedYes)
            else CellResult ByteString -> Parser (CellResult ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Ended -> CellResult ByteString
forall c. c -> Ended -> CellResult c
CellResultNewline ByteString
B.empty Ended
EndedNo)
      | Bool
otherwise -> do
          (ByteString
bs,TrailChar
tc) <- Word8 -> Parser (ByteString, TrailChar)
unescapedField Word8
delim
          case TrailChar
tc of
            TrailChar
TrailCharComma -> CellResult ByteString -> Parser (CellResult ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> CellResult ByteString
forall c. c -> CellResult c
CellResultData ByteString
bs)
            TrailChar
TrailCharNewline -> CellResult ByteString -> Parser (CellResult ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Ended -> CellResult ByteString
forall c. c -> Ended -> CellResult c
CellResultNewline ByteString
bs Ended
EndedNo)
            TrailChar
TrailCharEnd -> CellResult ByteString -> Parser (CellResult ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Ended -> CellResult ByteString
forall c. c -> Ended -> CellResult c
CellResultNewline ByteString
bs Ended
EndedYes)
    Maybe Word8
Nothing -> CellResult ByteString -> Parser (CellResult ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Ended -> CellResult ByteString
forall c. c -> Ended -> CellResult c
CellResultNewline ByteString
B.empty Ended
EndedYes)
{-# INLINE field #-}

eatNewlines :: AL.Parser S.ByteString
eatNewlines :: Parser ByteString
eatNewlines = (Word8 -> Bool) -> Parser ByteString
A.takeWhile (\Word8
x -> Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
10 Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
13)

escapedField :: AL.Parser (S.ByteString,TrailChar)
escapedField :: Parser (ByteString, TrailChar)
escapedField = do
  Char
_ <- Parser Char
dquote
  -- The scan state is 'True' if the previous character was a double
  -- quote.  We need to drop a trailing double quote left by scan.
  ByteString
s <- ByteString -> ByteString
S.init (ByteString -> ByteString)
-> Parser ByteString -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ( Bool -> (Bool -> Word8 -> Maybe Bool) -> Parser ByteString
forall s. s -> (s -> Word8 -> Maybe s) -> Parser ByteString
A.scan Bool
False ((Bool -> Word8 -> Maybe Bool) -> Parser ByteString)
-> (Bool -> Word8 -> Maybe Bool) -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ \Bool
s Word8
c ->
      if Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
doubleQuote
        then Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Bool
not Bool
s)
        else if Bool
s
          then Maybe Bool
forall a. Maybe a
Nothing
          else Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
    )
  Maybe Word8
mb <- Parser (Maybe Word8)
A.peekWord8
  TrailChar
trailChar <- case Maybe Word8
mb of
    Just Word8
b
      | Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
comma -> Parser Word8
A.anyWord8 Parser Word8
-> Parser ByteString TrailChar -> Parser ByteString TrailChar
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TrailChar -> Parser ByteString TrailChar
forall (m :: * -> *) a. Monad m => a -> m a
return TrailChar
TrailCharComma
      | Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
newline -> Parser Word8
A.anyWord8 Parser Word8
-> Parser ByteString TrailChar -> Parser ByteString TrailChar
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TrailChar -> Parser ByteString TrailChar
forall (m :: * -> *) a. Monad m => a -> m a
return TrailChar
TrailCharNewline
      | Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
cr -> do
          Word8
_ <- Parser Word8
A.anyWord8
          Word8
_ <- Word8 -> Parser Word8
A.word8 Word8
newline
          TrailChar -> Parser ByteString TrailChar
forall (m :: * -> *) a. Monad m => a -> m a
return TrailChar
TrailCharNewline
      | Bool
otherwise -> String -> Parser ByteString TrailChar
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"encountered double quote after escaped field"
    Maybe Word8
Nothing -> TrailChar -> Parser ByteString TrailChar
forall (m :: * -> *) a. Monad m => a -> m a
return TrailChar
TrailCharEnd
  if Word8
doubleQuote Word8 -> ByteString -> Bool
`S.elem` ByteString
s
    then case Parser ByteString -> ByteString -> Either String ByteString
forall a. Parser a -> ByteString -> Either String a
Z.parse Parser ByteString
unescape ByteString
s of
      Right ByteString
r  -> (ByteString, TrailChar) -> Parser (ByteString, TrailChar)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
r,TrailChar
trailChar)
      Left String
err -> String -> Parser (ByteString, TrailChar)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
    else (ByteString, TrailChar) -> Parser (ByteString, TrailChar)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
s,TrailChar
trailChar)

data TrailChar = TrailCharNewline | TrailCharComma | TrailCharEnd

-- | Consume an unescaped field. If it ends with a newline,
--   leave that in tact. If it ends with a comma, consume the comma.
unescapedField :: Word8 -> AL.Parser (S.ByteString,TrailChar)
unescapedField :: Word8 -> Parser (ByteString, TrailChar)
unescapedField !Word8
delim = do
  ByteString
bs <- (Word8 -> Bool) -> Parser ByteString
A.takeWhile ((Word8 -> Bool) -> Parser ByteString)
-> (Word8 -> Bool) -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ \Word8
c -> 
    Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
doubleQuote Bool -> Bool -> Bool
&&
    Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
newline Bool -> Bool -> Bool
&&
    Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
delim Bool -> Bool -> Bool
&&
    Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
cr
  Maybe Word8
mb <- Parser (Maybe Word8)
A.peekWord8
  case Maybe Word8
mb of
    Just Word8
b
      | Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
comma -> Parser Word8
A.anyWord8 Parser Word8
-> Parser (ByteString, TrailChar) -> Parser (ByteString, TrailChar)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ByteString, TrailChar) -> Parser (ByteString, TrailChar)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
bs,TrailChar
TrailCharComma)
      | Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
newline -> Parser Word8
A.anyWord8 Parser Word8
-> Parser (ByteString, TrailChar) -> Parser (ByteString, TrailChar)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ByteString, TrailChar) -> Parser (ByteString, TrailChar)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
bs,TrailChar
TrailCharNewline)
      | Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
cr -> do
          Word8
_ <- Parser Word8
A.anyWord8
          Word8
_ <- Word8 -> Parser Word8
A.word8 Word8
newline
          (ByteString, TrailChar) -> Parser (ByteString, TrailChar)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
bs,TrailChar
TrailCharNewline)
      | Bool
otherwise -> String -> Parser (ByteString, TrailChar)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"encountered double quote in unescaped field"
    Maybe Word8
Nothing -> (ByteString, TrailChar) -> Parser (ByteString, TrailChar)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
bs,TrailChar
TrailCharEnd)

dquote :: AL.Parser Char
dquote :: Parser Char
dquote = Char -> Parser Char
char Char
'"'

-- | This could be improved. We could avoid the builder and just
-- write to a buffer directly.
unescape :: Z.Parser S.ByteString
unescape :: Parser ByteString
unescape = (ByteString -> ByteString
LByteString.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString) (Builder -> ByteString)
-> ZeptoT Identity Builder -> Parser ByteString
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Builder -> ZeptoT Identity Builder
forall (m :: * -> *). Monad m => Builder -> ZeptoT m Builder
go Builder
forall a. Monoid a => a
mempty where
  go :: Builder -> ZeptoT m Builder
go Builder
acc = do
    ByteString
h <- (Word8 -> Bool) -> ZeptoT m ByteString
forall (m :: * -> *).
Monad m =>
(Word8 -> Bool) -> ZeptoT m ByteString
Z.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
doubleQuote)
    let rest :: ZeptoT m Builder
rest = do
          ByteString
start <- Int -> ZeptoT m ByteString
forall (m :: * -> *). Monad m => Int -> ZeptoT m ByteString
Z.take Int
2
          if (ByteString -> Word8
S.unsafeHead ByteString
start Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
doubleQuote Bool -> Bool -> Bool
&&
              ByteString -> Int -> Word8
S.unsafeIndex ByteString
start Int
1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
doubleQuote)
              then Builder -> ZeptoT m Builder
go (Builder
acc Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` ByteString -> Builder
byteString ByteString
h Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` ByteString -> Builder
byteString (Char -> ByteString
BC8.singleton Char
'"'))
              else String -> ZeptoT m Builder
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid CSV escape sequence"
    Bool
done <- ZeptoT m Bool
forall (m :: * -> *). Monad m => ZeptoT m Bool
Z.atEnd
    if Bool
done
      then Builder -> ZeptoT m Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder
acc Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` ByteString -> Builder
byteString ByteString
h)
      else ZeptoT m Builder
rest

-- | Is this an empty record (i.e. a blank line)?
blankLine :: V.Vector B.ByteString -> Bool
blankLine :: Vector ByteString -> Bool
blankLine Vector ByteString
v = Vector ByteString -> Int
forall a. Vector a -> Int
V.length Vector ByteString
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& (ByteString -> Bool
B.null (Vector ByteString -> ByteString
forall a. Vector a -> a
V.head Vector ByteString
v))

doubleQuote, newline, cr, comma :: Word8
doubleQuote :: Word8
doubleQuote = Word8
34
newline :: Word8
newline = Word8
10
cr :: Word8
cr = Word8
13
comma :: Word8
comma = Word8
44

-- | This adds one to the index because text editors consider
--   line number to be one-based, not zero-based.
humanizeSiphonError :: SiphonError -> String
humanizeSiphonError :: SiphonError -> String
humanizeSiphonError (SiphonError Int
ix RowError
e) = [String] -> String
unlines
  ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String
"Decolonnade error on line " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" of file.")
  String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String
"Error Category: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
descr)
  String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"  " String -> ShowS
forall a. [a] -> [a] -> [a]
++) [String]
errDescrs
  where (String
descr,[String]
errDescrs) = RowError -> (String, [String])
prettyRowError RowError
e

prettyRowError :: RowError -> (String, [String])
prettyRowError :: RowError -> (String, [String])
prettyRowError RowError
x = case RowError
x of
  RowError
RowErrorParse -> (,) String
"CSV Parsing"
    [ String
"The cells were malformed."
    ]
  RowErrorSize Int
reqLen Int
actualLen -> (,) String
"Row Length"
    [ String
"Expected the row to have exactly " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
reqLen String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" cells."
    , String
"The row only has " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
actualLen String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" cells."
    ]
  RowErrorHeaderSize Int
reqLen Int
actualLen -> (,) String
"Minimum Header Length"
    [ String
"Expected the row to have at least " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
reqLen String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" cells."
    , String
"The row only has " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
actualLen String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" cells."
    ]
  RowErrorMalformed Int
column -> (,) String
"Text Decolonnade"
    [ String
"Tried to decode input input in column " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
columnNumToLetters Int
column String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" text"
    , String
"There is a mistake in the encoding of the text."
    ]
  RowErrorHeaders Vector (Vector CellError)
dupErrs Vector Text
namedErrs Vector Int
unnamedErrs -> (,) String
"Missing Headers" ([String] -> (String, [String])) -> [String] -> (String, [String])
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ if Vector Text -> Int
forall a. Vector a -> Int
V.length Vector Text
namedErrs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Vector Text -> [String]
prettyNamedMissingHeaders Vector Text
namedErrs else []
    , if Vector Int -> Int
forall a. Vector a -> Int
V.length Vector Int
unnamedErrs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then [String
"Missing unnamed headers"] else []
    , if Vector (Vector CellError) -> Int
forall a. Vector a -> Int
V.length Vector (Vector CellError)
dupErrs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Vector (Vector CellError) -> [String]
prettyHeadingErrors Vector (Vector CellError)
dupErrs else []
    ]
  RowErrorDecode Vector CellError
errs -> (,) String
"Cell Decolonnade" (Vector CellError -> [String]
prettyCellErrors Vector CellError
errs)

prettyCellErrors :: Vector CellError -> [String]
prettyCellErrors :: Vector CellError -> [String]
prettyCellErrors Vector CellError
errs = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
  ((CellError -> [String]) -> Vector CellError -> [String])
-> Vector CellError -> (CellError -> [String]) -> [String]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (CellError -> [String]) -> Vector CellError -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Vector CellError
errs ((CellError -> [String]) -> [String])
-> (CellError -> [String]) -> [String]
forall a b. (a -> b) -> a -> b
$ \(CellError Int
ix Text
content) ->
    let str :: String
str = Text -> String
T.unpack Text
content in
    [ String
"-----------"
    , String
"Column " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
columnNumToLetters Int
ix
    , String
"Cell Content Length: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length String
str)
    , String
"Cell Content: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str
        then String
"[empty cell]"
        else String
str
    ]

prettyNamedMissingHeaders :: Vector T.Text -> [String]
prettyNamedMissingHeaders :: Vector Text -> [String]
prettyNamedMissingHeaders Vector Text
missing = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ (Text -> [String]) -> Vector Text -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Text
h -> [String
"The header " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
h String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" was missing."]) Vector Text
missing
  ]

prettyHeadingErrors :: Vector (Vector CellError) -> [String]
prettyHeadingErrors :: Vector (Vector CellError) -> [String]
prettyHeadingErrors Vector (Vector CellError)
missing = [[String]] -> [String]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Vector [String] -> [[String]]
forall a. Vector a -> [a]
V.toList ((Vector CellError -> [String])
-> Vector (Vector CellError) -> Vector [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector CellError -> [String]
f Vector (Vector CellError)
missing))
  where
  f :: Vector CellError -> [String]
  f :: Vector CellError -> [String]
f Vector CellError
v
    | Bool -> Bool
not (Vector Text -> Bool
forall a. Vector a -> Bool
V.null Vector Text
w) Bool -> Bool -> Bool
&& (Text -> Bool) -> Vector Text -> Bool
forall a. (a -> Bool) -> Vector a -> Bool
V.all (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Vector Text -> Text
forall a. Vector a -> a
V.head Vector Text
w) (Vector Text -> Vector Text
forall a. Vector a -> Vector a
V.tail Vector Text
w) =
        [ String
"The header ["
        , Text -> String
T.unpack (Vector Text -> Text
forall a. Vector a -> a
V.head Vector Text
w)
        , String
"] appears in columns "
        , String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
", " (Vector String -> [String]
forall a. Vector a -> [a]
V.toList ((CellError -> String) -> Vector CellError -> Vector String
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\(CellError Int
ix Text
_) -> Int -> String
columnNumToLetters Int
ix) Vector CellError
v))
        ]
    | Bool
otherwise = String
multiMsg String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Vector String -> [String]
forall a. Vector a -> [a]
V.toList
        ((CellError -> String) -> Vector CellError -> Vector String
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\(CellError Int
ix Text
content) -> String
"  Column " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
columnNumToLetters Int
ix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
content) Vector CellError
v)
    where
    w :: Vector T.Text
    w :: Vector Text
w = (CellError -> Text) -> Vector CellError -> Vector Text
forall a b. (a -> b) -> Vector a -> Vector b
V.map CellError -> Text
cellErrorContent Vector CellError
v
    multiMsg :: String
    multiMsg :: String
multiMsg = String
"Multiple headers matched the same predicate:"

columnNumToLetters :: Int -> String
columnNumToLetters :: Int -> String
columnNumToLetters Int
i
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
25 = [Int -> Char
chr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
65)]
  | Bool
otherwise = String
"Beyond Z. Fix this."

newtype EitherWrap a b = EitherWrap
  { EitherWrap a b -> Either a b
getEitherWrap :: Either a b
  } deriving (a -> EitherWrap a b -> EitherWrap a a
(a -> b) -> EitherWrap a a -> EitherWrap a b
(forall a b. (a -> b) -> EitherWrap a a -> EitherWrap a b)
-> (forall a b. a -> EitherWrap a b -> EitherWrap a a)
-> Functor (EitherWrap a)
forall a b. a -> EitherWrap a b -> EitherWrap a a
forall a b. (a -> b) -> EitherWrap a a -> EitherWrap a b
forall a a b. a -> EitherWrap a b -> EitherWrap a a
forall a a b. (a -> b) -> EitherWrap a a -> EitherWrap a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> EitherWrap a b -> EitherWrap a a
$c<$ :: forall a a b. a -> EitherWrap a b -> EitherWrap a a
fmap :: (a -> b) -> EitherWrap a a -> EitherWrap a b
$cfmap :: forall a a b. (a -> b) -> EitherWrap a a -> EitherWrap a b
Functor)

instance Monoid a => Applicative (EitherWrap a) where
  pure :: a -> EitherWrap a a
pure = Either a a -> EitherWrap a a
forall a b. Either a b -> EitherWrap a b
EitherWrap (Either a a -> EitherWrap a a)
-> (a -> Either a a) -> a -> EitherWrap a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a a
forall a b. b -> Either a b
Right
  EitherWrap (Left a
a1) <*> :: EitherWrap a (a -> b) -> EitherWrap a a -> EitherWrap a b
<*> EitherWrap (Left a
a2) = Either a b -> EitherWrap a b
forall a b. Either a b -> EitherWrap a b
EitherWrap (a -> Either a b
forall a b. a -> Either a b
Left (a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
a1 a
a2))
  EitherWrap (Left a
a1) <*> EitherWrap (Right a
_) = Either a b -> EitherWrap a b
forall a b. Either a b -> EitherWrap a b
EitherWrap (a -> Either a b
forall a b. a -> Either a b
Left a
a1)
  EitherWrap (Right a -> b
_) <*> EitherWrap (Left a
a2) = Either a b -> EitherWrap a b
forall a b. Either a b -> EitherWrap a b
EitherWrap (a -> Either a b
forall a b. a -> Either a b
Left a
a2)
  EitherWrap (Right a -> b
f) <*> EitherWrap (Right a
b) = Either a b -> EitherWrap a b
forall a b. Either a b -> EitherWrap a b
EitherWrap (b -> Either a b
forall a b. b -> Either a b
Right (a -> b
f a
b))

mapLeft :: (a -> b) -> Either a c -> Either b c
mapLeft :: (a -> b) -> Either a c -> Either b c
mapLeft a -> b
_ (Right c
a) = c -> Either b c
forall a b. b -> Either a b
Right c
a
mapLeft a -> b
f (Left a
a) = b -> Either b c
forall a b. a -> Either a b
Left (a -> b
f a
a)

consumeHeaderRowUtf8 :: Monad m
  => Stream (Of ByteString) m ()
  -> m (Either SiphonError (Of (Vector ByteString) (Stream (Of ByteString) m ())))
consumeHeaderRowUtf8 :: Stream (Of ByteString) m ()
-> m (Either
        SiphonError (Of (Vector ByteString) (Stream (Of ByteString) m ())))
consumeHeaderRowUtf8 = (ByteString -> IResult ByteString (CellResult ByteString))
-> (ByteString -> Bool)
-> ByteString
-> (() -> Bool)
-> Stream (Of ByteString) m ()
-> m (Either
        SiphonError (Of (Vector ByteString) (Stream (Of ByteString) m ())))
forall (m :: * -> *) r c.
Monad m =>
(c -> IResult c (CellResult c))
-> (c -> Bool)
-> c
-> (r -> Bool)
-> Stream (Of c) m r
-> m (Either SiphonError (Of (Vector c) (Stream (Of c) m r)))
consumeHeaderRow (Parser (CellResult ByteString)
-> ByteString -> IResult ByteString (CellResult ByteString)
forall a. Parser a -> ByteString -> Result a
A.parse (Word8 -> Parser (CellResult ByteString)
field Word8
comma)) ByteString -> Bool
B.null ByteString
B.empty (\() -> Bool
True)

consumeBodyUtf8 :: forall m a. Monad m
  => Int -- ^ index of first row, usually zero or one
  -> Int -- ^ Required row length
  -> Siphon IndexedHeader ByteString a
  -> Stream (Of ByteString) m ()
  -> Stream (Of a) m (Maybe SiphonError)
consumeBodyUtf8 :: Int
-> Int
-> Siphon IndexedHeader ByteString a
-> Stream (Of ByteString) m ()
-> Stream (Of a) m (Maybe SiphonError)
consumeBodyUtf8 = (ByteString -> Text)
-> (ByteString -> IResult ByteString (CellResult ByteString))
-> (ByteString -> Bool)
-> ByteString
-> (() -> Bool)
-> Int
-> Int
-> Siphon IndexedHeader ByteString a
-> Stream (Of ByteString) m ()
-> Stream (Of a) m (Maybe SiphonError)
forall (m :: * -> *) r c a.
Monad m =>
(c -> Text)
-> (c -> IResult c (CellResult c))
-> (c -> Bool)
-> c
-> (r -> Bool)
-> Int
-> Int
-> Siphon IndexedHeader c a
-> Stream (Of c) m r
-> Stream (Of a) m (Maybe SiphonError)
consumeBody ByteString -> Text
utf8ToStr
  (Parser (CellResult ByteString)
-> ByteString -> IResult ByteString (CellResult ByteString)
forall a. Parser a -> ByteString -> Result a
A.parse (Word8 -> Parser (CellResult ByteString)
field Word8
comma)) ByteString -> Bool
B.null ByteString
B.empty (\() -> Bool
True)

utf8ToStr :: ByteString -> T.Text
utf8ToStr :: ByteString -> Text
utf8ToStr = (UnicodeException -> Text)
-> (Text -> Text) -> Either UnicodeException Text -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\UnicodeException
_ -> Text
T.empty) Text -> Text
forall a. a -> a
id (Either UnicodeException Text -> Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
decodeUtf8'

consumeHeaderRow :: forall m r c. Monad m
  => (c -> ATYP.IResult c (CellResult c))
  -> (c -> Bool) -- ^ true if null string
  -> c
  -> (r -> Bool) -- ^ true if termination is acceptable
  -> Stream (Of c) m r
  -> m (Either SiphonError (Of (Vector c) (Stream (Of c) m r)))
consumeHeaderRow :: (c -> IResult c (CellResult c))
-> (c -> Bool)
-> c
-> (r -> Bool)
-> Stream (Of c) m r
-> m (Either SiphonError (Of (Vector c) (Stream (Of c) m r)))
consumeHeaderRow c -> IResult c (CellResult c)
parseCell c -> Bool
isNull c
emptyStr r -> Bool
isGood Stream (Of c) m r
s0 = Int
-> StrictList c
-> Stream (Of c) m r
-> m (Either SiphonError (Of (Vector c) (Stream (Of c) m r)))
go Int
0 StrictList c
forall a. StrictList a
StrictListNil Stream (Of c) m r
s0
  where
  go :: Int
     -> StrictList c
     -> Stream (Of c) m r
     -> m (Either SiphonError (Of (Vector c) (Stream (Of c) m r)))
  go :: Int
-> StrictList c
-> Stream (Of c) m r
-> m (Either SiphonError (Of (Vector c) (Stream (Of c) m r)))
go !Int
cellsLen !StrictList c
cells !Stream (Of c) m r
s1 = do
    Either r (Of c (Stream (Of c) m r))
e <- (c -> Bool)
-> Stream (Of c) m r -> m (Either r (Of c (Stream (Of c) m r)))
forall (m :: * -> *) a r.
Monad m =>
(a -> Bool)
-> Stream (Of a) m r -> m (Either r (Of a (Stream (Of a) m r)))
skipWhile c -> Bool
isNull Stream (Of c) m r
s1
    case Either r (Of c (Stream (Of c) m r))
e of
      Left r
r -> Either SiphonError (Of (Vector c) (Stream (Of c) m r))
-> m (Either SiphonError (Of (Vector c) (Stream (Of c) m r)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SiphonError (Of (Vector c) (Stream (Of c) m r))
 -> m (Either SiphonError (Of (Vector c) (Stream (Of c) m r))))
-> Either SiphonError (Of (Vector c) (Stream (Of c) m r))
-> m (Either SiphonError (Of (Vector c) (Stream (Of c) m r)))
forall a b. (a -> b) -> a -> b
$ if r -> Bool
isGood r
r
        then Of (Vector c) (Stream (Of c) m r)
-> Either SiphonError (Of (Vector c) (Stream (Of c) m r))
forall a b. b -> Either a b
Right (Int -> StrictList c -> Vector c
forall c. Int -> StrictList c -> Vector c
reverseVectorStrictList Int
cellsLen StrictList c
cells Vector c -> Stream (Of c) m r -> Of (Vector c) (Stream (Of c) m r)
forall a b. a -> b -> Of a b
:> r -> Stream (Of c) m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r)
        else SiphonError
-> Either SiphonError (Of (Vector c) (Stream (Of c) m r))
forall a b. a -> Either a b
Left (Int -> RowError -> SiphonError
SiphonError Int
0 RowError
RowErrorParse)
      Right (c
c :> Stream (Of c) m r
s2) -> Int
-> StrictList c
-> IResult c (CellResult c)
-> Stream (Of c) m r
-> m (Either SiphonError (Of (Vector c) (Stream (Of c) m r)))
handleResult Int
cellsLen StrictList c
cells (c -> IResult c (CellResult c)
parseCell c
c) Stream (Of c) m r
s2
  handleResult :: Int -> StrictList c 
               -> ATYP.IResult c (CellResult c)
               -> Stream (Of c) m r
               -> m (Either SiphonError (Of (Vector c) (Stream (Of c) m r)))
  handleResult :: Int
-> StrictList c
-> IResult c (CellResult c)
-> Stream (Of c) m r
-> m (Either SiphonError (Of (Vector c) (Stream (Of c) m r)))
handleResult !Int
cellsLen !StrictList c
cells !IResult c (CellResult c)
result Stream (Of c) m r
s1 = case IResult c (CellResult c)
result of
    ATYP.Fail c
_ [String]
_ String
_ -> Either SiphonError (Of (Vector c) (Stream (Of c) m r))
-> m (Either SiphonError (Of (Vector c) (Stream (Of c) m r)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SiphonError (Of (Vector c) (Stream (Of c) m r))
 -> m (Either SiphonError (Of (Vector c) (Stream (Of c) m r))))
-> Either SiphonError (Of (Vector c) (Stream (Of c) m r))
-> m (Either SiphonError (Of (Vector c) (Stream (Of c) m r)))
forall a b. (a -> b) -> a -> b
$ SiphonError
-> Either SiphonError (Of (Vector c) (Stream (Of c) m r))
forall a b. a -> Either a b
Left (SiphonError
 -> Either SiphonError (Of (Vector c) (Stream (Of c) m r)))
-> SiphonError
-> Either SiphonError (Of (Vector c) (Stream (Of c) m r))
forall a b. (a -> b) -> a -> b
$ Int -> RowError -> SiphonError
SiphonError Int
0 RowError
RowErrorParse
    ATYP.Done !c
c1 !CellResult c
res -> case CellResult c
res of
      -- it might be wrong to ignore whether or not the stream has ended
      CellResultNewline c
cd Ended
_ -> do
        let v :: Vector c
v = Int -> StrictList c -> Vector c
forall c. Int -> StrictList c -> Vector c
reverseVectorStrictList (Int
cellsLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (c -> StrictList c -> StrictList c
forall a. a -> StrictList a -> StrictList a
StrictListCons c
cd StrictList c
cells)
        Either SiphonError (Of (Vector c) (Stream (Of c) m r))
-> m (Either SiphonError (Of (Vector c) (Stream (Of c) m r)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Of (Vector c) (Stream (Of c) m r)
-> Either SiphonError (Of (Vector c) (Stream (Of c) m r))
forall a b. b -> Either a b
Right (Vector c
v Vector c -> Stream (Of c) m r -> Of (Vector c) (Stream (Of c) m r)
forall a b. a -> b -> Of a b
:> (c -> Stream (Of c) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
SMP.yield c
c1 Stream (Of c) m () -> Stream (Of c) m r -> Stream (Of c) m r
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Stream (Of c) m r
s1)))
      CellResultData !c
cd -> if c -> Bool
isNull c
c1
        then Int
-> StrictList c
-> Stream (Of c) m r
-> m (Either SiphonError (Of (Vector c) (Stream (Of c) m r)))
go (Int
cellsLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (c -> StrictList c -> StrictList c
forall a. a -> StrictList a -> StrictList a
StrictListCons c
cd StrictList c
cells) Stream (Of c) m r
s1
        else Int
-> StrictList c
-> IResult c (CellResult c)
-> Stream (Of c) m r
-> m (Either SiphonError (Of (Vector c) (Stream (Of c) m r)))
handleResult (Int
cellsLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (c -> StrictList c -> StrictList c
forall a. a -> StrictList a -> StrictList a
StrictListCons c
cd StrictList c
cells) (c -> IResult c (CellResult c)
parseCell c
c1) Stream (Of c) m r
s1
    ATYP.Partial c -> IResult c (CellResult c)
k -> do
      Either r (Of c (Stream (Of c) m r))
e <- (c -> Bool)
-> Stream (Of c) m r -> m (Either r (Of c (Stream (Of c) m r)))
forall (m :: * -> *) a r.
Monad m =>
(a -> Bool)
-> Stream (Of a) m r -> m (Either r (Of a (Stream (Of a) m r)))
skipWhile c -> Bool
isNull Stream (Of c) m r
s1
      case Either r (Of c (Stream (Of c) m r))
e of
        Left r
r -> Int
-> StrictList c
-> IResult c (CellResult c)
-> Stream (Of c) m r
-> m (Either SiphonError (Of (Vector c) (Stream (Of c) m r)))
handleResult Int
cellsLen StrictList c
cells (c -> IResult c (CellResult c)
k c
emptyStr) (r -> Stream (Of c) m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r)
        Right (c
c1 :> Stream (Of c) m r
s2) -> Int
-> StrictList c
-> IResult c (CellResult c)
-> Stream (Of c) m r
-> m (Either SiphonError (Of (Vector c) (Stream (Of c) m r)))
handleResult Int
cellsLen StrictList c
cells (c -> IResult c (CellResult c)
k c
c1) Stream (Of c) m r
s2

consumeBody :: forall m r c a. Monad m
  => (c -> T.Text)
  -> (c -> ATYP.IResult c (CellResult c))
  -> (c -> Bool)
  -> c
  -> (r -> Bool) -- ^ True if termination is acceptable. False if it is because of a decoding error.
  -> Int -- ^ index of first row, usually zero or one
  -> Int -- ^ Required row length
  -> Siphon IndexedHeader c a
  -> Stream (Of c) m r
  -> Stream (Of a) m (Maybe SiphonError)
consumeBody :: (c -> Text)
-> (c -> IResult c (CellResult c))
-> (c -> Bool)
-> c
-> (r -> Bool)
-> Int
-> Int
-> Siphon IndexedHeader c a
-> Stream (Of c) m r
-> Stream (Of a) m (Maybe SiphonError)
consumeBody c -> Text
toStr c -> IResult c (CellResult c)
parseCell c -> Bool
isNull c
emptyStr r -> Bool
isGood Int
row0 Int
reqLen Siphon IndexedHeader c a
siphon Stream (Of c) m r
s0 =
  Int
-> Int
-> StrictList c
-> Stream (Of c) m r
-> Stream (Of a) m (Maybe SiphonError)
go Int
row0 Int
0 StrictList c
forall a. StrictList a
StrictListNil Stream (Of c) m r
s0
  where
  go :: Int -> Int -> StrictList c -> Stream (Of c) m r -> Stream (Of a) m (Maybe SiphonError)
  go :: Int
-> Int
-> StrictList c
-> Stream (Of c) m r
-> Stream (Of a) m (Maybe SiphonError)
go !Int
row !Int
cellsLen !StrictList c
cells !Stream (Of c) m r
s1 = do
    Either r (Of c (Stream (Of c) m r))
e <- m (Either r (Of c (Stream (Of c) m r)))
-> Stream (Of a) m (Either r (Of c (Stream (Of c) m r)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((c -> Bool)
-> Stream (Of c) m r -> m (Either r (Of c (Stream (Of c) m r)))
forall (m :: * -> *) a r.
Monad m =>
(a -> Bool)
-> Stream (Of a) m r -> m (Either r (Of a (Stream (Of a) m r)))
skipWhile c -> Bool
isNull Stream (Of c) m r
s1)
    case Either r (Of c (Stream (Of c) m r))
e of
      Left r
r -> Maybe SiphonError -> Stream (Of a) m (Maybe SiphonError)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SiphonError -> Stream (Of a) m (Maybe SiphonError))
-> Maybe SiphonError -> Stream (Of a) m (Maybe SiphonError)
forall a b. (a -> b) -> a -> b
$ if r -> Bool
isGood r
r
        then Maybe SiphonError
forall a. Maybe a
Nothing
        else SiphonError -> Maybe SiphonError
forall a. a -> Maybe a
Just (Int -> RowError -> SiphonError
SiphonError Int
row RowError
RowErrorParse)
      Right (c
c :> Stream (Of c) m r
s2) -> Int
-> Int
-> StrictList c
-> IResult c (CellResult c)
-> Stream (Of c) m r
-> Stream (Of a) m (Maybe SiphonError)
handleResult Int
row Int
cellsLen StrictList c
cells (c -> IResult c (CellResult c)
parseCell c
c) Stream (Of c) m r
s2
  handleResult :: Int -> Int -> StrictList c 
               -> ATYP.IResult c (CellResult c)
               -> Stream (Of c) m r
               -> Stream (Of a) m (Maybe SiphonError)
  handleResult :: Int
-> Int
-> StrictList c
-> IResult c (CellResult c)
-> Stream (Of c) m r
-> Stream (Of a) m (Maybe SiphonError)
handleResult !Int
row !Int
cellsLen !StrictList c
cells !IResult c (CellResult c)
result Stream (Of c) m r
s1 = case IResult c (CellResult c)
result of
    ATYP.Fail c
_ [String]
_ String
_ -> Maybe SiphonError -> Stream (Of a) m (Maybe SiphonError)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SiphonError -> Stream (Of a) m (Maybe SiphonError))
-> Maybe SiphonError -> Stream (Of a) m (Maybe SiphonError)
forall a b. (a -> b) -> a -> b
$ SiphonError -> Maybe SiphonError
forall a. a -> Maybe a
Just (SiphonError -> Maybe SiphonError)
-> SiphonError -> Maybe SiphonError
forall a b. (a -> b) -> a -> b
$ Int -> RowError -> SiphonError
SiphonError Int
row RowError
RowErrorParse
    ATYP.Done !c
c1 !CellResult c
res -> case CellResult c
res of
      CellResultNewline !c
cd !Ended
ended -> do
        case Int -> Vector c -> Either SiphonError a
decodeRow Int
row (Int -> StrictList c -> Vector c
forall c. Int -> StrictList c -> Vector c
reverseVectorStrictList (Int
cellsLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (c -> StrictList c -> StrictList c
forall a. a -> StrictList a -> StrictList a
StrictListCons c
cd StrictList c
cells)) of
          Left SiphonError
err -> Maybe SiphonError -> Stream (Of a) m (Maybe SiphonError)
forall (m :: * -> *) a. Monad m => a -> m a
return (SiphonError -> Maybe SiphonError
forall a. a -> Maybe a
Just SiphonError
err)
          Right a
a -> do
            a -> Stream (Of a) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
SMP.yield a
a
            case Ended
ended of
              Ended
EndedYes -> do
                Either r (Of c (Stream (Of c) m r))
e <- m (Either r (Of c (Stream (Of c) m r)))
-> Stream (Of a) m (Either r (Of c (Stream (Of c) m r)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Stream (Of c) m r -> m (Either r (Of c (Stream (Of c) m r)))
forall (m :: * -> *) (f :: * -> *) r.
Monad m =>
Stream f m r -> m (Either r (f (Stream f m r)))
SM.inspect Stream (Of c) m r
s1)
                case Either r (Of c (Stream (Of c) m r))
e of
                  Left r
r -> Maybe SiphonError -> Stream (Of a) m (Maybe SiphonError)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SiphonError -> Stream (Of a) m (Maybe SiphonError))
-> Maybe SiphonError -> Stream (Of a) m (Maybe SiphonError)
forall a b. (a -> b) -> a -> b
$ if r -> Bool
isGood r
r
                    then Maybe SiphonError
forall a. Maybe a
Nothing
                    else SiphonError -> Maybe SiphonError
forall a. a -> Maybe a
Just (Int -> RowError -> SiphonError
SiphonError Int
row RowError
RowErrorParse)
                  Right Of c (Stream (Of c) m r)
_ -> String -> Stream (Of a) m (Maybe SiphonError)
forall a. HasCallStack => String -> a
error String
"siphon: logical error, stream should be exhausted"
              Ended
EndedNo -> if c -> Bool
isNull c
c1 
                then Int
-> Int
-> StrictList c
-> Stream (Of c) m r
-> Stream (Of a) m (Maybe SiphonError)
go (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0 StrictList c
forall a. StrictList a
StrictListNil Stream (Of c) m r
s1
                else Int
-> Int
-> StrictList c
-> IResult c (CellResult c)
-> Stream (Of c) m r
-> Stream (Of a) m (Maybe SiphonError)
handleResult (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0 StrictList c
forall a. StrictList a
StrictListNil (c -> IResult c (CellResult c)
parseCell c
c1) Stream (Of c) m r
s1
      CellResultData !c
cd -> if c -> Bool
isNull c
c1
        then Int
-> Int
-> StrictList c
-> Stream (Of c) m r
-> Stream (Of a) m (Maybe SiphonError)
go Int
row (Int
cellsLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (c -> StrictList c -> StrictList c
forall a. a -> StrictList a -> StrictList a
StrictListCons c
cd StrictList c
cells) Stream (Of c) m r
s1
        else Int
-> Int
-> StrictList c
-> IResult c (CellResult c)
-> Stream (Of c) m r
-> Stream (Of a) m (Maybe SiphonError)
handleResult Int
row (Int
cellsLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (c -> StrictList c -> StrictList c
forall a. a -> StrictList a -> StrictList a
StrictListCons c
cd StrictList c
cells) (c -> IResult c (CellResult c)
parseCell c
c1) Stream (Of c) m r
s1
    ATYP.Partial c -> IResult c (CellResult c)
k -> do
      Either r (Of c (Stream (Of c) m r))
e <- m (Either r (Of c (Stream (Of c) m r)))
-> Stream (Of a) m (Either r (Of c (Stream (Of c) m r)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((c -> Bool)
-> Stream (Of c) m r -> m (Either r (Of c (Stream (Of c) m r)))
forall (m :: * -> *) a r.
Monad m =>
(a -> Bool)
-> Stream (Of a) m r -> m (Either r (Of a (Stream (Of a) m r)))
skipWhile c -> Bool
isNull Stream (Of c) m r
s1)
      case Either r (Of c (Stream (Of c) m r))
e of
        Left r
r -> Int
-> Int
-> StrictList c
-> IResult c (CellResult c)
-> Stream (Of c) m r
-> Stream (Of a) m (Maybe SiphonError)
handleResult Int
row Int
cellsLen StrictList c
cells (c -> IResult c (CellResult c)
k c
emptyStr) (r -> Stream (Of c) m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r)
        Right (c
c1 :> Stream (Of c) m r
s2) -> Int
-> Int
-> StrictList c
-> IResult c (CellResult c)
-> Stream (Of c) m r
-> Stream (Of a) m (Maybe SiphonError)
handleResult Int
row Int
cellsLen StrictList c
cells (c -> IResult c (CellResult c)
k c
c1) Stream (Of c) m r
s2
  decodeRow :: Int -> Vector c -> Either SiphonError a
  decodeRow :: Int -> Vector c -> Either SiphonError a
decodeRow Int
rowIx Vector c
v =
    let vlen :: Int
vlen = Vector c -> Int
forall a. Vector a -> Int
V.length Vector c
v in
    if Int
vlen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
reqLen
      then SiphonError -> Either SiphonError a
forall a b. a -> Either a b
Left (SiphonError -> Either SiphonError a)
-> SiphonError -> Either SiphonError a
forall a b. (a -> b) -> a -> b
$ Int -> RowError -> SiphonError
SiphonError Int
rowIx (RowError -> SiphonError) -> RowError -> SiphonError
forall a b. (a -> b) -> a -> b
$ Int -> Int -> RowError
RowErrorSize Int
reqLen Int
vlen
      else (c -> Text)
-> Int
-> Siphon IndexedHeader c a
-> Vector c
-> Either SiphonError a
forall c a.
(c -> Text)
-> Int
-> Siphon IndexedHeader c a
-> Vector c
-> Either SiphonError a
uncheckedRunWithRow c -> Text
toStr Int
rowIx Siphon IndexedHeader c a
siphon Vector c
v

-- | You must pass the length of the list and as the first argument.
--   Passing the wrong length will lead to an error.
reverseVectorStrictList :: forall c. Int -> StrictList c -> Vector c
reverseVectorStrictList :: Int -> StrictList c -> Vector c
reverseVectorStrictList Int
len StrictList c
sl0 = (forall s. ST s (MVector s c)) -> Vector c
forall a. (forall s. ST s (MVector s a)) -> Vector a
V.create ((forall s. ST s (MVector s c)) -> Vector c)
-> (forall s. ST s (MVector s c)) -> Vector c
forall a b. (a -> b) -> a -> b
$ do
  MVector s c
mv <- Int -> ST s (MVector (PrimState (ST s)) c)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
MV.new Int
len
  MVector s c -> ST s ()
forall s. MVector s c -> ST s ()
go1 MVector s c
mv
  MVector s c -> ST s (MVector s c)
forall (m :: * -> *) a. Monad m => a -> m a
return MVector s c
mv
  where
  go1 :: forall s. MVector s c -> ST s ()
  go1 :: MVector s c -> ST s ()
go1 !MVector s c
mv = Int -> StrictList c -> ST s ()
go2 Int
0 StrictList c
sl0
    where
    go2 :: Int -> StrictList c -> ST s ()
    go2 :: Int -> StrictList c -> ST s ()
go2 Int
_ StrictList c
StrictListNil = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go2 !Int
ix (StrictListCons c
c StrictList c
slNext) = do
      MVector (PrimState (ST s)) c -> Int -> c -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.write MVector s c
MVector (PrimState (ST s)) c
mv Int
ix c
c
      Int -> StrictList c -> ST s ()
go2 (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) StrictList c
slNext


skipWhile :: forall m a r. Monad m
  => (a -> Bool)
  -> Stream (Of a) m r
  -> m (Either r (Of a (Stream (Of a) m r)))
skipWhile :: (a -> Bool)
-> Stream (Of a) m r -> m (Either r (Of a (Stream (Of a) m r)))
skipWhile a -> Bool
f = Stream (Of a) m r -> m (Either r (Of a (Stream (Of a) m r)))
go where
  go :: Stream (Of a) m r
     -> m (Either r (Of a (Stream (Of a) m r)))
  go :: Stream (Of a) m r -> m (Either r (Of a (Stream (Of a) m r)))
go Stream (Of a) m r
s1 = do
    Either r (Of a (Stream (Of a) m r))
e <- Stream (Of a) m r -> m (Either r (Of a (Stream (Of a) m r)))
forall (m :: * -> *) (f :: * -> *) r.
Monad m =>
Stream f m r -> m (Either r (f (Stream f m r)))
SM.inspect Stream (Of a) m r
s1
    case Either r (Of a (Stream (Of a) m r))
e of
      Left r
_ -> Either r (Of a (Stream (Of a) m r))
-> m (Either r (Of a (Stream (Of a) m r)))
forall (m :: * -> *) a. Monad m => a -> m a
return Either r (Of a (Stream (Of a) m r))
e
      Right (a
a :> Stream (Of a) m r
s2) -> if a -> Bool
f a
a
        then Stream (Of a) m r -> m (Either r (Of a (Stream (Of a) m r)))
go Stream (Of a) m r
s2
        else Either r (Of a (Stream (Of a) m r))
-> m (Either r (Of a (Stream (Of a) m r)))
forall (m :: * -> *) a. Monad m => a -> m a
return Either r (Of a (Stream (Of a) m r))
e

-- | Strict in the spine and in the values
data StrictList a = StrictListNil | StrictListCons !a !(StrictList a)

-- | This function uses 'unsafeIndex' to access
--   elements of the 'Vector'.
uncheckedRunWithRow ::
     (c -> T.Text)
  -> Int
  -> Siphon IndexedHeader c a
  -> Vector c
  -> Either SiphonError a
uncheckedRunWithRow :: (c -> Text)
-> Int
-> Siphon IndexedHeader c a
-> Vector c
-> Either SiphonError a
uncheckedRunWithRow c -> Text
toStr Int
i Siphon IndexedHeader c a
d Vector c
v =
  (Vector CellError -> SiphonError)
-> Either (Vector CellError) a -> Either SiphonError a
forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft (Int -> RowError -> SiphonError
SiphonError Int
i (RowError -> SiphonError)
-> (Vector CellError -> RowError)
-> Vector CellError
-> SiphonError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector CellError -> RowError
RowErrorDecode) ((c -> Text)
-> Siphon IndexedHeader c a
-> Vector c
-> Either (Vector CellError) a
forall c a.
(c -> Text)
-> Siphon IndexedHeader c a
-> Vector c
-> Either (Vector CellError) a
uncheckedRun c -> Text
toStr Siphon IndexedHeader c a
d Vector c
v)

-- | This function does not check to make sure that the indicies in
--   the 'Decolonnade' are in the 'Vector'. Only use this if you have
--   already verified that none of the indices in the siphon are
--   out of the bounds.
uncheckedRun :: forall c a.
     (c -> T.Text)
  -> Siphon IndexedHeader c a
  -> Vector c
  -> Either (Vector CellError) a
uncheckedRun :: (c -> Text)
-> Siphon IndexedHeader c a
-> Vector c
-> Either (Vector CellError) a
uncheckedRun c -> Text
toStr Siphon IndexedHeader c a
dc Vector c
v = EitherWrap (Vector CellError) a -> Either (Vector CellError) a
forall a b. EitherWrap a b -> Either a b
getEitherWrap (Siphon IndexedHeader c a -> EitherWrap (Vector CellError) a
forall b.
Siphon IndexedHeader c b -> EitherWrap (Vector CellError) b
go Siphon IndexedHeader c a
dc)
  where
  go :: forall b.
        Siphon IndexedHeader c b
     -> EitherWrap (Vector CellError) b
  go :: Siphon IndexedHeader c b -> EitherWrap (Vector CellError) b
go (SiphonPure b
b) = Either (Vector CellError) b -> EitherWrap (Vector CellError) b
forall a b. Either a b -> EitherWrap a b
EitherWrap (b -> Either (Vector CellError) b
forall a b. b -> Either a b
Right b
b)
  go (SiphonAp (IndexedHeader Int
ix c
_) c -> Maybe a
decode Siphon IndexedHeader c (a -> b)
apNext) =
    let rnext :: EitherWrap (Vector CellError) (a -> b)
rnext = Siphon IndexedHeader c (a -> b)
-> EitherWrap (Vector CellError) (a -> b)
forall b.
Siphon IndexedHeader c b -> EitherWrap (Vector CellError) b
go Siphon IndexedHeader c (a -> b)
apNext
        content :: c
content = Vector c
v Vector c -> Int -> c
forall a. Vector a -> Int -> a
V.! Int
ix -- V.unsafeIndex v ix
        rcurrent :: Either (Vector CellError) a
rcurrent = Either (Vector CellError) a
-> (a -> Either (Vector CellError) a)
-> Maybe a
-> Either (Vector CellError) a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (Vector CellError -> Either (Vector CellError) a
forall a b. a -> Either a b
Left (CellError -> Vector CellError
forall a. a -> Vector a
V.singleton (Int -> Text -> CellError
CellError Int
ix (c -> Text
toStr c
content))))
          a -> Either (Vector CellError) a
forall a b. b -> Either a b
Right
          (c -> Maybe a
decode c
content)
    in EitherWrap (Vector CellError) (a -> b)
rnext EitherWrap (Vector CellError) (a -> b)
-> EitherWrap (Vector CellError) a
-> EitherWrap (Vector CellError) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Either (Vector CellError) a -> EitherWrap (Vector CellError) a
forall a b. Either a b -> EitherWrap a b
EitherWrap Either (Vector CellError) a
rcurrent)

siphonLength :: forall f c a. Siphon f c a -> Int
siphonLength :: Siphon f c a -> Int
siphonLength = Int -> Siphon f c a -> Int
forall b. Int -> Siphon f c b -> Int
go Int
0 where
  go :: forall b. Int -> Siphon f c b -> Int
  go :: Int -> Siphon f c b -> Int
go !Int
a (SiphonPure b
_) = Int
a
  go !Int
a (SiphonAp f c
_ c -> Maybe a
_ Siphon f c (a -> b)
apNext) = Int -> Siphon f c (a -> b) -> Int
forall b. Int -> Siphon f c b -> Int
go (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Siphon f c (a -> b)
apNext

maxIndex :: forall c a. Siphon IndexedHeader c a -> Int
maxIndex :: Siphon IndexedHeader c a -> Int
maxIndex = Int -> Siphon IndexedHeader c a -> Int
forall b. Int -> Siphon IndexedHeader c b -> Int
go Int
0 where
  go :: forall b. Int -> Siphon IndexedHeader c b -> Int
  go :: Int -> Siphon IndexedHeader c b -> Int
go !Int
ix (SiphonPure b
_) = Int
ix
  go !Int
ix1 (SiphonAp (IndexedHeader Int
ix2 c
_) c -> Maybe a
_ Siphon IndexedHeader c (a -> b)
apNext) =
    Int -> Siphon IndexedHeader c (a -> b) -> Int
forall b. Int -> Siphon IndexedHeader c b -> Int
go (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
ix1 Int
ix2) Siphon IndexedHeader c (a -> b)
apNext

-- | Uses the argument to parse a CSV column.
headless :: (c -> Maybe a) -> Siphon CE.Headless c a
headless :: (c -> Maybe a) -> Siphon Headless c a
headless c -> Maybe a
f = Headless c
-> (c -> Maybe a)
-> Siphon Headless c (a -> a)
-> Siphon Headless c a
forall (f :: * -> *) c a b.
f c -> (c -> Maybe a) -> Siphon f c (a -> b) -> Siphon f c b
SiphonAp Headless c
forall a. Headless a
CE.Headless c -> Maybe a
f ((a -> a) -> Siphon Headless c (a -> a)
forall a (f :: * -> *) c. a -> Siphon f c a
SiphonPure a -> a
forall a. a -> a
id)

-- | Uses the second argument to parse a CSV column whose 
--   header content matches the first column exactly.
headed :: c -> (c -> Maybe a) -> Siphon CE.Headed c a
headed :: c -> (c -> Maybe a) -> Siphon Headed c a
headed c
h c -> Maybe a
f = Headed c
-> (c -> Maybe a) -> Siphon Headed c (a -> a) -> Siphon Headed c a
forall (f :: * -> *) c a b.
f c -> (c -> Maybe a) -> Siphon f c (a -> b) -> Siphon f c b
SiphonAp (c -> Headed c
forall a. a -> Headed a
CE.Headed c
h) c -> Maybe a
f ((a -> a) -> Siphon Headed c (a -> a)
forall a (f :: * -> *) c. a -> Siphon f c a
SiphonPure a -> a
forall a. a -> a
id)

-- | Uses the second argument to parse a CSV column that
--   is positioned at the index given by the first argument.
indexed :: Int -> (c -> Maybe a) -> Siphon Indexed c a
indexed :: Int -> (c -> Maybe a) -> Siphon Indexed c a
indexed Int
ix c -> Maybe a
f = Indexed c
-> (c -> Maybe a)
-> Siphon Indexed c (a -> a)
-> Siphon Indexed c a
forall (f :: * -> *) c a b.
f c -> (c -> Maybe a) -> Siphon f c (a -> b) -> Siphon f c b
SiphonAp (Int -> Indexed c
forall a. Int -> Indexed a
Indexed Int
ix) c -> Maybe a
f ((a -> a) -> Siphon Indexed c (a -> a)
forall a (f :: * -> *) c. a -> Siphon f c a
SiphonPure a -> a
forall a. a -> a
id)

-- $setup
--
-- This code is copied from the head section. It has to be
-- run before every set of tests.
--
-- >>> :set -XOverloadedStrings
-- >>> import Siphon (Siphon)
-- >>> import Colonnade (Colonnade,Headed)
-- >>> import qualified Siphon as S
-- >>> import qualified Colonnade as C
-- >>> import qualified Data.Text as T
-- >>> import Data.Text (Text)
-- >>> import qualified Data.Text.Lazy.IO as LTIO
-- >>> import qualified Data.Text.Lazy.Builder as LB
-- >>> import Data.Maybe (fromMaybe)
-- >>> data Person = Person { name :: Text, age :: Int, company :: Maybe Text}