    -- |
    -- 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 Word8 -> a -> IO (ForeignPtr Word8, Int)
    doneH Ptr Word8
    op' a
    _ = (ForeignPtr Word8, Int) -> IO (ForeignPtr Word8, Int)
    forall a. a -> IO a
    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 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
          res ← BuildStep a
    -> (Ptr Word8 -> a -> IO (ForeignPtr Word8, Int))
    -> (Ptr Word8 -> Int -> BuildStep a -> IO (ForeignPtr Word8, Int))
    -> (Ptr Word8
        -> StrictByteString -> 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 -> StrictByteString -> 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
    -> StrictByteString -> BuildStep a -> IO (ForeignPtr Word8, Int)
    forall a. HasCallStack => a
    undefined BufferRange
    br
          touchForeignPtr fpbuf
          return res

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