-- |
-- Copyright:   (c) 2022 Andrew Lelechenko
-- Licence:     BSD3
-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>

module Data.Text.Builder.Linear.Double
  ( (|>%)
  , (%<|)
  ) where

import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Builder.Internal as BBI
import qualified Data.Text.Array as A
import Data.Word (Word8)
import GHC.Exts (Ptr(..))
import GHC.ForeignPtr (touchForeignPtr, unsafeForeignPtrToPtr, unsafeWithForeignPtr, ForeignPtr)
import GHC.IO (unsafeIOToST, unsafeSTToIO, unsafeDupablePerformIO)
import GHC.Ptr (minusPtr)
import GHC.ST (ST)

import Data.Text.Builder.Linear.Core

-- | Append double.
(|>%) :: Buffer ⊸ Double → Buffer
infixl 6 |>%
Buffer
buffer |>% :: Buffer %1 -> Double -> Buffer
|>% Double
x = Int
-> (forall s. MArray s -> Int -> ST s Int) -> Buffer %1 -> Buffer
appendBounded
  Int
maxDblLen
  (\MArray s
dst Int
dstOff → MArray s -> Int -> Double -> ST s Int
forall s. MArray s -> Int -> Double -> ST s Int
unsafeAppendDouble MArray s
dst Int
dstOff Double
x)
  Buffer
buffer

-- | Prepend double
(%<|) :: Double → Buffer ⊸ Buffer
infixr 6 %<|
Double
x %<| :: Double -> Buffer %1 -> Buffer
%<| Buffer
buffer = Int
-> (forall s. MArray s -> Int -> ST s Int)
-> (forall s. MArray s -> Int -> ST s Int)
-> Buffer
%1 -> Buffer
prependBounded
  Int
maxDblLen
  (\MArray s
dst Int
dstOff → MArray s -> Int -> Double -> ST s Int
forall s. MArray s -> Int -> Double -> ST s Int
unsafePrependDouble MArray s
dst Int
dstOff Double
x)
  (\MArray s
dst Int
dstOff → MArray s -> Int -> Double -> ST s Int
forall s. MArray s -> Int -> Double -> ST s Int
unsafeAppendDouble MArray s
dst Int
dstOff Double
x)
  Buffer
buffer

unsafeAppendDouble :: A.MArray s → Int → Double → ST s Int
unsafeAppendDouble :: forall s. MArray s -> Int -> Double -> ST s Int
unsafeAppendDouble MArray s
dst !Int
dstOff !Double
x = do
  let (ForeignPtr Word8
fp, !Int
srcLen) = Double -> (ForeignPtr Word8, Int)
runDoubleBuilder Double
x
  IO () -> ST s ()
forall a s. IO a -> ST s a
unsafeIOToST (IO () -> ST s ()) -> IO () -> ST s ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr Addr#
addr#) →
    ST s () -> IO ()
forall s a. ST s a -> IO a
unsafeSTToIO (ST s () -> IO ()) -> ST s () -> IO ()
forall a b. (a -> b) -> a -> b
$ MArray s -> Int -> Ptr Word8 -> Int -> ST s ()
forall s. MArray s -> Int -> Ptr Word8 -> Int -> ST s ()
A.copyFromPointer MArray s
dst Int
dstOff (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
addr#) Int
srcLen
  Int -> ST s Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
srcLen

unsafePrependDouble :: A.MArray s → Int → Double → ST s Int
unsafePrependDouble :: forall s. MArray s -> Int -> Double -> ST s Int
unsafePrependDouble MArray s
dst !Int
dstOff !Double
x = do
  let (ForeignPtr Word8
fp, !Int
srcLen) = Double -> (ForeignPtr Word8, Int)
runDoubleBuilder Double
x
  IO () -> ST s ()
forall a s. IO a -> ST s a
unsafeIOToST (IO () -> ST s ()) -> IO () -> ST s ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr Addr#
addr#) →
    ST s () -> IO ()
forall s a. ST s a -> IO a
unsafeSTToIO (ST s () -> IO ()) -> ST s () -> IO ()
forall a b. (a -> b) -> a -> b
$ MArray s -> Int -> Ptr Word8 -> Int -> ST s ()
forall s. MArray s -> Int -> Ptr Word8 -> Int -> ST s ()
A.copyFromPointer MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
srcLen) (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
addr#) Int
srcLen
  Int -> ST s Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
srcLen

runDoubleBuilder :: Double → (ForeignPtr Word8, Int)
runDoubleBuilder :: Double -> (ForeignPtr Word8, Int)
runDoubleBuilder =
  IO (ForeignPtr Word8, Int) -> (ForeignPtr Word8, Int)
forall a. IO a -> a
unsafeDupablePerformIO (IO (ForeignPtr Word8, Int) -> (ForeignPtr Word8, Int))
-> (Double -> IO (ForeignPtr Word8, Int))
-> Double
-> (ForeignPtr Word8, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildStep () -> IO (ForeignPtr Word8, Int)
forall a. BuildStep a -> IO (ForeignPtr Word8, Int)
buildStepToFirstChunk (BuildStep () -> IO (ForeignPtr Word8, Int))
-> (Double -> BuildStep ()) -> Double -> IO (ForeignPtr Word8, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> BuildStep ()
BBI.runBuilder (Builder -> BuildStep ())
-> (Double -> Builder) -> Double -> BuildStep ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Builder
BB.doubleDec
{-# INLINE runDoubleBuilder #-}

buildStepToFirstChunk :: BBI.BuildStep a → IO (ForeignPtr Word8, Int)
buildStepToFirstChunk :: forall a. BuildStep a -> IO (ForeignPtr Word8, Int)
buildStepToFirstChunk = \BuildStep a
step → Int -> IO Buffer
BBI.newBuffer Int
maxDblLen IO Buffer
-> (Buffer -> IO (ForeignPtr Word8, Int))
-> IO (ForeignPtr Word8, Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BuildStep a -> Buffer -> IO (ForeignPtr Word8, Int)
forall {a}. BuildStep a -> Buffer -> IO (ForeignPtr Word8, Int)
fill BuildStep a
step
  where
    fill :: BuildStep a -> Buffer -> IO (ForeignPtr Word8, Int)
fill !BuildStep a
step (BBI.Buffer ForeignPtr Word8
fpbuf BufferRange
br) = do
      let doneH :: Ptr Word8 -> a -> IO (ForeignPtr Word8, Int)
doneH Ptr Word8
op' a
_ = (ForeignPtr Word8, Int) -> IO (ForeignPtr Word8, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignPtr Word8
fpbuf, Ptr Word8
op' Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fpbuf)
          fullH :: Ptr Word8 -> Int -> BuildStep a -> IO (ForeignPtr Word8, Int)
fullH Ptr Word8
_ Int
_ BuildStep a
nextStep = Int -> IO Buffer
BBI.newBuffer Int
maxDblLen IO Buffer
-> (Buffer -> IO (ForeignPtr Word8, Int))
-> IO (ForeignPtr Word8, Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BuildStep a -> Buffer -> IO (ForeignPtr Word8, Int)
fill BuildStep a
nextStep
      (ForeignPtr Word8, Int)
res ← BuildStep a
-> (Ptr Word8 -> a -> IO (ForeignPtr Word8, Int))
-> (Ptr Word8 -> Int -> BuildStep a -> IO (ForeignPtr Word8, Int))
-> (Ptr Word8
    -> ByteString -> BuildStep a -> IO (ForeignPtr Word8, Int))
-> BufferRange
-> IO (ForeignPtr Word8, Int)
forall a b.
BuildStep a
-> (Ptr Word8 -> a -> IO b)
-> (Ptr Word8 -> Int -> BuildStep a -> IO b)
-> (Ptr Word8 -> ByteString -> BuildStep a -> IO b)
-> BufferRange
-> IO b
BBI.fillWithBuildStep BuildStep a
step Ptr Word8 -> a -> IO (ForeignPtr Word8, Int)
doneH Ptr Word8 -> Int -> BuildStep a -> IO (ForeignPtr Word8, Int)
fullH Ptr Word8
-> ByteString -> BuildStep a -> IO (ForeignPtr Word8, Int)
forall a. HasCallStack => a
undefined BufferRange
br
      ForeignPtr Word8 -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Word8
fpbuf
      (ForeignPtr Word8, Int) -> IO (ForeignPtr Word8, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8, Int)
res

maxDblLen :: Int
maxDblLen :: Int
maxDblLen = Int
24 -- length (show (-1.0000000000000004e-308 :: Double))