{-# LANGUAGE MagicHash, UnboxedTuples #-}
-- | Published almost entirely for benchmarks, comparing to stdlib!
-- Should have little direct interest to Harfbuzz callers, & I'm not promising a stable API.
-- This is here because, as it turns out, Harfbuzz can return a lot of output!
module Data.Text.Glyphize.Array where

import Foreign.Storable (Storable(..))
import Foreign.ForeignPtr (ForeignPtr, plusForeignPtr, withForeignPtr, mallocForeignPtrArray)
import Foreign.Ptr
import Foreign.Marshal.Array (copyArray)

import GHC.IO (IO(IO))
import GHC.Exts (realWorld#, oneShot)

-- | Clone the given array so it can be freed without the losing access to the data.
-- Uses `memcpy` so it gets very heavily optimized by the OS.
clonePtr :: Storable a => Ptr a -> Int -> IO (ForeignPtr a)
clonePtr :: forall a. Storable a => Ptr a -> Int -> IO (ForeignPtr a)
clonePtr Ptr a
ptr Int
l = do
    ForeignPtr a
ret <- forall a. Storable a => Int -> IO (ForeignPtr a)
mallocForeignPtrArray Int
l
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
ret forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr' -> forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray Ptr a
ptr' Ptr a
ptr Int
l
    forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr a
ret
-- | Iterate over an array in a ForeignPtr, no matter how small or large it is.
peekLazy :: Storable a => ForeignPtr a -> Int -> [a]
peekLazy :: forall a. Storable a => ForeignPtr a -> Int -> [a]
peekLazy ForeignPtr a
fp Int
0 = []
peekLazy ForeignPtr a
fp Int
n
    | Int
n forall a. Ord a => a -> a -> Bool
<= Int
chunkSize = forall {c}. (Ptr a -> IO c) -> c
withFP forall a b. (a -> b) -> a -> b
$ forall a. Storable a => [a] -> Int -> Ptr a -> IO [a]
peekEager [] Int
n
    | Bool
otherwise = forall {c}. (Ptr a -> IO c) -> c
withFP forall a b. (a -> b) -> a -> b
$ forall a. Storable a => [a] -> Int -> Ptr a -> IO [a]
peekEager (forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr a
fp Int
chunkSize forall a. Storable a => ForeignPtr a -> Int -> [a]
`peekLazy` (-) Int
n Int
chunkSize) Int
chunkSize
  where withFP :: (Ptr a -> IO c) -> c
withFP = forall a. IO a -> a
accursedUnutterablePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fp
-- | Variation of peekArray, taking a tail to append to the decoded list.
peekEager :: Storable a => [a] -> Int -> Ptr a -> IO [a]
peekEager :: forall a. Storable a => [a] -> Int -> Ptr a -> IO [a]
peekEager [a]
acc Int
0 Ptr a
ptr = forall (m :: * -> *) a. Monad m => a -> m a
return [a]
acc
peekEager [a]
acc Int
n Ptr a
ptr = let n' :: Int
n' = forall a. Enum a => a -> a
pred Int
n in do
    a
e <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr a
ptr Int
n'
    forall a. Storable a => [a] -> Int -> Ptr a -> IO [a]
peekEager (a
eforall a. a -> [a] -> [a]
:[a]
acc) Int
n' Ptr a
ptr
-- | How many words should be decoded by `peekLazy` & `iterateLazy`.
chunkSize :: Int
chunkSize :: Int
chunkSize = Int
1024 -- 4k, benchmarks seem to like it!
-- | Convert an array from C code into a Haskell list,
-- performant no matter how small or large it is.
iterateLazy :: Storable a => Ptr a -> Int -> IO [a]
iterateLazy :: forall a. Storable a => Ptr a -> Int -> IO [a]
iterateLazy Ptr a
ptr Int
l
  | Int
l forall a. Ord a => a -> a -> Bool
< Int
0 = String -> IO ()
putStrLn (String
"Invalid array length: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
l) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return []
  | Int
l forall a. Eq a => a -> a -> Bool
== Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return []
  | Bool
otherwise = do
    ForeignPtr a
fp <- forall a. Storable a => Ptr a -> Int -> IO (ForeignPtr a)
clonePtr Ptr a
ptr Int
l
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> a -> b
noCache forall a. Storable a => ForeignPtr a -> Int -> [a]
peekLazy ForeignPtr a
fp forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum Int
l

-- | This \"function\" has a superficial similarity to 'System.IO.Unsafe.unsafePerformIO' but
-- it is in fact a malevolent agent of chaos. It unpicks the seams of reality
-- (and the 'IO' monad) so that the normal rules no longer apply. It lulls you
-- into thinking it is reasonable, but when you are not looking it stabs you
-- in the back and aliases all of your mutable buffers. The carcass of many a
-- seasoned Haskell programmer lie strewn at its feet.
--
-- Witness the trail of destruction:
--
-- * <https://github.com/haskell/bytestring/commit/71c4b438c675aa360c79d79acc9a491e7bbc26e7>
--
-- * <https://github.com/haskell/bytestring/commit/210c656390ae617d9ee3b8bcff5c88dd17cef8da>
--
-- * <https://github.com/haskell/aeson/commit/720b857e2e0acf2edc4f5512f2b217a89449a89d>
--
-- * <https://ghc.haskell.org/trac/ghc/ticket/3486>
--
-- * <https://ghc.haskell.org/trac/ghc/ticket/3487>
--
-- * <https://ghc.haskell.org/trac/ghc/ticket/7270>
--
-- * <https://gitlab.haskell.org/ghc/ghc/-/issues/22204>
--
-- Do not talk about \"safe\"! You do not know what is safe!
--
-- Yield not to its blasphemous call! Flee traveller! Flee or you will be
-- corrupted and devoured!
--
{-# INLINE accursedUnutterablePerformIO #-}
accursedUnutterablePerformIO :: IO a -> a
accursedUnutterablePerformIO :: forall a. IO a -> a
accursedUnutterablePerformIO (IO State# RealWorld -> (# State# RealWorld, a #)
m) = case State# RealWorld -> (# State# RealWorld, a #)
m State# RealWorld
realWorld# of (# State# RealWorld
_, a
r #) -> a
r

-- | Harfbuzz produces ~40x as much output data as its input data.
-- In many applications that input data would be a large fraction of its heap.
-- As such, unless callers are processing these results, it is usually more
-- efficient for Haskell to recompute the glyphs than to store them.
--
-- This synonym of `oneShot` is used to instruct Haskell of this fact.
noCache :: (a -> b) -> a -> b
noCache :: forall a b. (a -> b) -> a -> b
noCache = oneShot :: forall a b. (a -> b) -> a -> b
oneShot