{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
module Foundation.Format.CSV.Builder
(
csvStringBuilder
, rowStringBuilder
, fieldStringBuilder
, csvBlockBuilder
, rowBlockBuilder
, fieldBlockBuilder
, rowC
) where
import Basement.Imports
import Basement.String (replace)
import Foundation.Collection.Sequential (Sequential(intersperse))
import Foundation.Conduit.Internal
import qualified Foundation.String.Builder as String
import Basement.Block (Block)
import qualified Basement.Block.Builder as Block
import GHC.ST (runST)
import Foundation.Format.CSV.Types
csvStringBuilder :: CSV -> String.Builder
csvStringBuilder :: CSV -> Builder
csvStringBuilder = Builder -> Builder
String.unsafeStringBuilder (Builder -> Builder) -> (CSV -> Builder) -> CSV -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CSV -> Builder
csvBlockBuilder
rowStringBuilder :: Row -> String.Builder
rowStringBuilder :: Row -> Builder
rowStringBuilder = Builder -> Builder
String.unsafeStringBuilder (Builder -> Builder) -> (Row -> Builder) -> Row -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Row -> Builder
rowBlockBuilder
fieldStringBuilder :: Field -> String.Builder
fieldStringBuilder :: Field -> Builder
fieldStringBuilder = Builder -> Builder
String.unsafeStringBuilder (Builder -> Builder) -> (Field -> Builder) -> Field -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Field -> Builder
fieldBlockBuilder
csvBlockBuilder :: CSV -> Block.Builder
csvBlockBuilder :: CSV -> Builder
csvBlockBuilder = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> (CSV -> [Builder]) -> CSV -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Element [Builder] -> [Builder] -> [Builder]
forall c. Sequential c => Element c -> c -> c
intersperse (String -> Builder
Block.emitString String
"\r\n") ([Builder] -> [Builder]) -> (CSV -> [Builder]) -> CSV -> [Builder]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Row -> Builder) -> [Row] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Row -> Builder
rowBlockBuilder ([Row] -> [Builder]) -> (CSV -> [Row]) -> CSV -> [Builder]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Array Row -> [Row]
forall l. IsList l => l -> [Item l]
toList (Array Row -> [Row]) -> (CSV -> Array Row) -> CSV -> [Row]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CSV -> Array Row
unCSV
rowBlockBuilder :: Row -> Block.Builder
rowBlockBuilder :: Row -> Builder
rowBlockBuilder = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> (Row -> [Builder]) -> Row -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Element [Builder] -> [Builder] -> [Builder]
forall c. Sequential c => Element c -> c -> c
intersperse (Char -> Builder
Block.emitUTF8Char Char
',') ([Builder] -> [Builder]) -> (Row -> [Builder]) -> Row -> [Builder]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Field -> Builder) -> [Field] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Field -> Builder
fieldBlockBuilder ([Field] -> [Builder]) -> (Row -> [Field]) -> Row -> [Builder]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Array Field -> [Field]
forall l. IsList l => l -> [Item l]
toList (Array Field -> [Field]) -> (Row -> Array Field) -> Row -> [Field]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Row -> Array Field
unRow
fieldBlockBuilder :: Field -> Block.Builder
fieldBlockBuilder :: Field -> Builder
fieldBlockBuilder (FieldInteger Integer
i) = String -> Builder
Block.emitString (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
i
fieldBlockBuilder (FieldDouble Double
d) = String -> Builder
Block.emitString (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
d
fieldBlockBuilder (FieldString String
s Escaping
e) = case Escaping
e of
Escaping
NoEscape -> String -> Builder
Block.emitString String
s
Escaping
Escape -> Char -> Builder
Block.emitUTF8Char Char
'"' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
Block.emitString String
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Block.emitUTF8Char Char
'"'
Escaping
DoubleEscape -> Char -> Builder
Block.emitUTF8Char Char
'"' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
Block.emitString (String -> String -> String -> String
replace String
"\"" String
"\"\"" String
s) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Block.emitUTF8Char Char
'"'
rowC :: (Record row, Monad m) => Conduit row (Block Word8) m ()
rowC :: Conduit row (Block Word8) m ()
rowC = Conduit row (Block Word8) m (Maybe row)
forall i o (m :: * -> *). Conduit i o m (Maybe i)
await Conduit row (Block Word8) m (Maybe row)
-> (Maybe row -> Conduit row (Block Word8) m ())
-> Conduit row (Block Word8) m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe row -> Conduit row (Block Word8) m ()
forall (m :: * -> *) i.
(Monad m, Record i) =>
Maybe i -> Conduit i (Block Word8) m ()
go
where
go :: Maybe i -> Conduit i (Block Word8) m ()
go Maybe i
Nothing = () -> Conduit i (Block Word8) m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
go (Just i
r) =
let bytes :: Block Word8
bytes = (forall s. ST s (Block Word8)) -> Block Word8
forall a. (forall s. ST s a) -> a
runST (Builder -> ST s (Block Word8)
forall (prim :: * -> *).
PrimMonad prim =>
Builder -> prim (Block Word8)
Block.run (Builder -> ST s (Block Word8)) -> Builder -> ST s (Block Word8)
forall a b. (a -> b) -> a -> b
$ Row -> Builder
rowBlockBuilder (i -> Row
forall a. Record a => a -> Row
toRow i
r) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
Block.emitString String
"\r\n")
in Block Word8 -> Conduit i (Block Word8) m ()
forall (m :: * -> *) o i. Monad m => o -> Conduit i o m ()
yield Block Word8
bytes Conduit i (Block Word8) m ()
-> Conduit i (Block Word8) m (Maybe i)
-> Conduit i (Block Word8) m (Maybe i)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Conduit i (Block Word8) m (Maybe i)
forall i o (m :: * -> *). Conduit i o m (Maybe i)
await Conduit i (Block Word8) m (Maybe i)
-> (Maybe i -> Conduit i (Block Word8) m ())
-> Conduit i (Block Word8) m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe i -> Conduit i (Block Word8) m ()
go