-- |
-- Module      : Basement.Block.Builder
-- License     : BSD-style
-- Maintainer  : Foundation
--
-- Block builder

{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeOperators #-}

module Basement.Block.Builder
    ( Builder
    , run

    -- * Emit functions
    , emit
    , emitPrim
    , emitString
    , emitUTF8Char

    -- * unsafe
    , unsafeRunString
    ) where

import qualified Basement.Alg.UTF8 as UTF8
import           Basement.UTF8.Helper          (charToBytes)
import           Basement.Numerical.Conversion (charToInt)
import           Basement.Block.Base (Block(..), MutableBlock(..))
import qualified Basement.Block.Base as B
import           Basement.Cast
import           Basement.Compat.Base
import           Basement.Compat.Semigroup
import           Basement.Monad
import           Basement.FinalPtr (FinalPtr, withFinalPtr)
import           Basement.Numerical.Additive
import           Basement.String                (String(..))
import qualified Basement.String as S
import           Basement.Types.OffsetSize
import           Basement.PrimType (PrimType(..), primMbaWrite)
import           Basement.UArray.Base (UArray(..))
import qualified Basement.UArray.Base as A

import           GHC.ST
import           Data.Proxy

newtype Action = Action
    { Action
-> forall (prim :: * -> *).
   PrimMonad prim =>
   MutableBlock Word8 (PrimState prim)
   -> Offset Word8 -> prim (Offset Word8)
runAction_ :: forall prim . PrimMonad prim
                 => MutableBlock Word8 (PrimState prim)
                 -> Offset Word8
                 -> prim (Offset Word8)
    }

data Builder = Builder {-# UNPACK #-} !(CountOf Word8)
                                      !Action

instance Semigroup Builder where
    <> :: Builder -> Builder -> Builder
(<>) = Builder -> Builder -> Builder
append
    {-# INLINABLE (<>) #-}
instance Monoid Builder where
    mempty :: Builder
mempty = Builder
empty
    {-# INLINABLE mempty #-}
    mconcat :: [Builder] -> Builder
mconcat = [Builder] -> Builder
concat
    {-# INLINABLE mconcat #-}

-- | create an empty builder
--
-- this does nothing, build nothing, take no space (in the resulted block)
empty :: Builder
empty :: Builder
empty = CountOf Word8 -> Action -> Builder
Builder CountOf Word8
0 ((forall (prim :: * -> *).
 PrimMonad prim =>
 MutableBlock Word8 (PrimState prim)
 -> Offset Word8 -> prim (Offset Word8))
-> Action
Action forall a b. (a -> b) -> a -> b
$ \MutableBlock Word8 (PrimState prim)
_ !Offset Word8
off -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Offset Word8
off)
{-# INLINE empty #-}

-- | concatenate the 2 given bulider
append :: Builder -> Builder -> Builder
append :: Builder -> Builder -> Builder
append (Builder CountOf Word8
size1 (Action forall (prim :: * -> *).
PrimMonad prim =>
MutableBlock Word8 (PrimState prim)
-> Offset Word8 -> prim (Offset Word8)
action1)) (Builder CountOf Word8
size2 (Action forall (prim :: * -> *).
PrimMonad prim =>
MutableBlock Word8 (PrimState prim)
-> Offset Word8 -> prim (Offset Word8)
action2)) =
    CountOf Word8 -> Action -> Builder
Builder CountOf Word8
size Action
action
  where
    action :: Action
action = (forall (prim :: * -> *).
 PrimMonad prim =>
 MutableBlock Word8 (PrimState prim)
 -> Offset Word8 -> prim (Offset Word8))
-> Action
Action forall a b. (a -> b) -> a -> b
$ \MutableBlock Word8 (PrimState prim)
arr Offset Word8
off -> do
      Offset Word8
off' <- forall (prim :: * -> *).
PrimMonad prim =>
MutableBlock Word8 (PrimState prim)
-> Offset Word8 -> prim (Offset Word8)
action1 MutableBlock Word8 (PrimState prim)
arr Offset Word8
off
      forall (prim :: * -> *).
PrimMonad prim =>
MutableBlock Word8 (PrimState prim)
-> Offset Word8 -> prim (Offset Word8)
action2 MutableBlock Word8 (PrimState prim)
arr Offset Word8
off'
    size :: CountOf Word8
size = CountOf Word8
size1 forall a. Additive a => a -> a -> a
+ CountOf Word8
size2
{-# INLINABLE append #-}

-- | concatenate the list of builder
concat :: [Builder] -> Builder
concat :: [Builder] -> Builder
concat = CountOf Word8 -> Action -> [Builder] -> Builder
loop CountOf Word8
0 ((forall (prim :: * -> *).
 PrimMonad prim =>
 MutableBlock Word8 (PrimState prim)
 -> Offset Word8 -> prim (Offset Word8))
-> Action
Action forall a b. (a -> b) -> a -> b
$ \MutableBlock Word8 (PrimState prim)
_ !Offset Word8
off -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Offset Word8
off)
  where
    loop :: CountOf Word8 -> Action -> [Builder] -> Builder
loop !CountOf Word8
sz Action
acc          []                              = CountOf Word8 -> Action -> Builder
Builder CountOf Word8
sz Action
acc
    loop !CountOf Word8
sz (Action forall (prim :: * -> *).
PrimMonad prim =>
MutableBlock Word8 (PrimState prim)
-> Offset Word8 -> prim (Offset Word8)
acc) (Builder !CountOf Word8
s (Action forall (prim :: * -> *).
PrimMonad prim =>
MutableBlock Word8 (PrimState prim)
-> Offset Word8 -> prim (Offset Word8)
action):[Builder]
xs) =
       CountOf Word8 -> Action -> [Builder] -> Builder
loop (CountOf Word8
sz forall a. Additive a => a -> a -> a
+ CountOf Word8
s) ((forall (prim :: * -> *).
 PrimMonad prim =>
 MutableBlock Word8 (PrimState prim)
 -> Offset Word8 -> prim (Offset Word8))
-> Action
Action forall a b. (a -> b) -> a -> b
$ \MutableBlock Word8 (PrimState prim)
arr Offset Word8
off -> forall (prim :: * -> *).
PrimMonad prim =>
MutableBlock Word8 (PrimState prim)
-> Offset Word8 -> prim (Offset Word8)
acc MutableBlock Word8 (PrimState prim)
arr Offset Word8
off forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (prim :: * -> *).
PrimMonad prim =>
MutableBlock Word8 (PrimState prim)
-> Offset Word8 -> prim (Offset Word8)
action MutableBlock Word8 (PrimState prim)
arr) [Builder]
xs
{-# INLINABLE concat #-}

-- | run the given builder and return the generated block
run :: PrimMonad prim => Builder -> prim (Block Word8)
run :: forall (prim :: * -> *).
PrimMonad prim =>
Builder -> prim (Block Word8)
run (Builder CountOf Word8
sz Action
action) = do
    MutableBlock Word8 (PrimState prim)
mb <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
B.new CountOf Word8
sz
    Offset Word8
off <- Action
-> forall (prim :: * -> *).
   PrimMonad prim =>
   MutableBlock Word8 (PrimState prim)
   -> Offset Word8 -> prim (Offset Word8)
runAction_ Action
action MutableBlock Word8 (PrimState prim)
mb Offset Word8
0
    forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim)
-> CountOf ty -> prim (MutableBlock ty (PrimState prim))
B.unsafeShrink MutableBlock Word8 (PrimState prim)
mb (forall a. Offset a -> CountOf a
offsetAsSize Offset Word8
off) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
B.unsafeFreeze

-- | run the given builder and return a UTF8String
--
-- this action is unsafe as there is no guarantee upon the validity of the
-- content of the built block.
unsafeRunString :: PrimMonad prim => Builder -> prim String
unsafeRunString :: forall (prim :: * -> *). PrimMonad prim => Builder -> prim String
unsafeRunString Builder
b = do
    Block Word8
str <- forall (prim :: * -> *).
PrimMonad prim =>
Builder -> prim (Block Word8)
run Builder
b
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ UArray Word8 -> String
String forall a b. (a -> b) -> a -> b
$ forall ty. Offset ty -> CountOf ty -> UArrayBackend ty -> UArray ty
A.UArray Offset Word8
0 (forall ty. PrimType ty => Block ty -> CountOf ty
B.length Block Word8
str) (forall ty. Block ty -> UArrayBackend ty
A.UArrayBA Block Word8
str)

-- | add a Block in the builder
emit :: Block a -> Builder
emit :: forall a. Block a -> Builder
emit Block a
b = CountOf Word8 -> Action -> Builder
Builder CountOf Word8
size forall a b. (a -> b) -> a -> b
$ (forall (prim :: * -> *).
 PrimMonad prim =>
 MutableBlock Word8 (PrimState prim)
 -> Offset Word8 -> prim (Offset Word8))
-> Action
Action forall a b. (a -> b) -> a -> b
$ \MutableBlock Word8 (PrimState prim)
arr Offset Word8
off ->
    forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim)
-> Offset Word8
-> Block ty
-> Offset Word8
-> CountOf Word8
-> prim ()
B.unsafeCopyBytesRO MutableBlock Word8 (PrimState prim)
arr Offset Word8
off Block Word8
b' Offset Word8
0 CountOf Word8
size forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Offset Word8
off forall a. Additive a => a -> a -> a
+ forall a. CountOf a -> Offset a
sizeAsOffset CountOf Word8
size)
  where
    b' :: Block Word8
    b' :: Block Word8
b' = forall source destination.
Cast source destination =>
source -> destination
cast Block a
b
    size :: CountOf Word8
    size :: CountOf Word8
size = forall ty. PrimType ty => Block ty -> CountOf ty
B.length Block Word8
b'

emitPrim :: (PrimType ty, ty ~ Word8) => ty -> Builder
emitPrim :: forall ty. (PrimType ty, ty ~ Word8) => ty -> Builder
emitPrim ty
a = CountOf Word8 -> Action -> Builder
Builder CountOf Word8
size forall a b. (a -> b) -> a -> b
$ (forall (prim :: * -> *).
 PrimMonad prim =>
 MutableBlock Word8 (PrimState prim)
 -> Offset Word8 -> prim (Offset Word8))
-> Action
Action forall a b. (a -> b) -> a -> b
$ \(MutableBlock MutableByteArray# (PrimState prim)
arr) Offset Word8
off ->
    forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
MutableByteArray# (PrimState prim) -> Offset ty -> ty -> prim ()
primMbaWrite MutableByteArray# (PrimState prim)
arr Offset Word8
off ty
a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Offset Word8
off forall a. Additive a => a -> a -> a
+ forall a. CountOf a -> Offset a
sizeAsOffset CountOf Word8
size)
  where
    size :: CountOf Word8
size = forall ty. PrimType ty => Proxy ty -> ty -> CountOf Word8
getSize forall {k} (t :: k). Proxy t
Proxy ty
a
    getSize :: PrimType ty => Proxy ty -> ty -> CountOf Word8
    getSize :: forall ty. PrimType ty => Proxy ty -> ty -> CountOf Word8
getSize Proxy ty
p ty
_ = forall ty. PrimType ty => Proxy ty -> CountOf Word8
primSizeInBytes Proxy ty
p

-- | add a string in the builder
emitString :: String -> Builder
emitString :: String -> Builder
emitString (String UArray Word8
str) = CountOf Word8 -> Action -> Builder
Builder CountOf Word8
size forall a b. (a -> b) -> a -> b
$ (forall (prim :: * -> *).
 PrimMonad prim =>
 MutableBlock Word8 (PrimState prim)
 -> Offset Word8 -> prim (Offset Word8))
-> Action
Action forall a b. (a -> b) -> a -> b
$ \MutableBlock Word8 (PrimState prim)
arr Offset Word8
off ->
    forall (prim :: * -> *) ty a.
PrimMonad prim =>
(Block ty -> prim a)
-> (FinalPtr ty -> prim a) -> UArray ty -> prim a
A.onBackendPrim (forall (prim :: * -> *).
PrimMonad prim =>
MutableBlock Word8 (PrimState prim)
-> Offset Word8 -> Block Word8 -> prim ()
onBA MutableBlock Word8 (PrimState prim)
arr Offset Word8
off) (forall (prim :: * -> *).
PrimMonad prim =>
MutableBlock Word8 (PrimState prim)
-> Offset Word8 -> FinalPtr Word8 -> prim ()
onAddr MutableBlock Word8 (PrimState prim)
arr Offset Word8
off) UArray Word8
str forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Offset Word8
off forall a. Additive a => a -> a -> a
+ forall a. CountOf a -> Offset a
sizeAsOffset CountOf Word8
size)
  where
    size :: CountOf Word8
size = forall ty. UArray ty -> CountOf ty
A.length UArray Word8
str
    onBA :: PrimMonad prim
         => MutableBlock Word8 (PrimState prim)
         -> Offset Word8
         -> Block Word8
         -> prim ()
    onBA :: forall (prim :: * -> *).
PrimMonad prim =>
MutableBlock Word8 (PrimState prim)
-> Offset Word8 -> Block Word8 -> prim ()
onBA   MutableBlock Word8 (PrimState prim)
arr Offset Word8
off Block Word8
ba   = forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim)
-> Offset Word8
-> Block ty
-> Offset Word8
-> CountOf Word8
-> prim ()
B.unsafeCopyBytesRO MutableBlock Word8 (PrimState prim)
arr Offset Word8
off Block Word8
ba Offset Word8
0 CountOf Word8
size
    onAddr :: PrimMonad prim
           => MutableBlock Word8 (PrimState prim)
           -> Offset Word8
           -> FinalPtr Word8
           -> prim ()
    onAddr :: forall (prim :: * -> *).
PrimMonad prim =>
MutableBlock Word8 (PrimState prim)
-> Offset Word8 -> FinalPtr Word8 -> prim ()
onAddr MutableBlock Word8 (PrimState prim)
arr Offset Word8
off FinalPtr Word8
fptr = forall (prim :: * -> *) p a.
PrimMonad prim =>
FinalPtr p -> (Ptr p -> prim a) -> prim a
withFinalPtr FinalPtr Word8
fptr forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim)
-> Offset Word8 -> Ptr ty -> CountOf Word8 -> prim ()
B.unsafeCopyBytesPtr MutableBlock Word8 (PrimState prim)
arr Offset Word8
off Ptr Word8
ptr CountOf Word8
size

-- | emit a UTF8 char in the builder
--
-- this function may be replaced by `emit :: Encoding -> Char -> Builder`
emitUTF8Char :: Char -> Builder
emitUTF8Char :: Char -> Builder
emitUTF8Char Char
c = CountOf Word8 -> Action -> Builder
Builder (Int -> CountOf Word8
charToBytes forall a b. (a -> b) -> a -> b
$ Char -> Int
charToInt Char
c) forall a b. (a -> b) -> a -> b
$ (forall (prim :: * -> *).
 PrimMonad prim =>
 MutableBlock Word8 (PrimState prim)
 -> Offset Word8 -> prim (Offset Word8))
-> Action
Action forall a b. (a -> b) -> a -> b
$ \block :: MutableBlock Word8 (PrimState prim)
block@(MutableBlock !MutableByteArray# (PrimState prim)
_) Offset Word8
off ->
    forall (prim :: * -> *) container.
(PrimMonad prim, RandomAccess container prim Word8) =>
container -> Offset Word8 -> Char -> prim (Offset Word8)
UTF8.writeUTF8 MutableBlock Word8 (PrimState prim)
block Offset Word8
off Char
c