-- |
-- Copyright:   (c) 2022 Andrew Lelechenko
-- Licence:     BSD3
-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>
module Data.Text.Builder.Linear.Double (
  (|>%),
  (%<|),
) where

import Data.ByteString.Builder qualified as BB
import Data.ByteString.Builder.Internal qualified as BBI
import Data.Text.Array qualified as A
import Data.Word (Word8)
import GHC.Exts (Ptr (..))
import GHC.ForeignPtr (ForeignPtr, touchForeignPtr, unsafeForeignPtrToPtr, unsafeWithForeignPtr)
import GHC.IO (unsafeDupablePerformIO, unsafeIOToST, unsafeSTToIO)
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 → 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 → forall s. MArray s -> Int -> Double -> ST s Int
unsafePrependDouble MArray s
dst Int
dstOff Double
x)
    (\MArray s
dst Int
dstOff → 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
  forall a s. IO a -> ST s a
unsafeIOToST forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \(Ptr Addr#
addr#) →
    forall s a. ST s a -> IO a
unsafeSTToIO forall a b. (a -> b) -> a -> b
$ forall s. MArray s -> Int -> Ptr Word8 -> Int -> ST s ()
A.copyFromPointer MArray s
dst Int
dstOff (forall a. Addr# -> Ptr a
Ptr Addr#
addr#) Int
srcLen
  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
  forall a s. IO a -> ST s a
unsafeIOToST forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \(Ptr Addr#
addr#) →
    forall s a. ST s a -> IO a
unsafeSTToIO forall a b. (a -> b) -> a -> b
$ forall s. MArray s -> Int -> Ptr Word8 -> Int -> ST s ()
A.copyFromPointer MArray s
dst (Int
dstOff forall a. Num a => a -> a -> a
- Int
srcLen) (forall a. Addr# -> Ptr a
Ptr Addr#
addr#) Int
srcLen
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
srcLen

runDoubleBuilder ∷ Double → (ForeignPtr Word8, Int)
runDoubleBuilder :: Double -> (ForeignPtr Word8, Int)
runDoubleBuilder =
  forall a. IO a -> a
unsafeDupablePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. BuildStep a -> IO (ForeignPtr Word8, Int)
buildStepToFirstChunk forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> BuildStep ()
BBI.runBuilder 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 a -> p -> f (ForeignPtr Word8, Int)
doneH Ptr a
op' p
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignPtr Word8
fpbuf, Ptr a
op' forall a b. Ptr a -> Ptr b -> Int
`minusPtr` forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fpbuf)
          fullH :: p -> p -> BuildStep a -> IO (ForeignPtr Word8, Int)
fullH p
_ p
_ BuildStep a
nextStep = Int -> IO Buffer
BBI.newBuffer Int
maxDblLen 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 ← 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 forall {f :: * -> *} {a} {p}.
Applicative f =>
Ptr a -> p -> f (ForeignPtr Word8, Int)
doneH forall {p} {p}. p -> p -> BuildStep a -> IO (ForeignPtr Word8, Int)
fullH forall a. HasCallStack => a
undefined BufferRange
br
      forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Word8
fpbuf
      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))