{-# LANGUAGE MagicHash, UnliftedFFITypes, DeriveGeneric #-}
module Data.Text.Glyphize.Buffer where

import qualified Data.Text.Internal.Lazy as Lazy
import qualified Data.Text.Lazy as Lazy (Text, pack)
import qualified Data.Text.Internal as Txt
import Data.Char (toUpper, toLower)
import Control.Monad (forM)
import Control.Exception (bracket)
import Control.DeepSeq (NFData)

import Data.Text.Glyphize.Oom (throwFalse, throwNull)
import Data.Text.Glyphize.Array (iterateLazy, noCache)

import qualified Data.Text.Array as A
import GHC.Exts (ByteArray#, sizeofByteArray#, Int#)
import Data.Word (Word32)
import Data.Int (Int32)
import Data.Bits ((.|.), (.&.), shiftR, shiftL, testBit)

import System.IO.Unsafe (unsafePerformIO)

import Foreign.Marshal.Alloc (alloca, allocaBytes)
import Foreign.Marshal.Array (peekArray)
import Foreign.Ptr
import Foreign.C.String (CString, withCString, peekCString)
import Foreign.Storable (Storable(..))
import GHC.Generics (Generic(..))
import Foreign.Storable.Generic (GStorable(..))

------
--- Public Datastructures
------

-- | Text to be shaped or the resulting glyphs, for which language/script/direction/etc.
data Buffer = Buffer {
    Buffer -> Text
text :: Lazy.Text,
    -- ^ The Unicode text, in visual order, for HarfBuzz to convert into glyphs.
    -- See https://hackage.haskell.org/package/text-2.0.1/docs/Data-Text-Internal-Lazy.html#t:Text for details.
    Buffer -> Maybe ContentType
contentType :: Maybe ContentType,
    -- ^ What the bytes of the ByteString contents represents,
    -- namely unicode characters (before shaping) or glyphs (result of shaping).
    -- Typically callers should leave this as `Just ContentTypeUnicode`.
    Buffer -> Maybe Direction
direction :: Maybe Direction,
    -- ^ The text flow direction of the buffer.
    -- No shaping can happen without setting buffer direction, and it controls
    -- the visual direction for the output glyphs; for RTL direction the glyphs
    -- will be reversed. Many layout features depend on the proper setting of
    -- the direction, for example, reversing RTL text before shaping,
    -- then shaping with LTR direction is not the same as keeping the text in
    -- logical order and shaping with RTL direction.
    Buffer -> Maybe String
script :: Maybe String,
    -- ^ Script is crucial for choosing the proper shaping behaviour for scripts
    -- that require it (e.g. Arabic) and the which OpenType features defined in
    -- the font to be applied.
    Buffer -> Maybe String
language :: Maybe String,
    -- ^ Languages are crucial for selecting which OpenType feature to apply to
    -- the buffer which can result in applying language-specific behaviour.
    -- Languages are orthogonal to the scripts, and though they are related,
    -- they are different concepts and should not be confused with each other.
    Buffer -> Bool
beginsText :: Bool,
    -- ^ special handling of the beginning of text paragraph can be applied to
    -- this buffer. Should usually be set, unless you are passing to the buffer
    -- only part of the text without the full context.
    Buffer -> Bool
endsText :: Bool,
    -- ^ special handling of the end of text paragraph can be applied to this buffer.
    Buffer -> Bool
preserveDefaultIgnorables :: Bool,
    -- ^ character with Default_Ignorable Unicode property should use the
    -- corresponding glyph from the font, instead of hiding them (done by
    -- replacing them with the space glyph and zeroing the advance width.)
    -- Takes precedance over `removeDefaultIgnorables`.
    Buffer -> Bool
removeDefaultIgnorables :: Bool,
    -- ^ character with Default_Ignorable Unicode property should be removed
    -- from glyph string instead of hiding them (done by replacing them with
    -- the space glyph and zeroing the advance width.)
    Buffer -> Bool
don'tInsertDottedCircle :: Bool,
    -- ^ a dotted circle should not be inserted in the rendering of incorrect
    -- character sequences (such as <0905 093E>).
    Buffer -> ClusterLevel
clusterLevel :: ClusterLevel,
    -- ^ dictates one aspect of how HarfBuzz will treat non-base characters
    -- during shaping.
    Buffer -> Char
invisibleGlyph :: Char,
    -- ^ The glyph number that replaces invisible characters in the
    -- shaping result. If set to zero (default), the glyph for the U+0020
    -- SPACE character is used. Otherwise, this value is used verbatim.
    Buffer -> Char
replacementCodepoint :: Char,
    -- ^ the glyph number that replaces invalid entries for a given encoding
    -- when adding text to buffer.
    Buffer -> Char
notFoundGlyph :: Char
    -- ^ the glyph number that replaces replaces characters not found in the font.
  } deriving (Buffer -> Buffer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Buffer -> Buffer -> Bool
$c/= :: Buffer -> Buffer -> Bool
== :: Buffer -> Buffer -> Bool
$c== :: Buffer -> Buffer -> Bool
Eq, Int -> Buffer -> ShowS
[Buffer] -> ShowS
Buffer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Buffer] -> ShowS
$cshowList :: [Buffer] -> ShowS
show :: Buffer -> String
$cshow :: Buffer -> String
showsPrec :: Int -> Buffer -> ShowS
$cshowsPrec :: Int -> Buffer -> ShowS
Show, ReadPrec [Buffer]
ReadPrec Buffer
Int -> ReadS Buffer
ReadS [Buffer]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Buffer]
$creadListPrec :: ReadPrec [Buffer]
readPrec :: ReadPrec Buffer
$creadPrec :: ReadPrec Buffer
readList :: ReadS [Buffer]
$creadList :: ReadS [Buffer]
readsPrec :: Int -> ReadS Buffer
$creadsPrec :: Int -> ReadS Buffer
Read, Eq Buffer
Buffer -> Buffer -> Bool
Buffer -> Buffer -> Ordering
Buffer -> Buffer -> Buffer
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Buffer -> Buffer -> Buffer
$cmin :: Buffer -> Buffer -> Buffer
max :: Buffer -> Buffer -> Buffer
$cmax :: Buffer -> Buffer -> Buffer
>= :: Buffer -> Buffer -> Bool
$c>= :: Buffer -> Buffer -> Bool
> :: Buffer -> Buffer -> Bool
$c> :: Buffer -> Buffer -> Bool
<= :: Buffer -> Buffer -> Bool
$c<= :: Buffer -> Buffer -> Bool
< :: Buffer -> Buffer -> Bool
$c< :: Buffer -> Buffer -> Bool
compare :: Buffer -> Buffer -> Ordering
$ccompare :: Buffer -> Buffer -> Ordering
Ord)

-- | Whether the given text is Unicode or font-specific "glyphs".
data ContentType = ContentTypeUnicode | ContentTypeGlyphs deriving (ContentType -> ContentType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentType -> ContentType -> Bool
$c/= :: ContentType -> ContentType -> Bool
== :: ContentType -> ContentType -> Bool
$c== :: ContentType -> ContentType -> Bool
Eq, Int -> ContentType -> ShowS
[ContentType] -> ShowS
ContentType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContentType] -> ShowS
$cshowList :: [ContentType] -> ShowS
show :: ContentType -> String
$cshow :: ContentType -> String
showsPrec :: Int -> ContentType -> ShowS
$cshowsPrec :: Int -> ContentType -> ShowS
Show, ReadPrec [ContentType]
ReadPrec ContentType
Int -> ReadS ContentType
ReadS [ContentType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ContentType]
$creadListPrec :: ReadPrec [ContentType]
readPrec :: ReadPrec ContentType
$creadPrec :: ReadPrec ContentType
readList :: ReadS [ContentType]
$creadList :: ReadS [ContentType]
readsPrec :: Int -> ReadS ContentType
$creadsPrec :: Int -> ReadS ContentType
Read, Eq ContentType
ContentType -> ContentType -> Bool
ContentType -> ContentType -> Ordering
ContentType -> ContentType -> ContentType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ContentType -> ContentType -> ContentType
$cmin :: ContentType -> ContentType -> ContentType
max :: ContentType -> ContentType -> ContentType
$cmax :: ContentType -> ContentType -> ContentType
>= :: ContentType -> ContentType -> Bool
$c>= :: ContentType -> ContentType -> Bool
> :: ContentType -> ContentType -> Bool
$c> :: ContentType -> ContentType -> Bool
<= :: ContentType -> ContentType -> Bool
$c<= :: ContentType -> ContentType -> Bool
< :: ContentType -> ContentType -> Bool
$c< :: ContentType -> ContentType -> Bool
compare :: ContentType -> ContentType -> Ordering
$ccompare :: ContentType -> ContentType -> Ordering
Ord)
-- | Defines how fine the groupings represented by `GlyphInfo`'s `cluster` property are.`
data ClusterLevel = ClusterMonotoneGraphemes | ClusterMonotoneChars | ClusterChars
    deriving (ClusterLevel -> ClusterLevel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClusterLevel -> ClusterLevel -> Bool
$c/= :: ClusterLevel -> ClusterLevel -> Bool
== :: ClusterLevel -> ClusterLevel -> Bool
$c== :: ClusterLevel -> ClusterLevel -> Bool
Eq, Int -> ClusterLevel -> ShowS
[ClusterLevel] -> ShowS
ClusterLevel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClusterLevel] -> ShowS
$cshowList :: [ClusterLevel] -> ShowS
show :: ClusterLevel -> String
$cshow :: ClusterLevel -> String
showsPrec :: Int -> ClusterLevel -> ShowS
$cshowsPrec :: Int -> ClusterLevel -> ShowS
Show, ReadPrec [ClusterLevel]
ReadPrec ClusterLevel
Int -> ReadS ClusterLevel
ReadS [ClusterLevel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ClusterLevel]
$creadListPrec :: ReadPrec [ClusterLevel]
readPrec :: ReadPrec ClusterLevel
$creadPrec :: ReadPrec ClusterLevel
readList :: ReadS [ClusterLevel]
$creadList :: ReadS [ClusterLevel]
readsPrec :: Int -> ReadS ClusterLevel
$creadsPrec :: Int -> ReadS ClusterLevel
Read, Eq ClusterLevel
ClusterLevel -> ClusterLevel -> Bool
ClusterLevel -> ClusterLevel -> Ordering
ClusterLevel -> ClusterLevel -> ClusterLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ClusterLevel -> ClusterLevel -> ClusterLevel
$cmin :: ClusterLevel -> ClusterLevel -> ClusterLevel
max :: ClusterLevel -> ClusterLevel -> ClusterLevel
$cmax :: ClusterLevel -> ClusterLevel -> ClusterLevel
>= :: ClusterLevel -> ClusterLevel -> Bool
$c>= :: ClusterLevel -> ClusterLevel -> Bool
> :: ClusterLevel -> ClusterLevel -> Bool
$c> :: ClusterLevel -> ClusterLevel -> Bool
<= :: ClusterLevel -> ClusterLevel -> Bool
$c<= :: ClusterLevel -> ClusterLevel -> Bool
< :: ClusterLevel -> ClusterLevel -> Bool
$c< :: ClusterLevel -> ClusterLevel -> Bool
compare :: ClusterLevel -> ClusterLevel -> Ordering
$ccompare :: ClusterLevel -> ClusterLevel -> Ordering
Ord)

-- | An empty buffer with sensible default properties.
defaultBuffer :: Buffer
defaultBuffer = Buffer {
        text :: Text
text = Text
Lazy.empty,
        contentType :: Maybe ContentType
contentType = forall a. a -> Maybe a
Just ContentType
ContentTypeUnicode,
        direction :: Maybe Direction
direction = forall a. Maybe a
Nothing,
        script :: Maybe String
script = forall a. Maybe a
Nothing,
        language :: Maybe String
language = forall a. Maybe a
Nothing,
        beginsText :: Bool
beginsText = Bool
True,
        endsText :: Bool
endsText = Bool
True,
        preserveDefaultIgnorables :: Bool
preserveDefaultIgnorables = Bool
False,
        removeDefaultIgnorables :: Bool
removeDefaultIgnorables = Bool
False,
        don'tInsertDottedCircle :: Bool
don'tInsertDottedCircle = Bool
False,
        clusterLevel :: ClusterLevel
clusterLevel = ClusterLevel
ClusterMonotoneGraphemes,
        invisibleGlyph :: Char
invisibleGlyph = Char
' ',
        replacementCodepoint :: Char
replacementCodepoint = Char
'\xFFFD',
        notFoundGlyph :: Char
notFoundGlyph = Char
'\0'
    }

------
--- Directions
------

-- | The direction of a text segment or buffer.
data Direction = DirLTR | DirRTL | DirTTB | DirBTT deriving (Direction -> Direction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq, Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Direction] -> ShowS
$cshowList :: [Direction] -> ShowS
show :: Direction -> String
$cshow :: Direction -> String
showsPrec :: Int -> Direction -> ShowS
$cshowsPrec :: Int -> Direction -> ShowS
Show, ReadPrec [Direction]
ReadPrec Direction
Int -> ReadS Direction
ReadS [Direction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Direction]
$creadListPrec :: ReadPrec [Direction]
readPrec :: ReadPrec Direction
$creadPrec :: ReadPrec Direction
readList :: ReadS [Direction]
$creadList :: ReadS [Direction]
readsPrec :: Int -> ReadS Direction
$creadsPrec :: Int -> ReadS Direction
Read, Eq Direction
Direction -> Direction -> Bool
Direction -> Direction -> Ordering
Direction -> Direction -> Direction
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Direction -> Direction -> Direction
$cmin :: Direction -> Direction -> Direction
max :: Direction -> Direction -> Direction
$cmax :: Direction -> Direction -> Direction
>= :: Direction -> Direction -> Bool
$c>= :: Direction -> Direction -> Bool
> :: Direction -> Direction -> Bool
$c> :: Direction -> Direction -> Bool
<= :: Direction -> Direction -> Bool
$c<= :: Direction -> Direction -> Bool
< :: Direction -> Direction -> Bool
$c< :: Direction -> Direction -> Bool
compare :: Direction -> Direction -> Ordering
$ccompare :: Direction -> Direction -> Ordering
Ord)
-- | Converts a string to an `Direction`.
-- Matching is loose and applies only to the first letter. For examples, 
-- "LTR" and "left-to-right" will both return HB_DIRECTION_LTR.
dirFromStr :: String -> Maybe Direction
dirFromStr (Char
'L':String
_) = forall a. a -> Maybe a
Just Direction
DirLTR
dirFromStr (Char
'l':String
_) = forall a. a -> Maybe a
Just Direction
DirLTR
dirFromStr (Char
'R':String
_) = forall a. a -> Maybe a
Just Direction
DirRTL
dirFromStr (Char
'r':String
_) = forall a. a -> Maybe a
Just Direction
DirRTL
dirFromStr (Char
'T':String
_) = forall a. a -> Maybe a
Just Direction
DirTTB
dirFromStr (Char
't':String
_) = forall a. a -> Maybe a
Just Direction
DirTTB
dirFromStr (Char
'B':String
_) = forall a. a -> Maybe a
Just Direction
DirBTT
dirFromStr (Char
'b':String
_) = forall a. a -> Maybe a
Just Direction
DirBTT
dirFromStr String
_ = forall a. Maybe a
Nothing
-- | Converts an `Direction` to a string.
dirToStr :: Direction -> String
dirToStr Direction
DirLTR = String
"ltr"
dirToStr Direction
DirRTL = String
"rtl"
dirToStr Direction
DirTTB = String
"ttb"
dirToStr Direction
DirBTT = String
"btt"
-- | Reverses a text direction.
dirReverse :: Direction -> Direction
dirReverse Direction
DirLTR = Direction
DirRTL
dirReverse Direction
DirRTL = Direction
DirLTR
dirReverse Direction
DirTTB = Direction
DirBTT
dirReverse Direction
DirBTT = Direction
DirTTB
-- | Tests whether a text direction moves backward
-- (from right to left, or from bottom to top).
dirBackward :: Direction -> Bool
dirBackward Direction
dir = Direction
dir forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem` [Direction
DirRTL, Direction
DirBTT]
-- | Tests whether a text direction moves forward
-- (from left to right, or from top to bottom).
dirForward :: Direction -> Bool
dirForward Direction
dir = Direction
dir forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem` [Direction
DirLTR, Direction
DirTTB]
-- | Tests whether a text direction is horizontal.
dirHorizontal :: Direction -> Bool
dirHorizontal Direction
dir = Direction
dir forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem` [Direction
DirLTR, Direction
DirRTL]
-- | Tests whether a text direction is vertical.
dirVertical :: Direction -> Bool
dirVertical Direction
dir = Direction
dir forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem` [Direction
DirTTB, Direction
DirBTT]

-- | Converts a `Direction` to C encoding.
dir2int :: Maybe Direction -> a
dir2int Maybe Direction
Nothing = a
0
dir2int (Just Direction
DirLTR) = a
4
dir2int (Just Direction
DirRTL) = a
5
dir2int (Just Direction
DirTTB) = a
6
dir2int (Just Direction
DirBTT) = a
7
-- | Sets `direction` property on C `Buffer'` struct.
foreign import ccall "hb_buffer_set_direction" hb_buffer_set_direction
    :: Buffer' -> Int -> IO ()

-- | Converts a `Direction` from C encoding.
int2dir :: a -> Maybe Direction
int2dir a
4 = forall a. a -> Maybe a
Just Direction
DirLTR
int2dir a
5 = forall a. a -> Maybe a
Just Direction
DirRTL
int2dir a
6 = forall a. a -> Maybe a
Just Direction
DirTTB
int2dir a
7 = forall a. a -> Maybe a
Just Direction
DirBTT
int2dir a
_ = forall a. Maybe a
Nothing

-- | Fetches the `Direction` of a script when it is set horizontally.
-- All right-to-left scripts will return `DirRTL`.
-- All left-to-right scripts will return `DirLTR`.
-- Scripts that can be written either horizontally or vertically will return `Nothing`.
-- Unknown scripts will return `DirLTR`.
scriptHorizontalDir :: String -> Maybe Direction
scriptHorizontalDir :: String -> Maybe Direction
scriptHorizontalDir = forall {a}. (Eq a, Num a) => a -> Maybe Direction
int2dir forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
hb_script_get_horizontal_direction forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Word32
script_from_string
foreign import ccall "hb_script_get_horizontal_direction" hb_script_get_horizontal_direction
    :: Word32 -> Int

------
--- Locales
------
data Language'
-- | Represents a natural written language.
-- Corresponds to a BCP47 language tag.
type Language = Ptr Language'
-- | Fetch the default language from current locale.
-- NOTE that the first time this function is called, it calls (C code)
-- "setlocale (LC_CTYPE, nullptr)" to fetch current locale.
-- The underlying setlocale function is, in many implementations, NOT threadsafe.
-- To avoid problems, call this function once before multiple threads can call it.
-- This function may be used to fill in missing fields on a `Buffer`.
languageDefault :: IO String
languageDefault :: IO String
languageDefault = IO Language
hb_language_get_default forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Language -> IO CString
hb_language_to_string forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString
foreign import ccall "hb_language_to_string" hb_language_to_string :: Language -> IO CString
foreign import ccall "hb_language_get_default" hb_language_get_default :: IO Language

-- | Converts a `String` representing a BCP 47 language tag to the corresponding `Language`.
hb_language_from_string :: String -> IO Language
hb_language_from_string :: String -> IO Language
hb_language_from_string String
str =
    forall a. String -> (CString -> IO a) -> IO a
withCString String
str forall a b. (a -> b) -> a -> b
$ \CString
str' -> CString -> Int -> IO Language
hb_language_from_string' CString
str' (-Int
1)
foreign import ccall "hb_language_from_string" hb_language_from_string'
    :: CString -> Int -> IO Language

{-
-- | Check whether a second language tag is the same or a more specific version
-- of the provided language tag.
-- For example, "fa_IR.utf8" is a more specific tag for "fa" or for "fa_IR".
languageMatches :: String -> String -> Bool
languageMatches lang specific = unsafePerformIO $ do
    lang' <- hb_language_from_string lang
    specific' <- hb_language_from_string specific
    hb_language_matches lang' specific'
foreign import ccall "hb_language_matches" hb_language_matches :: Language -> Language -> IO Bool-}

------
--- FFI Support
------

-- | Directly corresponds to "hb_buffer_t".
data Buffer''
type Buffer' = Ptr Buffer''

-- | Temporarily allocates a `Buffer'`
withNewBuffer :: (Buffer' -> IO a) -> IO a
withNewBuffer :: forall a. (Buffer' -> IO a) -> IO a
withNewBuffer Buffer' -> IO a
cb = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO Buffer'
hb_buffer_create Buffer' -> IO ()
hb_buffer_destroy Buffer' -> IO a
cb
foreign import ccall "hb_buffer_create" hb_buffer_create :: IO Buffer'
foreign import ccall "hb_buffer_destroy" hb_buffer_destroy :: Buffer' -> IO ()

-- | Decodes given lazy `Text` into given `Buffer'`.
-- Should be valid Unicode data.
-- Captures a few trailing & preceding chars when possible to give additional
-- context to the shaping.
bufferWithText :: Buffer' -> Text -> IO b -> IO b
bufferWithText Buffer'
_ Text
Lazy.Empty IO b
cb = IO b
cb
bufferWithText Buffer'
buffer txt :: Text
txt@(Lazy.Chunk (Txt.Text (A.ByteArray ByteArray#
arr) Int
offset Int
length) Text
txts) IO b
cb = do
    Buffer' -> ByteArray# -> Int# -> Word -> Int -> IO ()
hb_buffer_add_utf8 Buffer'
buffer ByteArray#
arr (ByteArray# -> Int#
sizeofByteArray# ByteArray#
arr) (forall a. Enum a => Int -> a
toEnum Int
offset) Int
length
    Buffer' -> Text -> IO b -> IO b
bufferWithText Buffer'
buffer Text
txts IO b
cb
foreign import ccall "hb_buffer_add_utf8" hb_buffer_add_utf8
    :: Buffer' -> ByteArray# -> Int# -> Word -> Int -> IO ()

-- | Converts initial char to uppercase & all others to lowercase.
-- Internal utility for reimplementation `script_from_string`.
titlecase :: String -> String
titlecase :: ShowS
titlecase String
"" = String
""
titlecase (Char
c:String
cs) = Char -> Char
toUpper Char
c forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
Prelude.map Char -> Char
toLower String
cs
-- | Converts a string str representing an ISO 15924 script tag to a corresponding "tag" `Word32`.
script_from_string :: String -> Word32
script_from_string :: String -> Word32
script_from_string String
str = String -> Word32
tag_from_string forall a b. (a -> b) -> a -> b
$ case ShowS
titlecase String
str of
    Char
'Q':Char
'a':Char
'a':Char
'i':String
_ -> String
"Zinh"
    Char
'Q':Char
'a':Char
'a':Char
'c':String
_ -> String
"Copt"

    Char
'A':Char
'r':Char
'a':Char
'n':String
_ -> String
"Arab"
    Char
'C':Char
'y':Char
'r':Char
's':String
_ -> String
"Cyrl"
    Char
'G':Char
'e':Char
'o':Char
'k':String
_ -> String
"Geor"
    Char
'H':Char
'a':Char
'n':Char
's':String
_ -> String
"Hani"
    Char
'H':Char
'a':Char
'n':Char
't':String
_ -> String
"Hani"
    Char
'J':Char
'a':Char
'm':Char
'o':String
_ -> String
"Hang"
    Char
'L':Char
'a':Char
't':Char
'f':String
_ -> String
"Latn"
    Char
'L':Char
'a':Char
't':Char
'g':String
_ -> String
"Latn"
    Char
'S':Char
'y':Char
'r':Char
'e':String
_ -> String
"Syrc"
    Char
'S':Char
'y':Char
'r':Char
'j':String
_ -> String
"Syrc"
    Char
'S':Char
'y':Char
'r':Char
'n':String
_ -> String
"Syrc"
    String
x -> String
x
-- | Converts a `String` into a "tag" `Word32`. Valid tags are 4 `Char`s.
-- Shorter input `String`s will be padded with spaces.
-- Longer input strings will be truncated.
tag_from_string :: String -> Word32
tag_from_string :: String -> Word32
tag_from_string String
str = case String
str forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
Prelude.repeat Char
' ' of
    Char
c1:Char
c2:Char
c3:Char
c4:String
_ -> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude.foldl forall a. Bits a => a -> a -> a
(.|.) Word32
0 [
        forall a. Bits a => a -> Int -> a
shiftL (Char -> Word32
c2w Char
c1 forall a. Bits a => a -> a -> a
.&. Word32
0x7f) Int
24,
        forall a. Bits a => a -> Int -> a
shiftL (Char -> Word32
c2w Char
c2 forall a. Bits a => a -> a -> a
.&. Word32
0x7f) Int
16,
        forall a. Bits a => a -> Int -> a
shiftL (Char -> Word32
c2w Char
c3 forall a. Bits a => a -> a -> a
.&. Word32
0x7f) Int
8,
        forall a. Bits a => a -> Int -> a
shiftL (Char -> Word32
c2w Char
c4 forall a. Bits a => a -> a -> a
.&. Word32
0x7f) Int
0
      ]
    String
_ -> Word32
0
-- | Converts a "tag" `Word32` into a 4 `Char` `String`.
tag_to_string :: Word32 -> String
tag_to_string :: Word32 -> String
tag_to_string Word32
tag = [
    Word32 -> Char
w2c (forall a. Bits a => a -> Int -> a
shiftR Word32
tag Int
24 forall a. Bits a => a -> a -> a
.&. Word32
0x7f),
    Word32 -> Char
w2c (forall a. Bits a => a -> Int -> a
shiftR Word32
tag Int
16 forall a. Bits a => a -> a -> a
.&. Word32
0x7f),
    Word32 -> Char
w2c (forall a. Bits a => a -> Int -> a
shiftR Word32
tag Int
8 forall a. Bits a => a -> a -> a
.&. Word32
0x7f),
    Word32 -> Char
w2c (forall a. Bits a => a -> Int -> a
shiftR Word32
tag Int
0 forall a. Bits a => a -> a -> a
.&. Word32
0x7f)
  ]

c2w :: Char -> Word32
c2w :: Char -> Word32
c2w = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum
w2c :: Word32 -> Char
w2c :: Word32 -> Char
w2c = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

------
--- Haskell-to-C conversion
------

-- | Temporarily allocates a `Buffer'` corresponding to the given `Buffer`
-- to be processed entirely within the given callback.
withBuffer :: Buffer -> (Buffer' -> IO a) -> IO a
withBuffer :: forall a. Buffer -> (Buffer' -> IO a) -> IO a
withBuffer Buffer
buf Buffer' -> IO a
cb = forall a. (Buffer' -> IO a) -> IO a
withNewBuffer forall a b. (a -> b) -> a -> b
$ \Buffer'
buf' -> forall {b}. Buffer' -> Text -> IO b -> IO b
bufferWithText Buffer'
buf' (Buffer -> Text
text Buffer
buf) forall a b. (a -> b) -> a -> b
$ do
    Buffer' -> Int -> IO ()
hb_buffer_set_content_type Buffer'
buf' forall a b. (a -> b) -> a -> b
$ case Buffer -> Maybe ContentType
contentType Buffer
buf of
        Maybe ContentType
Nothing -> Int
0
        Just ContentType
ContentTypeUnicode -> Int
1
        Just ContentType
ContentTypeGlyphs -> Int
2
    Buffer' -> Int -> IO ()
hb_buffer_set_direction Buffer'
buf' forall a b. (a -> b) -> a -> b
$ forall {a}. Num a => Maybe Direction -> a
dir2int forall a b. (a -> b) -> a -> b
$ Buffer -> Maybe Direction
direction Buffer
buf
    case Buffer -> Maybe String
script Buffer
buf of
        Just String
script' -> Buffer' -> Word32 -> IO ()
hb_buffer_set_script Buffer'
buf' forall a b. (a -> b) -> a -> b
$ String -> Word32
script_from_string String
script'
        Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    case Buffer -> Maybe String
language Buffer
buf of
        Just String
lang' -> Buffer' -> Language -> IO ()
hb_buffer_set_language Buffer'
buf' forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO Language
hb_language_from_string String
lang'
        Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Buffer' -> Int -> IO ()
hb_buffer_set_flags Buffer'
buf' forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude.foldl forall a. Bits a => a -> a -> a
(.|.) Int
0 [
        if Buffer -> Bool
beginsText Buffer
buf then Int
1 else Int
0,
        if Buffer -> Bool
endsText Buffer
buf then Int
2 else Int
0,
        if Buffer -> Bool
preserveDefaultIgnorables Buffer
buf then Int
4 else Int
0,
        if Buffer -> Bool
removeDefaultIgnorables Buffer
buf then Int
8 else Int
0,
        if Buffer -> Bool
don'tInsertDottedCircle Buffer
buf then Int
16 else Int
0
      ]
    Buffer' -> Int -> IO ()
hb_buffer_set_cluster_level Buffer'
buf' forall a b. (a -> b) -> a -> b
$ case Buffer -> ClusterLevel
clusterLevel Buffer
buf of
        ClusterLevel
ClusterMonotoneGraphemes -> Int
0
        ClusterLevel
ClusterMonotoneChars -> Int
1
        ClusterLevel
ClusterChars -> Int
2
    Buffer' -> Word32 -> IO ()
hb_buffer_set_invisible_glyph Buffer'
buf' forall a b. (a -> b) -> a -> b
$ Char -> Word32
c2w forall a b. (a -> b) -> a -> b
$ Buffer -> Char
invisibleGlyph Buffer
buf
    Buffer' -> Word32 -> IO ()
hb_buffer_set_replacement_codepoint Buffer'
buf' forall a b. (a -> b) -> a -> b
$ Char -> Word32
c2w forall a b. (a -> b) -> a -> b
$ Buffer -> Char
replacementCodepoint Buffer
buf
    Buffer' -> Word32 -> IO ()
hb_buffer_set_not_found_glyph Buffer'
buf' forall a b. (a -> b) -> a -> b
$ Char -> Word32
c2w forall a b. (a -> b) -> a -> b
$ Buffer -> Char
notFoundGlyph Buffer
buf
    case (Buffer -> Maybe ContentType
contentType Buffer
buf, Buffer -> Maybe Direction
direction Buffer
buf, Buffer -> Maybe String
script Buffer
buf, Buffer -> Maybe String
language Buffer
buf) of
        (Just ContentType
ContentTypeUnicode, Maybe Direction
Nothing, Maybe String
_, Maybe String
_) -> Buffer' -> IO ()
hb_buffer_guess_segment_properties Buffer'
buf'
        (Just ContentType
ContentTypeUnicode, Maybe Direction
_, Maybe String
Nothing, Maybe String
_) -> Buffer' -> IO ()
hb_buffer_guess_segment_properties Buffer'
buf'
        (Just ContentType
ContentTypeUnicode, Maybe Direction
_, Maybe String
_, Maybe String
Nothing) -> Buffer' -> IO ()
hb_buffer_guess_segment_properties Buffer'
buf'
        (Maybe ContentType, Maybe Direction, Maybe String, Maybe String)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

    IO Bool -> IO ()
throwFalse forall a b. (a -> b) -> a -> b
$ Buffer' -> IO Bool
hb_buffer_allocation_successful Buffer'
buf'
    Buffer' -> IO a
cb Buffer'
buf'
foreign import ccall "hb_buffer_set_content_type" hb_buffer_set_content_type
    :: Buffer' -> Int -> IO ()
foreign import ccall "hb_buffer_set_script" hb_buffer_set_script
    :: Buffer' -> Word32 -> IO ()
foreign import ccall "hb_buffer_set_language" hb_buffer_set_language
    :: Buffer' -> Language -> IO ()
foreign import ccall "hb_buffer_set_flags" hb_buffer_set_flags :: Buffer' -> Int -> IO ()
foreign import ccall "hb_buffer_set_cluster_level" hb_buffer_set_cluster_level
    :: Buffer' -> Int -> IO ()
foreign import ccall "hb_buffer_set_invisible_glyph" hb_buffer_set_invisible_glyph
    :: Buffer' -> Word32 -> IO ()
foreign import ccall "hb_buffer_set_replacement_codepoint" hb_buffer_set_replacement_codepoint
    :: Buffer' -> Word32 -> IO ()
foreign import ccall "hb_buffer_set_not_found_glyph" hb_buffer_set_not_found_glyph
    :: Buffer' -> Word32 -> IO ()
foreign import ccall "hb_buffer_guess_segment_properties" hb_buffer_guess_segment_properties
    :: Buffer' -> IO ()
foreign import ccall "hb_buffer_allocation_successful" hb_buffer_allocation_successful
    :: Buffer' -> IO Bool

------
--- C-to-Haskell conversion
------

-- | Holds information about the glyphs & their relation to input text.
data GlyphInfo = GlyphInfo {
    GlyphInfo -> Word32
codepoint :: Word32,
    -- ^ Glyph index (or unicode codepoint)
    GlyphInfo -> Word32
cluster :: Word32,
    -- ^ The index of the character in the original text that corresponds to
    -- this `GlyphInfo`. More than one `GlyphInfo` may have the same `cluster`
    -- value if they resulted from the same character, & when more than one
    -- character gets merged into the same glyph `GlyphInfo` will have the
    -- smallest cluster value of them.
    -- By default some characters are merged into the same cluster even when
    -- they are seperate glyphs, `Buffer`'s `clusterLevel` property allows
    -- selecting more fine grained cluster handling.
    GlyphInfo -> Bool
unsafeToBreak :: Bool,
    -- ^ Indicates that if input text is broken at the beginning of the cluster
    -- this glyph is part of, then both sides need to be re-shaped,
    -- as the result might be different.
    -- On the flip side, it means that when this flag is not present,
    -- then it is safe to break the glyph-run at the beginning of this cluster,
    -- and the two sides will represent the exact same result one would get
    -- if breaking input text at the beginning of this cluster and shaping
    -- the two sides separately. This can be used to optimize paragraph layout,
    -- by avoiding re-shaping of each line after line-breaking.
    GlyphInfo -> Bool
unsafeToConcat :: Bool,
    -- ^ Indicates that if input text is changed on one side of the beginning
    -- of the cluster this glyph is part of, then the shaping results for
    -- the other side might change.
    -- Note that the absence of this flag will NOT by itself mean that
    -- it IS safe to concat text. Only two pieces of text both of which
    -- clear of this flag can be concatenated safely.
    -- See https://harfbuzz.github.io/harfbuzz-hb-buffer.html#HB_GLYPH_FLAG_UNSAFE_TO_CONCAT
    -- for more details.
    GlyphInfo -> Bool
safeToInsertTatweel :: Bool
    -- ^ In scripts that use elongation (Arabic, Mongolian, Syriac, etc.),
    -- this flag signifies that it is safe to insert a U+0640 TATWEEL character
    -- before this cluster for elongation.
    -- This flag does not determine the script-specific elongation places,
    -- but only when it is safe to do the elongation without interrupting text shaping.
} deriving (Int -> GlyphInfo -> ShowS
[GlyphInfo] -> ShowS
GlyphInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlyphInfo] -> ShowS
$cshowList :: [GlyphInfo] -> ShowS
show :: GlyphInfo -> String
$cshow :: GlyphInfo -> String
showsPrec :: Int -> GlyphInfo -> ShowS
$cshowsPrec :: Int -> GlyphInfo -> ShowS
Show, ReadPrec [GlyphInfo]
ReadPrec GlyphInfo
Int -> ReadS GlyphInfo
ReadS [GlyphInfo]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GlyphInfo]
$creadListPrec :: ReadPrec [GlyphInfo]
readPrec :: ReadPrec GlyphInfo
$creadPrec :: ReadPrec GlyphInfo
readList :: ReadS [GlyphInfo]
$creadList :: ReadS [GlyphInfo]
readsPrec :: Int -> ReadS GlyphInfo
$creadsPrec :: Int -> ReadS GlyphInfo
Read, GlyphInfo -> GlyphInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlyphInfo -> GlyphInfo -> Bool
$c/= :: GlyphInfo -> GlyphInfo -> Bool
== :: GlyphInfo -> GlyphInfo -> Bool
$c== :: GlyphInfo -> GlyphInfo -> Bool
Eq, forall x. Rep GlyphInfo x -> GlyphInfo
forall x. GlyphInfo -> Rep GlyphInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GlyphInfo x -> GlyphInfo
$cfrom :: forall x. GlyphInfo -> Rep GlyphInfo x
Generic)
instance NFData GlyphInfo
-- | Decodes multiple `GlyphInfo`s from a dereferenced `Word32` list according to
-- Harfbuzz's ABI.
decodeInfos :: [Word32] -> [GlyphInfo]
decodeInfos :: [Word32] -> [GlyphInfo]
decodeInfos (Word32
codepoint':Word32
cluster':Word32
mask:Word32
_:Word32
_:[Word32]
rest) =
    Word32 -> Word32 -> Bool -> Bool -> Bool -> GlyphInfo
GlyphInfo Word32
codepoint' Word32
cluster' (Word32
mask forall a. Bits a => a -> Int -> Bool
`testBit` Int
1) (Word32
mask forall a. Bits a => a -> Int -> Bool
`testBit` Int
2)
        (Word32
mask forall a. Bits a => a -> Int -> Bool
`testBit` Int
3)forall a. a -> [a] -> [a]
:[Word32] -> [GlyphInfo]
decodeInfos [Word32]
rest
decodeInfos [Word32]
_ = []
-- | Decodes `Buffer'`'s glyph information array.
glyphInfos :: Buffer' -> IO [GlyphInfo]
glyphInfos Buffer'
buf' = do
    Ptr Word32
arr <- forall a. IO (Ptr a) -> IO (Ptr a)
throwNull forall a b. (a -> b) -> a -> b
$ Buffer' -> Ptr Word -> IO (Ptr Word32)
hb_buffer_get_glyph_infos Buffer'
buf' forall a. Ptr a
nullPtr
    Word
length <- Buffer' -> IO Word
hb_buffer_get_length Buffer'
buf'
    [Word32]
words <- forall a. Storable a => Ptr a -> Int -> IO [a]
iterateLazy Ptr Word32
arr (forall a. Enum a => a -> Int
fromEnum Word
length forall a. Num a => a -> a -> a
* Int
5)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> a -> b
noCache [Word32] -> [GlyphInfo]
decodeInfos [Word32]
words
foreign import ccall "hb_buffer_get_glyph_infos" hb_buffer_get_glyph_infos
    :: Buffer' -> Ptr Word -> IO (Ptr Word32)
foreign import ccall "hb_buffer_get_length" hb_buffer_get_length :: Buffer' -> IO Word
-- NOTE: The array returned from FFI is valid as long as the buffer is.

-- | Holds positions of the glyph in both horizontal & vertical directions.
-- All positions are relative to current point.
data GlyphPos = GlyphPos {
    GlyphPos -> Int32
x_advance :: Int32,
    -- ^ How much the line advances after drawing this glyph when setting text
    -- in horizontal direction.
    GlyphPos -> Int32
y_advance :: Int32,
    -- ^ How much the line advances after drawing this glyph when setting text
    -- in vertical direction.
    GlyphPos -> Int32
x_offset :: Int32,
    -- ^ How much the glyph moves on the X-axis before drawing it, this should
    -- not effect how much the line advances.
    GlyphPos -> Int32
y_offset :: Int32
    -- ^ How much the glyph moves on the Y-axis before drawing it, this should
    -- not effect how much the line advances.
} deriving (Int -> GlyphPos -> ShowS
[GlyphPos] -> ShowS
GlyphPos -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlyphPos] -> ShowS
$cshowList :: [GlyphPos] -> ShowS
show :: GlyphPos -> String
$cshow :: GlyphPos -> String
showsPrec :: Int -> GlyphPos -> ShowS
$cshowsPrec :: Int -> GlyphPos -> ShowS
Show, ReadPrec [GlyphPos]
ReadPrec GlyphPos
Int -> ReadS GlyphPos
ReadS [GlyphPos]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GlyphPos]
$creadListPrec :: ReadPrec [GlyphPos]
readPrec :: ReadPrec GlyphPos
$creadPrec :: ReadPrec GlyphPos
readList :: ReadS [GlyphPos]
$creadList :: ReadS [GlyphPos]
readsPrec :: Int -> ReadS GlyphPos
$creadsPrec :: Int -> ReadS GlyphPos
Read, GlyphPos -> GlyphPos -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlyphPos -> GlyphPos -> Bool
$c/= :: GlyphPos -> GlyphPos -> Bool
== :: GlyphPos -> GlyphPos -> Bool
$c== :: GlyphPos -> GlyphPos -> Bool
Eq, forall x. Rep GlyphPos x -> GlyphPos
forall x. GlyphPos -> Rep GlyphPos x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GlyphPos x -> GlyphPos
$cfrom :: forall x. GlyphPos -> Rep GlyphPos x
Generic)
instance NFData GlyphPos
-- | Decode multiple `GlyphPos`s from a dereferenced list according to
-- Harfbuzz's ABI.
decodePositions :: [Int32] -> [GlyphPos]
decodePositions (Int32
x_advance':Int32
y_advance':Int32
x_offset':Int32
y_offset':Int32
_:[Int32]
rest) =
    Int32 -> Int32 -> Int32 -> Int32 -> GlyphPos
GlyphPos Int32
x_advance' Int32
y_advance' Int32
x_offset' Int32
y_offset'forall a. a -> [a] -> [a]
:[Int32] -> [GlyphPos]
decodePositions [Int32]
rest
decodePositions [Int32]
_ = []
-- | Decodes `Buffer'`'s glyph position array.
-- If buffer did not have positions before, they will be initialized to zeros.'
glyphsPos :: Buffer' -> IO [GlyphPos]
glyphsPos Buffer'
buf' = do
    Ptr Int32
arr <- forall a. IO (Ptr a) -> IO (Ptr a)
throwNull forall a b. (a -> b) -> a -> b
$ Buffer' -> Ptr Word -> IO (Ptr Int32)
hb_buffer_get_glyph_positions Buffer'
buf' forall a. Ptr a
nullPtr
    Word
length <- Buffer' -> IO Word
hb_buffer_get_length Buffer'
buf'
    [Int32]
words <- forall a. Storable a => Ptr a -> Int -> IO [a]
iterateLazy Ptr Int32
arr (forall a. Enum a => a -> Int
fromEnum Word
length forall a. Num a => a -> a -> a
* Int
5)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> a -> b
noCache [Int32] -> [GlyphPos]
decodePositions [Int32]
words
foreign import ccall "hb_buffer_get_glyph_positions" hb_buffer_get_glyph_positions
    :: Buffer' -> Ptr Word -> IO (Ptr Int32)
-- NOTE: The array returned from FFI is valid as long as the buffer is.

-- | Decodes a `Buffer'` back to corresponding pure-functional `Buffer`.
thawBuffer :: Buffer' -> IO Buffer
thawBuffer :: Buffer' -> IO Buffer
thawBuffer Buffer'
buf' = do
    [GlyphInfo]
glyphInfos' <- Buffer' -> IO [GlyphInfo]
glyphInfos Buffer'
buf'
    Int
contentType' <- Buffer' -> IO Int
hb_buffer_get_content_type Buffer'
buf'
    Int
direction' <- Buffer' -> IO Int
hb_buffer_get_direction Buffer'
buf'
    Word32
script' <- Buffer' -> IO Word32
hb_buffer_get_script Buffer'
buf'
    CString
language'' <- Buffer' -> IO CString
hb_buffer_get_language Buffer'
buf'
    String
language' <- CString -> IO String
peekCString CString
language''
    Int
flags' <- Buffer' -> IO Int
hb_buffer_get_flags Buffer'
buf'
    Int
clusterLevel' <- Buffer' -> IO Int
hb_buffer_get_cluster_level Buffer'
buf'
    Word32
invisibleGlyph' <- Buffer' -> IO Word32
hb_buffer_get_invisible_glyph Buffer'
buf'
    Word32
replacementCodepoint' <- Buffer' -> IO Word32
hb_buffer_get_replacement_codepoint Buffer'
buf'
    forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
defaultBuffer {
        text :: Text
text = String -> Text
Lazy.pack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
Prelude.map (Word32 -> Char
w2c forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlyphInfo -> Word32
codepoint) [GlyphInfo]
glyphInfos',
        contentType :: Maybe ContentType
contentType = case Int
contentType' of
            Int
1 -> forall a. a -> Maybe a
Just ContentType
ContentTypeUnicode
            Int
2 -> forall a. a -> Maybe a
Just ContentType
ContentTypeGlyphs
            Int
_ -> forall a. Maybe a
Nothing,
        direction :: Maybe Direction
direction = forall {a}. (Eq a, Num a) => a -> Maybe Direction
int2dir Int
direction',
        script :: Maybe String
script = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Word32 -> String
tag_to_string Word32
script',
        language :: Maybe String
language = forall a. a -> Maybe a
Just String
language',
        beginsText :: Bool
beginsText = forall a. Bits a => a -> Int -> Bool
testBit Int
flags' Int
0, endsText :: Bool
endsText = forall a. Bits a => a -> Int -> Bool
testBit Int
flags' Int
1,
        preserveDefaultIgnorables :: Bool
preserveDefaultIgnorables = forall a. Bits a => a -> Int -> Bool
testBit Int
flags' Int
2,
        removeDefaultIgnorables :: Bool
removeDefaultIgnorables = forall a. Bits a => a -> Int -> Bool
testBit Int
flags' Int
3,
        don'tInsertDottedCircle :: Bool
don'tInsertDottedCircle = forall a. Bits a => a -> Int -> Bool
testBit Int
flags' Int
4,
        clusterLevel :: ClusterLevel
clusterLevel = case Int
clusterLevel' of
            Int
1 -> ClusterLevel
ClusterMonotoneChars
            Int
2 -> ClusterLevel
ClusterChars
            Int
_ -> ClusterLevel
ClusterMonotoneGraphemes,
        invisibleGlyph :: Char
invisibleGlyph = Word32 -> Char
w2c Word32
invisibleGlyph',
        replacementCodepoint :: Char
replacementCodepoint = Word32 -> Char
w2c Word32
replacementCodepoint'
    }
foreign import ccall "hb_buffer_get_content_type" hb_buffer_get_content_type
    :: Buffer' -> IO Int
foreign import ccall "hb_buffer_get_direction" hb_buffer_get_direction :: Buffer' -> IO Int
foreign import ccall "hb_buffer_get_script" hb_buffer_get_script :: Buffer' -> IO Word32
foreign import ccall "hb_buffer_get_language" hb_buffer_get_language :: Buffer' -> IO CString
foreign import ccall "hb_buffer_get_flags" hb_buffer_get_flags :: Buffer' -> IO Int
foreign import ccall "hb_buffer_get_cluster_level" hb_buffer_get_cluster_level
    :: Buffer' -> IO Int
foreign import ccall "hb_buffer_get_invisible_glyph" hb_buffer_get_invisible_glyph
    :: Buffer' -> IO Word32
foreign import ccall "hb_buffer_get_replacement_codepoint" hb_buffer_get_replacement_codepoint
    :: Buffer' -> IO Word32