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

{- | 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
  , decodeHeadedCsvUtf8
  , decodeIndexedCsvUtf8

    -- * Build Siphon
  , headed
  , headless
  , indexed

    -- * Types
  , Escaped
  , Siphon
  , SiphonError (..)
  , Indexed (..)

    -- * For Testing
  , headedToIndexed

    -- * Utility
  , humanizeSiphonError
  , eqSiphonHeaders
  , showSiphonHeaders

    -- * Imports
    -- $setup
  ) where

import Control.Monad
import Control.Monad.ST
import Control.Monad.Trans.Class
import Data.Attoparsec.ByteString.Char8 (char)
import Data.ByteString (ByteString)
import Data.ByteString.Builder (byteString, toLazyByteString)
import Data.Char (chr)
import Data.Functor.Classes (Eq1, Show1, liftEq, showsPrec1)
import Data.Functor.Identity (Identity (..))
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8')
import Data.Vector (Vector)
import Data.Vector.Mutable (MVector)
import Data.Word (Word8)
import Siphon.Types
import Streaming (Of (..), Stream)

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

newtype Escaped c = Escaped {forall c. 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
$cshowsPrec :: Int -> Ended -> ShowS
showsPrec :: Int -> Ended -> ShowS
$cshow :: Ended -> String
show :: Ended -> String
$cshowList :: [Ended] -> ShowS
showList :: [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
$cshowsPrec :: forall c. Show c => Int -> CellResult c -> ShowS
showsPrec :: Int -> CellResult c -> ShowS
$cshow :: forall c. Show c => CellResult c -> String
show :: CellResult c -> String
$cshowList :: forall c. Show c => [CellResult c] -> ShowS
showList :: [CellResult c] -> ShowS
Show)

-- | Backwards-compatibility alias for 'decodeHeadedCsvUtf8'.
decodeCsvUtf8 ::
  (Monad m) =>
  Siphon CE.Headed ByteString a ->
  -- | encoded csv
  Stream (Of ByteString) m () ->
  Stream (Of a) m (Maybe SiphonError)
decodeCsvUtf8 :: forall (m :: * -> *) a.
Monad m =>
Siphon Headed ByteString a
-> Stream (Of ByteString) m ()
-> Stream (Of a) m (Maybe SiphonError)
decodeCsvUtf8 = Siphon Headed ByteString a
-> Stream (Of ByteString) m ()
-> Stream (Of a) m (Maybe SiphonError)
forall (m :: * -> *) a.
Monad m =>
Siphon Headed ByteString a
-> Stream (Of ByteString) m ()
-> Stream (Of a) m (Maybe SiphonError)
decodeHeadedCsvUtf8

-- | Decode a CSV whose first row is contains headers identify each column.
decodeHeadedCsvUtf8 ::
  (Monad m) =>
  Siphon CE.Headed ByteString a ->
  -- | encoded csv
  Stream (Of ByteString) m () ->
  Stream (Of a) m (Maybe SiphonError)
decodeHeadedCsvUtf8 :: forall (m :: * -> *) a.
Monad m =>
Siphon Headed ByteString a
-> Stream (Of ByteString) m ()
-> Stream (Of a) m (Maybe SiphonError)
decodeHeadedCsvUtf8 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 (m :: * -> *) a. Monad m => m a -> Stream (Of a) m a
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 a. a -> Stream (Of a) m a
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 Indexed ByteString a)
forall c a.
Eq c =>
(c -> Text)
-> Vector c
-> Siphon Headed c a
-> Either SiphonError (Siphon Indexed 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 a. a -> Stream (Of a) m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SiphonError -> Maybe SiphonError
forall a. a -> Maybe a
Just SiphonError
err)
      Right Siphon Indexed ByteString a
ixedSiphon -> do
        let requiredLength :: Int
requiredLength = Vector ByteString -> Int
forall a. Vector a -> Int
V.length Vector ByteString
v
        Int
-> Int
-> Siphon Indexed ByteString a
-> Stream (Of ByteString) m ()
-> Stream (Of a) m (Maybe SiphonError)
forall (m :: * -> *) a.
Monad m =>
Int
-> Int
-> Siphon Indexed ByteString a
-> Stream (Of ByteString) m ()
-> Stream (Of a) m (Maybe SiphonError)
consumeBodyUtf8 Int
1 Int
requiredLength Siphon Indexed ByteString a
ixedSiphon Stream (Of ByteString) m ()
s2

-- | Decode a CSV without a header.
decodeIndexedCsvUtf8 ::
  (Monad m) =>
  -- | How many columns are there? This number should be greater than any indices referenced by the scheme.
  Int ->
  Siphon Indexed ByteString a ->
  -- | encoded csv
  Stream (Of ByteString) m () ->
  Stream (Of a) m (Maybe SiphonError)
decodeIndexedCsvUtf8 :: forall (m :: * -> *) a.
Monad m =>
Int
-> Siphon Indexed ByteString a
-> Stream (Of ByteString) m ()
-> Stream (Of a) m (Maybe SiphonError)
decodeIndexedCsvUtf8 !Int
requiredLength Siphon Indexed ByteString a
ixedSiphon Stream (Of ByteString) m ()
s1 = do
  Int
-> Int
-> Siphon Indexed ByteString a
-> Stream (Of ByteString) m ()
-> Stream (Of a) m (Maybe SiphonError)
forall (m :: * -> *) a.
Monad m =>
Int
-> Int
-> Siphon Indexed ByteString a
-> Stream (Of ByteString) m ()
-> Stream (Of a) m (Maybe SiphonError)
consumeBodyUtf8 Int
0 Int
requiredLength Siphon Indexed ByteString a
ixedSiphon Stream (Of ByteString) m ()
s1

encodeCsvStreamUtf8 ::
  (Monad m, CE.Headedness h) =>
  CE.Colonnade h a ByteString ->
  Stream (Of a) m r ->
  Stream (Of ByteString) m r
encodeCsvStreamUtf8 :: forall (m :: * -> *) (h :: * -> *) a r.
(Monad m, Headedness h) =>
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 :: forall (m :: * -> *) (h :: * -> *) a r.
(Monad m, Headedness h) =>
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) =>
  -- | Tablular encoding
  CE.Colonnade h a Text ->
  -- | Value of each row
  f a ->
  TB.Builder
encodeCsv :: forall (f :: * -> *) (h :: * -> *) a.
(Foldable f, Headedness h) =>
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) =>
  -- | Tablular encoding
  CE.Colonnade h a ByteString ->
  -- | Value of each row
  f a ->
  BB.Builder
encodeCsvUtf8 :: forall (f :: * -> *) (h :: * -> *) a.
(Foldable f, Headedness h) =>
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) ->
  -- | separator
  c ->
  -- | newline
  c ->
  CE.Colonnade h a c ->
  Stream (Of a) m r ->
  Stream (Of c) m r
encodeCsvInternal :: 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 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 a. Maybe (h a -> a)
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 a. a -> Stream (Of c) m a
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) ->
  -- | separator
  c ->
  -- | newline
  c ->
  CE.Colonnade h a c ->
  Stream (Of c) m ()
encodeHeader :: 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 = 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 :: 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 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
a :> x
s) -> Stream (Of b) m x -> m (Stream (Of b) m x)
forall a. a -> m a
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 a b.
Stream (Of b) m a -> Stream (Of b) m b -> Stream (Of b) m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> x -> Stream (Of b) m x
forall a. a -> Stream (Of b) m a
forall (m :: * -> *) a. Monad m => a -> m a
return x
s))

encodeRows ::
  (Monad m) =>
  (c -> Escaped c) ->
  -- | separator
  c ->
  -- | newline
  c ->
  CE.Colonnade f a c ->
  Stream (Of a) m r ->
  Stream (Of c) m r
encodeRows :: 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 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

{- | 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) ->
  -- | Headers in the source document
  Vector c ->
  -- | Decolonnade that contains expected headers
  Siphon CE.Headed c a ->
  Either SiphonError (Siphon Indexed c a)
headedToIndexed :: forall c a.
Eq c =>
(c -> Text)
-> Vector c
-> Siphon Headed c a
-> Either SiphonError (Siphon Indexed c a)
headedToIndexed c -> Text
toStr Vector c
v =
  (HeaderErrors -> SiphonError)
-> Either HeaderErrors (Siphon Indexed c a)
-> Either SiphonError (Siphon Indexed 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 Indexed c a)
 -> Either SiphonError (Siphon Indexed c a))
-> (Siphon Headed c a -> Either HeaderErrors (Siphon Indexed c a))
-> Siphon Headed c a
-> Either SiphonError (Siphon Indexed c a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EitherWrap HeaderErrors (Siphon Indexed c a)
-> Either HeaderErrors (Siphon Indexed c a)
forall a b. EitherWrap a b -> Either a b
getEitherWrap
    (EitherWrap HeaderErrors (Siphon Indexed c a)
 -> Either HeaderErrors (Siphon Indexed c a))
-> (Siphon Headed c a
    -> EitherWrap HeaderErrors (Siphon Indexed c a))
-> Siphon Headed c a
-> Either HeaderErrors (Siphon Indexed c a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Siphon Headed c a -> EitherWrap HeaderErrors (Siphon Indexed c a)
forall b.
Siphon Headed c b -> EitherWrap HeaderErrors (Siphon Indexed c b)
go
 where
  go ::
    forall b.
    Siphon CE.Headed c b ->
    EitherWrap HeaderErrors (Siphon Indexed c b)
  go :: forall b.
Siphon Headed c b -> EitherWrap HeaderErrors (Siphon Indexed c b)
go (SiphonPure b
b) = Either HeaderErrors (Siphon Indexed c b)
-> EitherWrap HeaderErrors (Siphon Indexed c b)
forall a b. Either a b -> EitherWrap a b
EitherWrap (Siphon Indexed c b -> Either HeaderErrors (Siphon Indexed c b)
forall a b. b -> Either a b
Right (b -> Siphon Indexed c b
forall a (f :: * -> *) c. a -> Siphon f c a
SiphonPure b
b))
  go (SiphonAp (CE.Headed c
h) c -> Maybe a1
decode Siphon Headed c (a1 -> b)
apNext) =
    let rnext :: EitherWrap HeaderErrors (Siphon Indexed c (a1 -> b))
rnext = Siphon Headed c (a1 -> b)
-> EitherWrap HeaderErrors (Siphon Indexed c (a1 -> b))
forall b.
Siphon Headed c b -> EitherWrap HeaderErrors (Siphon Indexed c b)
go Siphon Headed c (a1 -> 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)
          | 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 Indexed c (a1 -> b)
nextSiphon -> Indexed c
-> (c -> Maybe a1)
-> Siphon Indexed c (a1 -> b)
-> Siphon Indexed c b
forall (f :: * -> *) c a1 a.
f c -> (c -> Maybe a1) -> Siphon f c (a1 -> a) -> Siphon f c a
SiphonAp (Int -> Indexed c
forall a. Int -> Indexed a
Indexed Int
ix) c -> Maybe a1
decode Siphon Indexed c (a1 -> b)
nextSiphon)
          (Int -> Siphon Indexed c (a1 -> b) -> Siphon Indexed c b)
-> EitherWrap HeaderErrors Int
-> EitherWrap
     HeaderErrors (Siphon Indexed c (a1 -> b) -> Siphon Indexed 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 Indexed c (a1 -> b) -> Siphon Indexed c b)
-> EitherWrap HeaderErrors (Siphon Indexed c (a1 -> b))
-> EitherWrap HeaderErrors (Siphon Indexed c b)
forall a b.
EitherWrap HeaderErrors (a -> b)
-> EitherWrap HeaderErrors a -> EitherWrap HeaderErrors b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EitherWrap HeaderErrors (Siphon Indexed c (a1 -> 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 a. a -> Parser ByteString a
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 a. a -> Parser ByteString a
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 a. a -> Parser ByteString a
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 a. a -> Parser ByteString a
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 a. a -> Parser ByteString a
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 a. a -> Parser ByteString a
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 a. a -> Parser ByteString a
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 a. a -> Parser ByteString a
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 a. a -> Parser ByteString a
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 <-
    HasCallStack => ByteString -> ByteString
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 a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TrailChar -> Parser ByteString TrailChar
forall a. a -> Parser ByteString a
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 a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TrailChar -> Parser ByteString TrailChar
forall a. a -> Parser ByteString a
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 a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return TrailChar
TrailCharNewline
      | Bool
otherwise -> String -> Parser ByteString TrailChar
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"encountered double quote after escaped field"
    Maybe Word8
Nothing -> TrailChar -> Parser ByteString TrailChar
forall a. a -> Parser ByteString a
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 a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
r, TrailChar
trailChar)
      Left String
err -> String -> Parser (ByteString, TrailChar)
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
    else (ByteString, TrailChar) -> Parser (ByteString, TrailChar)
forall a. a -> Parser ByteString a
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 a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ByteString, TrailChar) -> Parser (ByteString, TrailChar)
forall a. a -> Parser ByteString a
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 a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ByteString, TrailChar) -> Parser (ByteString, TrailChar)
forall a. a -> Parser ByteString a
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 a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
bs, TrailChar
TrailCharNewline)
      | Bool
otherwise -> String -> Parser (ByteString, TrailChar)
forall a. String -> Parser ByteString a
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 a. a -> Parser ByteString a
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 a. String -> ZeptoT m a
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 a. a -> ZeptoT m a
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

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 a. [a] -> 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 a. [a] -> 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 a b. (a -> b) -> Vector a -> Vector b
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
  { forall a b. EitherWrap a b -> Either a b
getEitherWrap :: Either a b
  }
  deriving ((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
$cfmap :: forall a a b. (a -> b) -> EitherWrap a a -> EitherWrap a b
fmap :: forall a b. (a -> b) -> EitherWrap a a -> EitherWrap a b
$c<$ :: forall a a b. a -> EitherWrap a b -> EitherWrap a a
<$ :: forall a b. a -> EitherWrap a b -> EitherWrap a a
Functor)

instance (Monoid a) => Applicative (EitherWrap a) where
  pure :: forall a. 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) <*> :: forall a b.
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 :: forall a b c. (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 :: forall (m :: * -> *).
Monad m =>
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) =>
  -- | index of first row, usually zero or one
  Int ->
  -- | Required row length
  Int ->
  Siphon Indexed ByteString a ->
  Stream (Of ByteString) m () ->
  Stream (Of a) m (Maybe SiphonError)
consumeBodyUtf8 :: forall (m :: * -> *) a.
Monad m =>
Int
-> Int
-> Siphon Indexed 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 Indexed 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 Indexed 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)) ->
  -- | true if null string
  (c -> Bool) ->
  c ->
  -- | true if termination is acceptable
  (r -> Bool) ->
  Stream (Of c) m r ->
  m (Either SiphonError (Of (Vector c) (Stream (Of c) m r)))
consumeHeaderRow :: 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 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 a. a -> m a
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 a. a -> Stream (Of c) m a
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 a. a -> m a
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 a. a -> m a
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 a b.
Stream (Of c) m a -> Stream (Of c) m b -> Stream (Of c) m b
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 a. a -> Stream (Of c) m a
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 ->
  -- | True if termination is acceptable. False if it is because of a decoding error.
  (r -> Bool) ->
  -- | index of first row, usually zero or one
  Int ->
  -- | Required row length
  Int ->
  Siphon Indexed c a ->
  Stream (Of c) m r ->
  Stream (Of a) m (Maybe SiphonError)
consumeBody :: forall (m :: * -> *) r c a.
Monad m =>
(c -> Text)
-> (c -> IResult c (CellResult c))
-> (c -> Bool)
-> c
-> (r -> Bool)
-> Int
-> Int
-> Siphon Indexed 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 Indexed 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 (m :: * -> *) a. Monad m => m a -> Stream (Of a) m a
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 a. a -> Stream (Of a) m a
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 a. a -> Stream (Of a) m a
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 a. a -> Stream (Of a) m a
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 (m :: * -> *) a. Monad m => m a -> Stream (Of a) m a
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 a. a -> Stream (Of a) m a
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 (m :: * -> *) a. Monad m => m a -> Stream (Of a) m a
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 a. a -> Stream (Of c) m a
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 Indexed c a -> Vector c -> Either SiphonError a
forall c a.
(c -> Text)
-> Int -> Siphon Indexed c a -> Vector c -> Either SiphonError a
uncheckedRunWithRow c -> Text
toStr Int
rowIx Siphon Indexed 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 :: forall c. 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 a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return MVector s c
mv
 where
  go1 :: forall s. MVector s c -> ST s ()
  go1 :: forall s. MVector s c -> ST s ()
go1 !MVector s c
mv = Int -> StrictList c -> ST s ()
go2 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) StrictList c
sl0
   where
    go2 :: Int -> StrictList c -> ST s ()
    go2 :: Int -> StrictList c -> ST s ()
go2 Int
_ StrictList c
StrictListNil = () -> ST s ()
forall a. a -> ST s a
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 :: 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
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 a. a -> m a
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 a. a -> m a
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
This is built in reverse and then reversed by reverseVectorStrictList
when converting to a vector.
-}
data StrictList a = StrictListNil | StrictListCons !a !(StrictList a)

{- | This function uses 'unsafeIndex' to access
  elements of the 'Vector'.
-}
uncheckedRunWithRow ::
  (c -> T.Text) ->
  Int ->
  Siphon Indexed c a ->
  Vector c ->
  Either SiphonError a
uncheckedRunWithRow :: forall c a.
(c -> Text)
-> Int -> Siphon Indexed c a -> Vector c -> Either SiphonError a
uncheckedRunWithRow c -> Text
toStr Int
i Siphon Indexed 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 Indexed c a -> Vector c -> Either (Vector CellError) a
forall c a.
(c -> Text)
-> Siphon Indexed c a -> Vector c -> Either (Vector CellError) a
uncheckedRun c -> Text
toStr Siphon Indexed 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 Indexed c a ->
  Vector c ->
  Either (Vector CellError) a
uncheckedRun :: forall c a.
(c -> Text)
-> Siphon Indexed c a -> Vector c -> Either (Vector CellError) a
uncheckedRun c -> Text
toStr Siphon Indexed 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 Indexed c a -> EitherWrap (Vector CellError) a
forall b. Siphon Indexed c b -> EitherWrap (Vector CellError) b
go Siphon Indexed c a
dc)
 where
  go ::
    forall b.
    Siphon Indexed c b ->
    EitherWrap (Vector CellError) b
  go :: forall b. Siphon Indexed 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 (Indexed Int
ix) c -> Maybe a1
decode Siphon Indexed c (a1 -> b)
apNext) =
    let rnext :: EitherWrap (Vector CellError) (a1 -> b)
rnext = Siphon Indexed c (a1 -> b)
-> EitherWrap (Vector CellError) (a1 -> b)
forall b. Siphon Indexed c b -> EitherWrap (Vector CellError) b
go Siphon Indexed c (a1 -> 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) a1
rcurrent =
          Either (Vector CellError) a1
-> (a1 -> Either (Vector CellError) a1)
-> Maybe a1
-> Either (Vector CellError) a1
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            (Vector CellError -> Either (Vector CellError) a1
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))))
            a1 -> Either (Vector CellError) a1
forall a b. b -> Either a b
Right
            (c -> Maybe a1
decode c
content)
     in EitherWrap (Vector CellError) (a1 -> b)
rnext EitherWrap (Vector CellError) (a1 -> b)
-> EitherWrap (Vector CellError) a1
-> EitherWrap (Vector CellError) b
forall a b.
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) a1 -> EitherWrap (Vector CellError) a1
forall a b. Either a b -> EitherWrap a b
EitherWrap Either (Vector CellError) a1
rcurrent)

-- | Uses the argument to parse a CSV column.
headless :: (c -> Maybe a) -> Siphon CE.Headless c a
headless :: forall c a. (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 a1 a.
f c -> (c -> Maybe a1) -> Siphon f c (a1 -> a) -> Siphon f c a
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 :: forall c a. 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 a1 a.
f c -> (c -> Maybe a1) -> Siphon f c (a1 -> a) -> Siphon f c a
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 :: forall c a. 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 a1 a.
f c -> (c -> Maybe a1) -> Siphon f c (a1 -> a) -> Siphon f c a
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)

eqSiphonHeaders :: (Eq1 f, Eq c) => Siphon f c a -> Siphon f c b -> Bool
eqSiphonHeaders :: forall (f :: * -> *) c a b.
(Eq1 f, Eq c) =>
Siphon f c a -> Siphon f c b -> Bool
eqSiphonHeaders (SiphonPure a
_) (SiphonPure b
_) = Bool
True
eqSiphonHeaders (SiphonAp f c
h0 c -> Maybe a1
_ Siphon f c (a1 -> a)
s0) (SiphonAp f c
h1 c -> Maybe a1
_ Siphon f c (a1 -> b)
s1) =
  (c -> c -> Bool) -> f c -> f c -> Bool
forall a b. (a -> b -> Bool) -> f a -> f b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq c -> c -> Bool
forall a. Eq a => a -> a -> Bool
(==) f c
h0 f c
h1 Bool -> Bool -> Bool
&& Siphon f c (a1 -> a) -> Siphon f c (a1 -> b) -> Bool
forall (f :: * -> *) c a b.
(Eq1 f, Eq c) =>
Siphon f c a -> Siphon f c b -> Bool
eqSiphonHeaders Siphon f c (a1 -> a)
s0 Siphon f c (a1 -> b)
s1
eqSiphonHeaders Siphon f c a
_ Siphon f c b
_ = Bool
False

showSiphonHeaders :: (Show1 f, Show c) => Siphon f c a -> String
showSiphonHeaders :: forall (f :: * -> *) c a.
(Show1 f, Show c) =>
Siphon f c a -> String
showSiphonHeaders (SiphonPure a
_) = String
""
showSiphonHeaders (SiphonAp f c
h0 c -> Maybe a1
_ Siphon f c (a1 -> a)
s0) = Int -> f c -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1 Int
10 f c
h0 (String
" :> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Siphon f c (a1 -> a) -> String
forall (f :: * -> *) c a.
(Show1 f, Show c) =>
Siphon f c a -> String
showSiphonHeaders Siphon f c (a1 -> a)
s0)

{- $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}
-}