-- |
-- 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 the decimal representation of a 'Double'.
--
-- Matches 'show' in displaying in standard or scientific notation:
--
-- >>> runBuffer (\b -> b |>% 123.456)
-- "123.456"
--
-- >>> runBuffer (\b -> b |>% 1.23e7)
-- "1.23e7"
(|>%) ∷ 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 the decimal representation of a 'Double'.
--
-- Matches 'show' in displaying in standard or scientific notation
-- (see examples in @'(|>%)'@).
(%<|) ∷ 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 a. a -> ST s a
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 a. a -> ST s a
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 a b. IO a -> (a -> IO b) -> IO b
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 a -> p -> f (ForeignPtr Word8, Int)
doneH Ptr a
op' p
_ = (ForeignPtr Word8, Int) -> f (ForeignPtr Word8, Int)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignPtr Word8
fpbuf, Ptr a
op' Ptr a -> 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 :: p -> p -> BuildStep a -> IO (ForeignPtr Word8, Int)
fullH p
_ p
_ BuildStep a
nextStep = Int -> IO Buffer
BBI.newBuffer Int
maxDblLen IO Buffer
-> (Buffer -> IO (ForeignPtr Word8, Int))
-> IO (ForeignPtr Word8, Int)
forall a b. IO a -> (a -> IO b) -> IO b
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)
forall {f :: * -> *} {a} {p}.
Applicative f =>
Ptr a -> p -> f (ForeignPtr Word8, Int)
doneH Ptr Word8 -> Int -> BuildStep a -> IO (ForeignPtr Word8, Int)
forall {p} {p}. p -> p -> 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 a. a -> IO a
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))