{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeOperators #-}
module Basement.Block.Builder
( Builder
, run
, emit
, emitPrim
, emitString
, emitUTF8Char
, 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 #-}
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 #-}
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 #-}
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 :: 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
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)
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
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
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