module Mason.Builder.Dynamic
  ( DynBuilder
  , DynamicBackend(..)
  -- * Runners

  , toStrictByteString
  , toLazyByteString
  , hPutBuilderLen
  , hPutBuilder
  , sendBuilder
  ) where

import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Mason.Builder as B
import qualified Mason.Builder.Internal as B
import Network.Socket (Socket)
import System.IO (Handle)

data DynamicBackend = DynGrowingBuffer !B.GrowingBuffer
  | DynChannel !B.Channel
  | DynPutEnv !B.PutEnv

instance B.Buildable DynamicBackend where
  byteString :: ByteString -> BuilderFor DynamicBackend
byteString ByteString
bs = forall s. (s -> Buffer -> IO Buffer) -> BuilderFor s
B.Builder forall a b. (a -> b) -> a -> b
$ \DynamicBackend
env Buffer
buf -> case DynamicBackend
env of
    DynGrowingBuffer GrowingBuffer
e -> forall s. BuilderFor s -> s -> Buffer -> IO Buffer
B.unBuilder (forall s. Buildable s => ByteString -> BuilderFor s
B.byteString ByteString
bs) GrowingBuffer
e Buffer
buf
    DynChannel Channel
e -> forall s. BuilderFor s -> s -> Buffer -> IO Buffer
B.unBuilder (forall s. Buildable s => ByteString -> BuilderFor s
B.byteString ByteString
bs) Channel
e Buffer
buf
    DynPutEnv PutEnv
e -> forall s. BuilderFor s -> s -> Buffer -> IO Buffer
B.unBuilder (forall s. Buildable s => ByteString -> BuilderFor s
B.byteString ByteString
bs) PutEnv
e Buffer
buf
  {-# INLINE byteString #-}
  flush :: BuilderFor DynamicBackend
flush = forall s. (s -> Buffer -> IO Buffer) -> BuilderFor s
B.Builder forall a b. (a -> b) -> a -> b
$ \DynamicBackend
env Buffer
buf -> case DynamicBackend
env of
    DynGrowingBuffer GrowingBuffer
e -> forall s. BuilderFor s -> s -> Buffer -> IO Buffer
B.unBuilder forall s. Buildable s => BuilderFor s
B.flush GrowingBuffer
e Buffer
buf
    DynChannel Channel
e -> forall s. BuilderFor s -> s -> Buffer -> IO Buffer
B.unBuilder forall s. Buildable s => BuilderFor s
B.flush Channel
e Buffer
buf
    DynPutEnv PutEnv
e -> forall s. BuilderFor s -> s -> Buffer -> IO Buffer
B.unBuilder forall s. Buildable s => BuilderFor s
B.flush PutEnv
e Buffer
buf
  {-# INLINE flush #-}
  allocate :: Int -> BuilderFor DynamicBackend
allocate Int
n = forall s. (s -> Buffer -> IO Buffer) -> BuilderFor s
B.Builder forall a b. (a -> b) -> a -> b
$ \DynamicBackend
env Buffer
buf -> case DynamicBackend
env of
    DynGrowingBuffer GrowingBuffer
e -> forall s. BuilderFor s -> s -> Buffer -> IO Buffer
B.unBuilder (forall s. Buildable s => Int -> BuilderFor s
B.allocate Int
n) GrowingBuffer
e Buffer
buf
    DynChannel Channel
e -> forall s. BuilderFor s -> s -> Buffer -> IO Buffer
B.unBuilder (forall s. Buildable s => Int -> BuilderFor s
B.allocate Int
n) Channel
e Buffer
buf
    DynPutEnv PutEnv
e -> forall s. BuilderFor s -> s -> Buffer -> IO Buffer
B.unBuilder (forall s. Buildable s => Int -> BuilderFor s
B.allocate Int
n) PutEnv
e Buffer
buf
  {-# INLINE allocate #-}

-- | Builder with a fixed set of backends. This helps reducing code size

-- and unoptimised code especially on complex/recursive structures, at the cost of

-- extensibility.

type DynBuilder = B.BuilderFor DynamicBackend

toStrictByteString :: DynBuilder -> B.ByteString
toStrictByteString :: BuilderFor DynamicBackend -> ByteString
toStrictByteString BuilderFor DynamicBackend
b = BuilderFor GrowingBuffer -> ByteString
B.toStrictByteString forall a b. (a -> b) -> a -> b
$ forall s. (s -> Buffer -> IO Buffer) -> BuilderFor s
B.Builder forall a b. (a -> b) -> a -> b
$ forall s. BuilderFor s -> s -> Buffer -> IO Buffer
B.unBuilder BuilderFor DynamicBackend
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. GrowingBuffer -> DynamicBackend
DynGrowingBuffer
{-# INLINE toStrictByteString #-}

toLazyByteString :: DynBuilder -> BL.ByteString
toLazyByteString :: BuilderFor DynamicBackend -> ByteString
toLazyByteString BuilderFor DynamicBackend
b = BuilderFor Channel -> ByteString
B.toLazyByteString forall a b. (a -> b) -> a -> b
$ forall s. (s -> Buffer -> IO Buffer) -> BuilderFor s
B.Builder forall a b. (a -> b) -> a -> b
$ forall s. BuilderFor s -> s -> Buffer -> IO Buffer
B.unBuilder BuilderFor DynamicBackend
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. Channel -> DynamicBackend
DynChannel
{-# INLINE toLazyByteString #-}

hPutBuilder :: Handle -> DynBuilder -> IO ()
hPutBuilder :: Handle -> BuilderFor DynamicBackend -> IO ()
hPutBuilder Handle
h BuilderFor DynamicBackend
b = Handle -> BuilderFor PutEnv -> IO ()
B.hPutBuilder Handle
h forall a b. (a -> b) -> a -> b
$ forall s. (s -> Buffer -> IO Buffer) -> BuilderFor s
B.Builder forall a b. (a -> b) -> a -> b
$ forall s. BuilderFor s -> s -> Buffer -> IO Buffer
B.unBuilder BuilderFor DynamicBackend
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. PutEnv -> DynamicBackend
DynPutEnv
{-# INLINE hPutBuilder #-}

hPutBuilderLen :: Handle -> DynBuilder -> IO Int
hPutBuilderLen :: Handle -> BuilderFor DynamicBackend -> IO Int
hPutBuilderLen Handle
h BuilderFor DynamicBackend
b = Handle -> BuilderFor PutEnv -> IO Int
B.hPutBuilderLen Handle
h forall a b. (a -> b) -> a -> b
$ forall s. (s -> Buffer -> IO Buffer) -> BuilderFor s
B.Builder forall a b. (a -> b) -> a -> b
$ forall s. BuilderFor s -> s -> Buffer -> IO Buffer
B.unBuilder BuilderFor DynamicBackend
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. PutEnv -> DynamicBackend
DynPutEnv
{-# INLINE hPutBuilderLen #-}

sendBuilder :: Socket -> DynBuilder -> IO Int
sendBuilder :: Socket -> BuilderFor DynamicBackend -> IO Int
sendBuilder Socket
h BuilderFor DynamicBackend
b = Socket -> BuilderFor PutEnv -> IO Int
B.sendBuilder Socket
h forall a b. (a -> b) -> a -> b
$ forall s. (s -> Buffer -> IO Buffer) -> BuilderFor s
B.Builder forall a b. (a -> b) -> a -> b
$ forall s. BuilderFor s -> s -> Buffer -> IO Buffer
B.unBuilder BuilderFor DynamicBackend
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. PutEnv -> DynamicBackend
DynPutEnv
{-# INLINE sendBuilder #-}