-- |
-- Module      : Foundation.Format.CSV.Builder
-- License     : BSD-style
-- Maintainer  : Foundation
-- Stability   : experimental
-- Portability : portable
--
-- Provies the support for Comma Separated Value

{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}

module Foundation.Format.CSV.Builder
    ( -- * String Bulider
      csvStringBuilder
    , rowStringBuilder
    , fieldStringBuilder
      -- * Block Builder
    , csvBlockBuilder
    , rowBlockBuilder
    , fieldBlockBuilder
      -- * Conduit
    , 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

-- | serialise the CSV document into a UTF8 string
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

-- | serialise the CSV document into a UTF8 encoded (Block Word8)
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