{-# LINE 1 "src/Data/Text/ICU/Bidi.hsc" #-}
{-# language TemplateHaskell #-}
{-# language QuasiQuotes #-}
{-# language ViewPatterns #-}
{-# language OverloadedStrings #-}
{-# language TupleSections #-}
{-# language DeriveDataTypeable #-}
{-# language DeriveGeneric #-}
{-# language PatternSynonyms #-}
{-# language LambdaCase #-}
{-# language ScopedTypeVariables #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language TypeApplications #-}
{-# language BangPatterns #-}
{-# language MagicHash #-} -- has fun interactions with hsc2hs!
{-# language PolyKinds #-}
{-# language DataKinds #-}
{-# language UnboxedTuples #-}
{-# language BlockArguments #-}
{-# options_ghc -Wno-missing-pattern-synonym-signatures #-}

module Data.Text.ICU.Bidi
( Bidi(..)
, pattern MAP_NOWHERE

, open
, openSized

, countParagraphs
, countRuns

, getCustomizedClass
, getLength
, getLevelAt
, getLevels
, getLogicalIndex
, getLogicalMap
, getLogicalRun
, getParaLevel
, getParagraph
, getParagraphByIndex
, getProcessedLength
, getResultLength
, getText
, getVisualIndex
, getVisualMap
, getVisualRun
, invertMap
, isInverse
, isOrderParagraphsLTR
, orderParagraphsLTR
, reorderLogical
, reorderVisual
, setContext
, setInverse
, setLine
, setPara
-- * Levels
, Level
  ( Level
  , DEFAULT_LTR
  , DEFAULT_RTL
  , MAX_EXPLICIT_LEVEL
  )
, isRTL, isLTR
, isOverride
, override
, pattern LEVEL_OVERRIDE
-- * Direction
, Direction(..)
, getBaseDirection
, getDirection
-- * Reordering
, ReorderingMode(..)
, getReorderingMode
, setReorderingMode
, ReorderingOption
  ( ReorderingOption
  , OPTION_DEFAULT
  , OPTION_INSERT_MARKS
  , OPTION_REMOVE_CONTROLS
  , OPTION_STREAMING
  )
, getReorderingOptions
, setReorderingOptions
-- * Character Direction Classes
, CharDirection
  ( CharDirection
  , LEFT_TO_RIGHT
  , RIGHT_TO_LEFT
  , EUROPEAN_NUMBER
  , EUROPEAN_NUMBER_SEPARATOR
  , EUROPEAN_NUMBER_TERMINATOR
  , ARABIC_NUMBER
  , COMMON_NUMBER_SEPARATOR
  , BLOCK_SEPARATOR
  , SEGMENT_SEPARATOR
  , WHITE_SPACE_NEUTRAL
  , OTHER_NEUTRAL
  , LEFT_TO_RIGHT_EMBEDDING
  , LEFT_TO_RIGHT_OVERRIDE
  , RIGHT_TO_LEFT_ARABIC
  , RIGHT_TO_LEFT_EMBEDDING
  , RIGHT_TO_LEFT_OVERRIDE
  , POP_DIRECTIONAL_FORMAT
  , DIR_NON_SPACING_MARK
  , BOUNDARY_NEUTRAL
  , FIRST_STRONG_ISOLATE
  , LEFT_TO_RIGHT_ISOLATE
  , RIGHT_TO_LEFT_ISOLATE
  , POP_DIRECTIONAL_ISOLATE
  , BIDI_CLASS_DEFAULT -- hack
  )

, ClassCallback
, mkClassCallback
, setClassCallback
, getClassCallback

-- * Writing
, WriteOptions
  ( WriteOptions
  , DO_MIRRORING
  , INSERT_LRM_FOR_NUMERIC
  , KEEP_BASE_COMBINING
  , REMOVE_BIDI_CONTROLS
  , OUTPUT_REVERSE
  )
, writeReordered
, writeReverse

-- * Internal
, UBiDi
, UErrorCode(..)
) where

import Control.Exception
import Control.Monad
import Control.Monad.Primitive
import Data.Bits
import Data.Coerce
import Data.Data (Data)
import Data.Default
import Data.Functor ((<&>))
import Data.Int
import Data.IORef
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Data.Primitive.ByteArray
import Data.Primitive.PrimArray
import Data.Primitive.Ptr as Prim
import Data.Primitive.Types
import Data.Text as Text
import Data.Text.Foreign as Text
import Data.Traversable (for)
import qualified Data.Vector.Primitive as Prim
import Data.Word
import Foreign.C.String
import Foreign.C.Types
import qualified Foreign.Concurrent as Concurrent
import Foreign.ForeignPtr
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Marshal.Unsafe (unsafeLocalState)
import Foreign.Marshal.Utils
import Foreign.Ptr
import Foreign.Storable
import GHC.Arr (Ix)
import GHC.Generics (Generic)
import GHC.Types
import qualified Language.C.Inline as C
import qualified Language.C.Inline.Context as C
import qualified Language.C.Inline.HaskellIdentifier as C
import qualified Language.C.Types as C
import qualified Language.Haskell.TH as TH
import System.IO.Unsafe (unsafePerformIO)

--------------------------------------------------------------------------------
-- PrimArray utilities
--------------------------------------------------------------------------------

withPrimArrayLen :: forall a r. Prim a => PrimArray a -> (Int -> Ptr a -> IO r) -> IO r
withPrimArrayLen :: forall a r. Prim a => PrimArray a -> (Int -> Ptr a -> IO r) -> IO r
withPrimArrayLen PrimArray a
pa Int -> Ptr a -> IO r
k = Int -> (Ptr a -> IO r) -> IO r
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int# -> Int
I# (forall a. Prim a => a -> Int#
sizeOf# @a a
forall a. HasCallStack => a
undefined)) \Ptr a
p -> Ptr a -> PrimArray a -> Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Ptr a -> PrimArray a -> Int -> Int -> m ()
copyPrimArrayToPtr Ptr a
p PrimArray a
pa Int
0 Int
n IO () -> IO r -> IO r
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Ptr a -> IO r
k Int
n Ptr a
p where
  n :: Int
n = PrimArray a -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray a
pa

peekPrimArray :: Prim a => Int -> Ptr a -> IO (PrimArray a)
peekPrimArray :: forall a. Prim a => Int -> Ptr a -> IO (PrimArray a)
peekPrimArray Int
len Ptr a
ptr = do
  MutablePrimArray RealWorld a
mpa <- Int -> IO (MutablePrimArray (PrimState IO) a)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
  MutablePrimArray (PrimState IO) a -> Int -> Ptr a -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
copyPtrToMutablePrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
mpa Int
0 Ptr a
ptr Int
len
  MutablePrimArray (PrimState IO) a -> IO (PrimArray a)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld a
MutablePrimArray (PrimState IO) a
mpa


{-# LINE 192 "src/Data/Text/ICU/Bidi.hsc" #-}





{-# LINE 197 "src/Data/Text/ICU/Bidi.hsc" #-}

newtype Level = Level Word8
  deriving (Level -> Level -> Bool
(Level -> Level -> Bool) -> (Level -> Level -> Bool) -> Eq Level
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Level -> Level -> Bool
$c/= :: Level -> Level -> Bool
== :: Level -> Level -> Bool
$c== :: Level -> Level -> Bool
Eq,Eq Level
Eq Level
-> (Level -> Level -> Ordering)
-> (Level -> Level -> Bool)
-> (Level -> Level -> Bool)
-> (Level -> Level -> Bool)
-> (Level -> Level -> Bool)
-> (Level -> Level -> Level)
-> (Level -> Level -> Level)
-> Ord Level
Level -> Level -> Bool
Level -> Level -> Ordering
Level -> Level -> Level
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 :: Level -> Level -> Level
$cmin :: Level -> Level -> Level
max :: Level -> Level -> Level
$cmax :: Level -> Level -> Level
>= :: Level -> Level -> Bool
$c>= :: Level -> Level -> Bool
> :: Level -> Level -> Bool
$c> :: Level -> Level -> Bool
<= :: Level -> Level -> Bool
$c<= :: Level -> Level -> Bool
< :: Level -> Level -> Bool
$c< :: Level -> Level -> Bool
compare :: Level -> Level -> Ordering
$ccompare :: Level -> Level -> Ordering
Ord,Int -> Level -> ShowS
[Level] -> ShowS
Level -> String
(Int -> Level -> ShowS)
-> (Level -> String) -> ([Level] -> ShowS) -> Show Level
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Level] -> ShowS
$cshowList :: [Level] -> ShowS
show :: Level -> String
$cshow :: Level -> String
showsPrec :: Int -> Level -> ShowS
$cshowsPrec :: Int -> Level -> ShowS
Show,Ptr Level -> IO Level
Ptr Level -> Int -> IO Level
Ptr Level -> Int -> Level -> IO ()
Ptr Level -> Level -> IO ()
Level -> Int
(Level -> Int)
-> (Level -> Int)
-> (Ptr Level -> Int -> IO Level)
-> (Ptr Level -> Int -> Level -> IO ())
-> (forall b. Ptr b -> Int -> IO Level)
-> (forall b. Ptr b -> Int -> Level -> IO ())
-> (Ptr Level -> IO Level)
-> (Ptr Level -> Level -> IO ())
-> Storable Level
forall b. Ptr b -> Int -> IO Level
forall b. Ptr b -> Int -> Level -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr Level -> Level -> IO ()
$cpoke :: Ptr Level -> Level -> IO ()
peek :: Ptr Level -> IO Level
$cpeek :: Ptr Level -> IO Level
pokeByteOff :: forall b. Ptr b -> Int -> Level -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Level -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO Level
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Level
pokeElemOff :: Ptr Level -> Int -> Level -> IO ()
$cpokeElemOff :: Ptr Level -> Int -> Level -> IO ()
peekElemOff :: Ptr Level -> Int -> IO Level
$cpeekElemOff :: Ptr Level -> Int -> IO Level
alignment :: Level -> Int
$calignment :: Level -> Int
sizeOf :: Level -> Int
$csizeOf :: Level -> Int
Storable,Addr# -> Int# -> Level
ByteArray# -> Int# -> Level
Level -> Int#
(Level -> Int#)
-> (Level -> Int#)
-> (ByteArray# -> Int# -> Level)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, Level #))
-> (forall s.
    MutableByteArray# s -> Int# -> Level -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> Level -> State# s -> State# s)
-> (Addr# -> Int# -> Level)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, Level #))
-> (forall s. Addr# -> Int# -> Level -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> Level -> State# s -> State# s)
-> Prim Level
forall s. Addr# -> Int# -> Int# -> Level -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, Level #)
forall s. Addr# -> Int# -> Level -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> Level -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Level #)
forall s.
MutableByteArray# s -> Int# -> Level -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> Level -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> Level -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> Level -> State# s -> State# s
$cwriteOffAddr# :: forall s. Addr# -> Int# -> Level -> State# s -> State# s
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, Level #)
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, Level #)
indexOffAddr# :: Addr# -> Int# -> Level
$cindexOffAddr# :: Addr# -> Int# -> Level
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> Level -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> Level -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> Level -> State# s -> State# s
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> Level -> State# s -> State# s
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Level #)
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Level #)
indexByteArray# :: ByteArray# -> Int# -> Level
$cindexByteArray# :: ByteArray# -> Int# -> Level
alignment# :: Level -> Int#
$calignment# :: Level -> Int#
sizeOf# :: Level -> Int#
$csizeOf# :: Level -> Int#
Prim)

isRTL :: Level -> Bool
isRTL :: Level -> Bool
isRTL = (Word8 -> Bool) -> Level -> Bool
coerce (forall a. Integral a => a -> Bool
odd @Word8)

isLTR :: Level -> Bool
isLTR :: Level -> Bool
isLTR = (Word8 -> Bool) -> Level -> Bool
coerce (forall a. Integral a => a -> Bool
even @Word8)

pattern $bLEVEL_OVERRIDE :: Word8
$mLEVEL_OVERRIDE :: forall {r}. Word8 -> (Void# -> r) -> (Void# -> r) -> r
LEVEL_OVERRIDE = (128) :: Word8
{-# LINE 208 "src/Data/Text/ICU/Bidi.hsc" #-}

isOverride :: Level -> Bool
isOverride :: Level -> Bool
isOverride (Level Word8
l) = Word8
l Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
LEVEL_OVERRIDE Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0

override :: Level -> Level
override :: Level -> Level
override (Level Word8
l) = Word8 -> Level
Level (Word8
l Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
LEVEL_OVERRIDE)


{-# LINE 216 "src/Data/Text/ICU/Bidi.hsc" #-}
pattern DEFAULT_LTR = Level (254)
{-# LINE 217 "src/Data/Text/ICU/Bidi.hsc" #-}
pattern DEFAULT_RTL = Level (255)
{-# LINE 218 "src/Data/Text/ICU/Bidi.hsc" #-}
pattern MAX_EXPLICIT_LEVEL = Level (125)
{-# LINE 219 "src/Data/Text/ICU/Bidi.hsc" #-}

{-# LINE 220 "src/Data/Text/ICU/Bidi.hsc" #-}


{-# LINE 222 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | Special value which can be returned by the mapping functions when a logical index has no corresponding visual index or vice-versa.
-- Returned by 'getVisualIndex', 'getVisualMap', 'getLogicalIndex', 'getLogicalMap'
pattern $bMAP_NOWHERE :: Int
$mMAP_NOWHERE :: forall {r}. Int -> (Void# -> r) -> (Void# -> r) -> r
MAP_NOWHERE = (-1) :: Int
{-# LINE 225 "src/Data/Text/ICU/Bidi.hsc" #-}

{-# LINE 226 "src/Data/Text/ICU/Bidi.hsc" #-}

newtype WriteOptions = WriteOptions Int16
  deriving (WriteOptions -> WriteOptions -> Bool
(WriteOptions -> WriteOptions -> Bool)
-> (WriteOptions -> WriteOptions -> Bool) -> Eq WriteOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WriteOptions -> WriteOptions -> Bool
$c/= :: WriteOptions -> WriteOptions -> Bool
== :: WriteOptions -> WriteOptions -> Bool
$c== :: WriteOptions -> WriteOptions -> Bool
Eq,Eq WriteOptions
Eq WriteOptions
-> (WriteOptions -> WriteOptions -> Ordering)
-> (WriteOptions -> WriteOptions -> Bool)
-> (WriteOptions -> WriteOptions -> Bool)
-> (WriteOptions -> WriteOptions -> Bool)
-> (WriteOptions -> WriteOptions -> Bool)
-> (WriteOptions -> WriteOptions -> WriteOptions)
-> (WriteOptions -> WriteOptions -> WriteOptions)
-> Ord WriteOptions
WriteOptions -> WriteOptions -> Bool
WriteOptions -> WriteOptions -> Ordering
WriteOptions -> WriteOptions -> WriteOptions
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 :: WriteOptions -> WriteOptions -> WriteOptions
$cmin :: WriteOptions -> WriteOptions -> WriteOptions
max :: WriteOptions -> WriteOptions -> WriteOptions
$cmax :: WriteOptions -> WriteOptions -> WriteOptions
>= :: WriteOptions -> WriteOptions -> Bool
$c>= :: WriteOptions -> WriteOptions -> Bool
> :: WriteOptions -> WriteOptions -> Bool
$c> :: WriteOptions -> WriteOptions -> Bool
<= :: WriteOptions -> WriteOptions -> Bool
$c<= :: WriteOptions -> WriteOptions -> Bool
< :: WriteOptions -> WriteOptions -> Bool
$c< :: WriteOptions -> WriteOptions -> Bool
compare :: WriteOptions -> WriteOptions -> Ordering
$ccompare :: WriteOptions -> WriteOptions -> Ordering
Ord,Int -> WriteOptions -> ShowS
[WriteOptions] -> ShowS
WriteOptions -> String
(Int -> WriteOptions -> ShowS)
-> (WriteOptions -> String)
-> ([WriteOptions] -> ShowS)
-> Show WriteOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WriteOptions] -> ShowS
$cshowList :: [WriteOptions] -> ShowS
show :: WriteOptions -> String
$cshow :: WriteOptions -> String
showsPrec :: Int -> WriteOptions -> ShowS
$cshowsPrec :: Int -> WriteOptions -> ShowS
Show,Ptr WriteOptions -> IO WriteOptions
Ptr WriteOptions -> Int -> IO WriteOptions
Ptr WriteOptions -> Int -> WriteOptions -> IO ()
Ptr WriteOptions -> WriteOptions -> IO ()
WriteOptions -> Int
(WriteOptions -> Int)
-> (WriteOptions -> Int)
-> (Ptr WriteOptions -> Int -> IO WriteOptions)
-> (Ptr WriteOptions -> Int -> WriteOptions -> IO ())
-> (forall b. Ptr b -> Int -> IO WriteOptions)
-> (forall b. Ptr b -> Int -> WriteOptions -> IO ())
-> (Ptr WriteOptions -> IO WriteOptions)
-> (Ptr WriteOptions -> WriteOptions -> IO ())
-> Storable WriteOptions
forall b. Ptr b -> Int -> IO WriteOptions
forall b. Ptr b -> Int -> WriteOptions -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr WriteOptions -> WriteOptions -> IO ()
$cpoke :: Ptr WriteOptions -> WriteOptions -> IO ()
peek :: Ptr WriteOptions -> IO WriteOptions
$cpeek :: Ptr WriteOptions -> IO WriteOptions
pokeByteOff :: forall b. Ptr b -> Int -> WriteOptions -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> WriteOptions -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO WriteOptions
$cpeekByteOff :: forall b. Ptr b -> Int -> IO WriteOptions
pokeElemOff :: Ptr WriteOptions -> Int -> WriteOptions -> IO ()
$cpokeElemOff :: Ptr WriteOptions -> Int -> WriteOptions -> IO ()
peekElemOff :: Ptr WriteOptions -> Int -> IO WriteOptions
$cpeekElemOff :: Ptr WriteOptions -> Int -> IO WriteOptions
alignment :: WriteOptions -> Int
$calignment :: WriteOptions -> Int
sizeOf :: WriteOptions -> Int
$csizeOf :: WriteOptions -> Int
Storable,Addr# -> Int# -> WriteOptions
ByteArray# -> Int# -> WriteOptions
WriteOptions -> Int#
(WriteOptions -> Int#)
-> (WriteOptions -> Int#)
-> (ByteArray# -> Int# -> WriteOptions)
-> (forall s.
    MutableByteArray# s
    -> Int# -> State# s -> (# State# s, WriteOptions #))
-> (forall s.
    MutableByteArray# s
    -> Int# -> WriteOptions -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> WriteOptions -> State# s -> State# s)
-> (Addr# -> Int# -> WriteOptions)
-> (forall s.
    Addr# -> Int# -> State# s -> (# State# s, WriteOptions #))
-> (forall s.
    Addr# -> Int# -> WriteOptions -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> WriteOptions -> State# s -> State# s)
-> Prim WriteOptions
forall s.
Addr# -> Int# -> Int# -> WriteOptions -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, WriteOptions #)
forall s. Addr# -> Int# -> WriteOptions -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> WriteOptions -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, WriteOptions #)
forall s.
MutableByteArray# s -> Int# -> WriteOptions -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
setOffAddr# :: forall s.
Addr# -> Int# -> Int# -> WriteOptions -> State# s -> State# s
$csetOffAddr# :: forall s.
Addr# -> Int# -> Int# -> WriteOptions -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> WriteOptions -> State# s -> State# s
$cwriteOffAddr# :: forall s. Addr# -> Int# -> WriteOptions -> State# s -> State# s
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, WriteOptions #)
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, WriteOptions #)
indexOffAddr# :: Addr# -> Int# -> WriteOptions
$cindexOffAddr# :: Addr# -> Int# -> WriteOptions
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> WriteOptions -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> WriteOptions -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> WriteOptions -> State# s -> State# s
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> WriteOptions -> State# s -> State# s
readByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, WriteOptions #)
$creadByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, WriteOptions #)
indexByteArray# :: ByteArray# -> Int# -> WriteOptions
$cindexByteArray# :: ByteArray# -> Int# -> WriteOptions
alignment# :: WriteOptions -> Int#
$calignment# :: WriteOptions -> Int#
sizeOf# :: WriteOptions -> Int#
$csizeOf# :: WriteOptions -> Int#
Prim,Eq WriteOptions
WriteOptions
Eq WriteOptions
-> (WriteOptions -> WriteOptions -> WriteOptions)
-> (WriteOptions -> WriteOptions -> WriteOptions)
-> (WriteOptions -> WriteOptions -> WriteOptions)
-> (WriteOptions -> WriteOptions)
-> (WriteOptions -> Int -> WriteOptions)
-> (WriteOptions -> Int -> WriteOptions)
-> WriteOptions
-> (Int -> WriteOptions)
-> (WriteOptions -> Int -> WriteOptions)
-> (WriteOptions -> Int -> WriteOptions)
-> (WriteOptions -> Int -> WriteOptions)
-> (WriteOptions -> Int -> Bool)
-> (WriteOptions -> Maybe Int)
-> (WriteOptions -> Int)
-> (WriteOptions -> Bool)
-> (WriteOptions -> Int -> WriteOptions)
-> (WriteOptions -> Int -> WriteOptions)
-> (WriteOptions -> Int -> WriteOptions)
-> (WriteOptions -> Int -> WriteOptions)
-> (WriteOptions -> Int -> WriteOptions)
-> (WriteOptions -> Int -> WriteOptions)
-> (WriteOptions -> Int)
-> Bits WriteOptions
Int -> WriteOptions
WriteOptions -> Bool
WriteOptions -> Int
WriteOptions -> Maybe Int
WriteOptions -> WriteOptions
WriteOptions -> Int -> Bool
WriteOptions -> Int -> WriteOptions
WriteOptions -> WriteOptions -> WriteOptions
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: WriteOptions -> Int
$cpopCount :: WriteOptions -> Int
rotateR :: WriteOptions -> Int -> WriteOptions
$crotateR :: WriteOptions -> Int -> WriteOptions
rotateL :: WriteOptions -> Int -> WriteOptions
$crotateL :: WriteOptions -> Int -> WriteOptions
unsafeShiftR :: WriteOptions -> Int -> WriteOptions
$cunsafeShiftR :: WriteOptions -> Int -> WriteOptions
shiftR :: WriteOptions -> Int -> WriteOptions
$cshiftR :: WriteOptions -> Int -> WriteOptions
unsafeShiftL :: WriteOptions -> Int -> WriteOptions
$cunsafeShiftL :: WriteOptions -> Int -> WriteOptions
shiftL :: WriteOptions -> Int -> WriteOptions
$cshiftL :: WriteOptions -> Int -> WriteOptions
isSigned :: WriteOptions -> Bool
$cisSigned :: WriteOptions -> Bool
bitSize :: WriteOptions -> Int
$cbitSize :: WriteOptions -> Int
bitSizeMaybe :: WriteOptions -> Maybe Int
$cbitSizeMaybe :: WriteOptions -> Maybe Int
testBit :: WriteOptions -> Int -> Bool
$ctestBit :: WriteOptions -> Int -> Bool
complementBit :: WriteOptions -> Int -> WriteOptions
$ccomplementBit :: WriteOptions -> Int -> WriteOptions
clearBit :: WriteOptions -> Int -> WriteOptions
$cclearBit :: WriteOptions -> Int -> WriteOptions
setBit :: WriteOptions -> Int -> WriteOptions
$csetBit :: WriteOptions -> Int -> WriteOptions
bit :: Int -> WriteOptions
$cbit :: Int -> WriteOptions
zeroBits :: WriteOptions
$czeroBits :: WriteOptions
rotate :: WriteOptions -> Int -> WriteOptions
$crotate :: WriteOptions -> Int -> WriteOptions
shift :: WriteOptions -> Int -> WriteOptions
$cshift :: WriteOptions -> Int -> WriteOptions
complement :: WriteOptions -> WriteOptions
$ccomplement :: WriteOptions -> WriteOptions
xor :: WriteOptions -> WriteOptions -> WriteOptions
$cxor :: WriteOptions -> WriteOptions -> WriteOptions
.|. :: WriteOptions -> WriteOptions -> WriteOptions
$c.|. :: WriteOptions -> WriteOptions -> WriteOptions
.&. :: WriteOptions -> WriteOptions -> WriteOptions
$c.&. :: WriteOptions -> WriteOptions -> WriteOptions
Bits)


{-# LINE 231 "src/Data/Text/ICU/Bidi.hsc" #-}
pattern KEEP_BASE_COMBINING = WriteOptions (1)
{-# LINE 232 "src/Data/Text/ICU/Bidi.hsc" #-}
pattern DO_MIRRORING = WriteOptions (2)
{-# LINE 233 "src/Data/Text/ICU/Bidi.hsc" #-}
pattern INSERT_LRM_FOR_NUMERIC = WriteOptions (4)
{-# LINE 234 "src/Data/Text/ICU/Bidi.hsc" #-}
pattern REMOVE_BIDI_CONTROLS  = WriteOptions (8)
{-# LINE 235 "src/Data/Text/ICU/Bidi.hsc" #-}
pattern OUTPUT_REVERSE = WriteOptions (16)
{-# LINE 236 "src/Data/Text/ICU/Bidi.hsc" #-}

{-# LINE 237 "src/Data/Text/ICU/Bidi.hsc" #-}

instance Default WriteOptions where
  def :: WriteOptions
def = Int16 -> WriteOptions
WriteOptions Int16
0

newtype UErrorCode = UErrorCode Int32
  deriving (UErrorCode -> UErrorCode -> Bool
(UErrorCode -> UErrorCode -> Bool)
-> (UErrorCode -> UErrorCode -> Bool) -> Eq UErrorCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UErrorCode -> UErrorCode -> Bool
$c/= :: UErrorCode -> UErrorCode -> Bool
== :: UErrorCode -> UErrorCode -> Bool
$c== :: UErrorCode -> UErrorCode -> Bool
Eq,Eq UErrorCode
Eq UErrorCode
-> (UErrorCode -> UErrorCode -> Ordering)
-> (UErrorCode -> UErrorCode -> Bool)
-> (UErrorCode -> UErrorCode -> Bool)
-> (UErrorCode -> UErrorCode -> Bool)
-> (UErrorCode -> UErrorCode -> Bool)
-> (UErrorCode -> UErrorCode -> UErrorCode)
-> (UErrorCode -> UErrorCode -> UErrorCode)
-> Ord UErrorCode
UErrorCode -> UErrorCode -> Bool
UErrorCode -> UErrorCode -> Ordering
UErrorCode -> UErrorCode -> UErrorCode
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 :: UErrorCode -> UErrorCode -> UErrorCode
$cmin :: UErrorCode -> UErrorCode -> UErrorCode
max :: UErrorCode -> UErrorCode -> UErrorCode
$cmax :: UErrorCode -> UErrorCode -> UErrorCode
>= :: UErrorCode -> UErrorCode -> Bool
$c>= :: UErrorCode -> UErrorCode -> Bool
> :: UErrorCode -> UErrorCode -> Bool
$c> :: UErrorCode -> UErrorCode -> Bool
<= :: UErrorCode -> UErrorCode -> Bool
$c<= :: UErrorCode -> UErrorCode -> Bool
< :: UErrorCode -> UErrorCode -> Bool
$c< :: UErrorCode -> UErrorCode -> Bool
compare :: UErrorCode -> UErrorCode -> Ordering
$ccompare :: UErrorCode -> UErrorCode -> Ordering
Ord,Int -> UErrorCode -> ShowS
[UErrorCode] -> ShowS
UErrorCode -> String
(Int -> UErrorCode -> ShowS)
-> (UErrorCode -> String)
-> ([UErrorCode] -> ShowS)
-> Show UErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UErrorCode] -> ShowS
$cshowList :: [UErrorCode] -> ShowS
show :: UErrorCode -> String
$cshow :: UErrorCode -> String
showsPrec :: Int -> UErrorCode -> ShowS
$cshowsPrec :: Int -> UErrorCode -> ShowS
Show,Integer -> UErrorCode
UErrorCode -> UErrorCode
UErrorCode -> UErrorCode -> UErrorCode
(UErrorCode -> UErrorCode -> UErrorCode)
-> (UErrorCode -> UErrorCode -> UErrorCode)
-> (UErrorCode -> UErrorCode -> UErrorCode)
-> (UErrorCode -> UErrorCode)
-> (UErrorCode -> UErrorCode)
-> (UErrorCode -> UErrorCode)
-> (Integer -> UErrorCode)
-> Num UErrorCode
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> UErrorCode
$cfromInteger :: Integer -> UErrorCode
signum :: UErrorCode -> UErrorCode
$csignum :: UErrorCode -> UErrorCode
abs :: UErrorCode -> UErrorCode
$cabs :: UErrorCode -> UErrorCode
negate :: UErrorCode -> UErrorCode
$cnegate :: UErrorCode -> UErrorCode
* :: UErrorCode -> UErrorCode -> UErrorCode
$c* :: UErrorCode -> UErrorCode -> UErrorCode
- :: UErrorCode -> UErrorCode -> UErrorCode
$c- :: UErrorCode -> UErrorCode -> UErrorCode
+ :: UErrorCode -> UErrorCode -> UErrorCode
$c+ :: UErrorCode -> UErrorCode -> UErrorCode
Num,Int -> UErrorCode
UErrorCode -> Int
UErrorCode -> [UErrorCode]
UErrorCode -> UErrorCode
UErrorCode -> UErrorCode -> [UErrorCode]
UErrorCode -> UErrorCode -> UErrorCode -> [UErrorCode]
(UErrorCode -> UErrorCode)
-> (UErrorCode -> UErrorCode)
-> (Int -> UErrorCode)
-> (UErrorCode -> Int)
-> (UErrorCode -> [UErrorCode])
-> (UErrorCode -> UErrorCode -> [UErrorCode])
-> (UErrorCode -> UErrorCode -> [UErrorCode])
-> (UErrorCode -> UErrorCode -> UErrorCode -> [UErrorCode])
-> Enum UErrorCode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: UErrorCode -> UErrorCode -> UErrorCode -> [UErrorCode]
$cenumFromThenTo :: UErrorCode -> UErrorCode -> UErrorCode -> [UErrorCode]
enumFromTo :: UErrorCode -> UErrorCode -> [UErrorCode]
$cenumFromTo :: UErrorCode -> UErrorCode -> [UErrorCode]
enumFromThen :: UErrorCode -> UErrorCode -> [UErrorCode]
$cenumFromThen :: UErrorCode -> UErrorCode -> [UErrorCode]
enumFrom :: UErrorCode -> [UErrorCode]
$cenumFrom :: UErrorCode -> [UErrorCode]
fromEnum :: UErrorCode -> Int
$cfromEnum :: UErrorCode -> Int
toEnum :: Int -> UErrorCode
$ctoEnum :: Int -> UErrorCode
pred :: UErrorCode -> UErrorCode
$cpred :: UErrorCode -> UErrorCode
succ :: UErrorCode -> UErrorCode
$csucc :: UErrorCode -> UErrorCode
Enum,Num UErrorCode
Ord UErrorCode
Num UErrorCode
-> Ord UErrorCode -> (UErrorCode -> Rational) -> Real UErrorCode
UErrorCode -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: UErrorCode -> Rational
$ctoRational :: UErrorCode -> Rational
Real,Enum UErrorCode
Real UErrorCode
Real UErrorCode
-> Enum UErrorCode
-> (UErrorCode -> UErrorCode -> UErrorCode)
-> (UErrorCode -> UErrorCode -> UErrorCode)
-> (UErrorCode -> UErrorCode -> UErrorCode)
-> (UErrorCode -> UErrorCode -> UErrorCode)
-> (UErrorCode -> UErrorCode -> (UErrorCode, UErrorCode))
-> (UErrorCode -> UErrorCode -> (UErrorCode, UErrorCode))
-> (UErrorCode -> Integer)
-> Integral UErrorCode
UErrorCode -> Integer
UErrorCode -> UErrorCode -> (UErrorCode, UErrorCode)
UErrorCode -> UErrorCode -> UErrorCode
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: UErrorCode -> Integer
$ctoInteger :: UErrorCode -> Integer
divMod :: UErrorCode -> UErrorCode -> (UErrorCode, UErrorCode)
$cdivMod :: UErrorCode -> UErrorCode -> (UErrorCode, UErrorCode)
quotRem :: UErrorCode -> UErrorCode -> (UErrorCode, UErrorCode)
$cquotRem :: UErrorCode -> UErrorCode -> (UErrorCode, UErrorCode)
mod :: UErrorCode -> UErrorCode -> UErrorCode
$cmod :: UErrorCode -> UErrorCode -> UErrorCode
div :: UErrorCode -> UErrorCode -> UErrorCode
$cdiv :: UErrorCode -> UErrorCode -> UErrorCode
rem :: UErrorCode -> UErrorCode -> UErrorCode
$crem :: UErrorCode -> UErrorCode -> UErrorCode
quot :: UErrorCode -> UErrorCode -> UErrorCode
$cquot :: UErrorCode -> UErrorCode -> UErrorCode
Integral,Ptr UErrorCode -> IO UErrorCode
Ptr UErrorCode -> Int -> IO UErrorCode
Ptr UErrorCode -> Int -> UErrorCode -> IO ()
Ptr UErrorCode -> UErrorCode -> IO ()
UErrorCode -> Int
(UErrorCode -> Int)
-> (UErrorCode -> Int)
-> (Ptr UErrorCode -> Int -> IO UErrorCode)
-> (Ptr UErrorCode -> Int -> UErrorCode -> IO ())
-> (forall b. Ptr b -> Int -> IO UErrorCode)
-> (forall b. Ptr b -> Int -> UErrorCode -> IO ())
-> (Ptr UErrorCode -> IO UErrorCode)
-> (Ptr UErrorCode -> UErrorCode -> IO ())
-> Storable UErrorCode
forall b. Ptr b -> Int -> IO UErrorCode
forall b. Ptr b -> Int -> UErrorCode -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr UErrorCode -> UErrorCode -> IO ()
$cpoke :: Ptr UErrorCode -> UErrorCode -> IO ()
peek :: Ptr UErrorCode -> IO UErrorCode
$cpeek :: Ptr UErrorCode -> IO UErrorCode
pokeByteOff :: forall b. Ptr b -> Int -> UErrorCode -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> UErrorCode -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO UErrorCode
$cpeekByteOff :: forall b. Ptr b -> Int -> IO UErrorCode
pokeElemOff :: Ptr UErrorCode -> Int -> UErrorCode -> IO ()
$cpokeElemOff :: Ptr UErrorCode -> Int -> UErrorCode -> IO ()
peekElemOff :: Ptr UErrorCode -> Int -> IO UErrorCode
$cpeekElemOff :: Ptr UErrorCode -> Int -> IO UErrorCode
alignment :: UErrorCode -> Int
$calignment :: UErrorCode -> Int
sizeOf :: UErrorCode -> Int
$csizeOf :: UErrorCode -> Int
Storable)

instance Default UErrorCode where
  def :: UErrorCode
def = Int32 -> UErrorCode
UErrorCode Int32
0

-- |
-- 'ReorderingOption' values indicate which options are
-- specified to affect the Bidi algorithm.
newtype ReorderingOption = ReorderingOption Int32
  deriving (ReorderingOption -> ReorderingOption -> Bool
(ReorderingOption -> ReorderingOption -> Bool)
-> (ReorderingOption -> ReorderingOption -> Bool)
-> Eq ReorderingOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReorderingOption -> ReorderingOption -> Bool
$c/= :: ReorderingOption -> ReorderingOption -> Bool
== :: ReorderingOption -> ReorderingOption -> Bool
$c== :: ReorderingOption -> ReorderingOption -> Bool
Eq,Eq ReorderingOption
Eq ReorderingOption
-> (ReorderingOption -> ReorderingOption -> Ordering)
-> (ReorderingOption -> ReorderingOption -> Bool)
-> (ReorderingOption -> ReorderingOption -> Bool)
-> (ReorderingOption -> ReorderingOption -> Bool)
-> (ReorderingOption -> ReorderingOption -> Bool)
-> (ReorderingOption -> ReorderingOption -> ReorderingOption)
-> (ReorderingOption -> ReorderingOption -> ReorderingOption)
-> Ord ReorderingOption
ReorderingOption -> ReorderingOption -> Bool
ReorderingOption -> ReorderingOption -> Ordering
ReorderingOption -> ReorderingOption -> ReorderingOption
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 :: ReorderingOption -> ReorderingOption -> ReorderingOption
$cmin :: ReorderingOption -> ReorderingOption -> ReorderingOption
max :: ReorderingOption -> ReorderingOption -> ReorderingOption
$cmax :: ReorderingOption -> ReorderingOption -> ReorderingOption
>= :: ReorderingOption -> ReorderingOption -> Bool
$c>= :: ReorderingOption -> ReorderingOption -> Bool
> :: ReorderingOption -> ReorderingOption -> Bool
$c> :: ReorderingOption -> ReorderingOption -> Bool
<= :: ReorderingOption -> ReorderingOption -> Bool
$c<= :: ReorderingOption -> ReorderingOption -> Bool
< :: ReorderingOption -> ReorderingOption -> Bool
$c< :: ReorderingOption -> ReorderingOption -> Bool
compare :: ReorderingOption -> ReorderingOption -> Ordering
$ccompare :: ReorderingOption -> ReorderingOption -> Ordering
Ord,Int -> ReorderingOption -> ShowS
[ReorderingOption] -> ShowS
ReorderingOption -> String
(Int -> ReorderingOption -> ShowS)
-> (ReorderingOption -> String)
-> ([ReorderingOption] -> ShowS)
-> Show ReorderingOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReorderingOption] -> ShowS
$cshowList :: [ReorderingOption] -> ShowS
show :: ReorderingOption -> String
$cshow :: ReorderingOption -> String
showsPrec :: Int -> ReorderingOption -> ShowS
$cshowsPrec :: Int -> ReorderingOption -> ShowS
Show,Eq ReorderingOption
ReorderingOption
Eq ReorderingOption
-> (ReorderingOption -> ReorderingOption -> ReorderingOption)
-> (ReorderingOption -> ReorderingOption -> ReorderingOption)
-> (ReorderingOption -> ReorderingOption -> ReorderingOption)
-> (ReorderingOption -> ReorderingOption)
-> (ReorderingOption -> Int -> ReorderingOption)
-> (ReorderingOption -> Int -> ReorderingOption)
-> ReorderingOption
-> (Int -> ReorderingOption)
-> (ReorderingOption -> Int -> ReorderingOption)
-> (ReorderingOption -> Int -> ReorderingOption)
-> (ReorderingOption -> Int -> ReorderingOption)
-> (ReorderingOption -> Int -> Bool)
-> (ReorderingOption -> Maybe Int)
-> (ReorderingOption -> Int)
-> (ReorderingOption -> Bool)
-> (ReorderingOption -> Int -> ReorderingOption)
-> (ReorderingOption -> Int -> ReorderingOption)
-> (ReorderingOption -> Int -> ReorderingOption)
-> (ReorderingOption -> Int -> ReorderingOption)
-> (ReorderingOption -> Int -> ReorderingOption)
-> (ReorderingOption -> Int -> ReorderingOption)
-> (ReorderingOption -> Int)
-> Bits ReorderingOption
Int -> ReorderingOption
ReorderingOption -> Bool
ReorderingOption -> Int
ReorderingOption -> Maybe Int
ReorderingOption -> ReorderingOption
ReorderingOption -> Int -> Bool
ReorderingOption -> Int -> ReorderingOption
ReorderingOption -> ReorderingOption -> ReorderingOption
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: ReorderingOption -> Int
$cpopCount :: ReorderingOption -> Int
rotateR :: ReorderingOption -> Int -> ReorderingOption
$crotateR :: ReorderingOption -> Int -> ReorderingOption
rotateL :: ReorderingOption -> Int -> ReorderingOption
$crotateL :: ReorderingOption -> Int -> ReorderingOption
unsafeShiftR :: ReorderingOption -> Int -> ReorderingOption
$cunsafeShiftR :: ReorderingOption -> Int -> ReorderingOption
shiftR :: ReorderingOption -> Int -> ReorderingOption
$cshiftR :: ReorderingOption -> Int -> ReorderingOption
unsafeShiftL :: ReorderingOption -> Int -> ReorderingOption
$cunsafeShiftL :: ReorderingOption -> Int -> ReorderingOption
shiftL :: ReorderingOption -> Int -> ReorderingOption
$cshiftL :: ReorderingOption -> Int -> ReorderingOption
isSigned :: ReorderingOption -> Bool
$cisSigned :: ReorderingOption -> Bool
bitSize :: ReorderingOption -> Int
$cbitSize :: ReorderingOption -> Int
bitSizeMaybe :: ReorderingOption -> Maybe Int
$cbitSizeMaybe :: ReorderingOption -> Maybe Int
testBit :: ReorderingOption -> Int -> Bool
$ctestBit :: ReorderingOption -> Int -> Bool
complementBit :: ReorderingOption -> Int -> ReorderingOption
$ccomplementBit :: ReorderingOption -> Int -> ReorderingOption
clearBit :: ReorderingOption -> Int -> ReorderingOption
$cclearBit :: ReorderingOption -> Int -> ReorderingOption
setBit :: ReorderingOption -> Int -> ReorderingOption
$csetBit :: ReorderingOption -> Int -> ReorderingOption
bit :: Int -> ReorderingOption
$cbit :: Int -> ReorderingOption
zeroBits :: ReorderingOption
$czeroBits :: ReorderingOption
rotate :: ReorderingOption -> Int -> ReorderingOption
$crotate :: ReorderingOption -> Int -> ReorderingOption
shift :: ReorderingOption -> Int -> ReorderingOption
$cshift :: ReorderingOption -> Int -> ReorderingOption
complement :: ReorderingOption -> ReorderingOption
$ccomplement :: ReorderingOption -> ReorderingOption
xor :: ReorderingOption -> ReorderingOption -> ReorderingOption
$cxor :: ReorderingOption -> ReorderingOption -> ReorderingOption
.|. :: ReorderingOption -> ReorderingOption -> ReorderingOption
$c.|. :: ReorderingOption -> ReorderingOption -> ReorderingOption
.&. :: ReorderingOption -> ReorderingOption -> ReorderingOption
$c.&. :: ReorderingOption -> ReorderingOption -> ReorderingOption
Bits)


{-# LINE 254 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | 
-- option for 'setReorderingOptions' that disables all the options which can be
-- set with this function
-- 
-- @since ICU 3.6
pattern $bOPTION_DEFAULT :: ReorderingOption
$mOPTION_DEFAULT :: forall {r}. ReorderingOption -> (Void# -> r) -> (Void# -> r) -> r
OPTION_DEFAULT = ReorderingOption (0)
{-# LINE 260 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | @since ICU 3.6
pattern $bOPTION_INSERT_MARKS :: ReorderingOption
$mOPTION_INSERT_MARKS :: forall {r}. ReorderingOption -> (Void# -> r) -> (Void# -> r) -> r
OPTION_INSERT_MARKS = ReorderingOption (1)
{-# LINE 262 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | @since ICU 3.6
pattern $bOPTION_REMOVE_CONTROLS :: ReorderingOption
$mOPTION_REMOVE_CONTROLS :: forall {r}. ReorderingOption -> (Void# -> r) -> (Void# -> r) -> r
OPTION_REMOVE_CONTROLS = ReorderingOption (2)
{-# LINE 264 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | 
pattern $bOPTION_STREAMING :: ReorderingOption
$mOPTION_STREAMING :: forall {r}. ReorderingOption -> (Void# -> r) -> (Void# -> r) -> r
OPTION_STREAMING = ReorderingOption (4)
{-# LINE 266 "src/Data/Text/ICU/Bidi.hsc" #-}

{-# LINE 267 "src/Data/Text/ICU/Bidi.hsc" #-}

instance Default ReorderingOption where
  def :: ReorderingOption
def = ReorderingOption
OPTION_DEFAULT

-- | Character Directions.
--
-- This is morally the same as text-icu's Direction type, but that one is missing a few definitions =(
--
-- When issue <https://github.com/haskell/text-icu/issues/44 44> is resolved, this will
-- be able to be text.icu's @Data.Text.ICU.Char.Direction@.

newtype CharDirection = CharDirection Int32 deriving
  (CharDirection -> CharDirection -> Bool
(CharDirection -> CharDirection -> Bool)
-> (CharDirection -> CharDirection -> Bool) -> Eq CharDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CharDirection -> CharDirection -> Bool
$c/= :: CharDirection -> CharDirection -> Bool
== :: CharDirection -> CharDirection -> Bool
$c== :: CharDirection -> CharDirection -> Bool
Eq,Eq CharDirection
Eq CharDirection
-> (CharDirection -> CharDirection -> Ordering)
-> (CharDirection -> CharDirection -> Bool)
-> (CharDirection -> CharDirection -> Bool)
-> (CharDirection -> CharDirection -> Bool)
-> (CharDirection -> CharDirection -> Bool)
-> (CharDirection -> CharDirection -> CharDirection)
-> (CharDirection -> CharDirection -> CharDirection)
-> Ord CharDirection
CharDirection -> CharDirection -> Bool
CharDirection -> CharDirection -> Ordering
CharDirection -> CharDirection -> CharDirection
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 :: CharDirection -> CharDirection -> CharDirection
$cmin :: CharDirection -> CharDirection -> CharDirection
max :: CharDirection -> CharDirection -> CharDirection
$cmax :: CharDirection -> CharDirection -> CharDirection
>= :: CharDirection -> CharDirection -> Bool
$c>= :: CharDirection -> CharDirection -> Bool
> :: CharDirection -> CharDirection -> Bool
$c> :: CharDirection -> CharDirection -> Bool
<= :: CharDirection -> CharDirection -> Bool
$c<= :: CharDirection -> CharDirection -> Bool
< :: CharDirection -> CharDirection -> Bool
$c< :: CharDirection -> CharDirection -> Bool
compare :: CharDirection -> CharDirection -> Ordering
$ccompare :: CharDirection -> CharDirection -> Ordering
Ord,Int -> CharDirection -> ShowS
[CharDirection] -> ShowS
CharDirection -> String
(Int -> CharDirection -> ShowS)
-> (CharDirection -> String)
-> ([CharDirection] -> ShowS)
-> Show CharDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CharDirection] -> ShowS
$cshowList :: [CharDirection] -> ShowS
show :: CharDirection -> String
$cshow :: CharDirection -> String
showsPrec :: Int -> CharDirection -> ShowS
$cshowsPrec :: Int -> CharDirection -> ShowS
Show,Ptr CharDirection -> IO CharDirection
Ptr CharDirection -> Int -> IO CharDirection
Ptr CharDirection -> Int -> CharDirection -> IO ()
Ptr CharDirection -> CharDirection -> IO ()
CharDirection -> Int
(CharDirection -> Int)
-> (CharDirection -> Int)
-> (Ptr CharDirection -> Int -> IO CharDirection)
-> (Ptr CharDirection -> Int -> CharDirection -> IO ())
-> (forall b. Ptr b -> Int -> IO CharDirection)
-> (forall b. Ptr b -> Int -> CharDirection -> IO ())
-> (Ptr CharDirection -> IO CharDirection)
-> (Ptr CharDirection -> CharDirection -> IO ())
-> Storable CharDirection
forall b. Ptr b -> Int -> IO CharDirection
forall b. Ptr b -> Int -> CharDirection -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr CharDirection -> CharDirection -> IO ()
$cpoke :: Ptr CharDirection -> CharDirection -> IO ()
peek :: Ptr CharDirection -> IO CharDirection
$cpeek :: Ptr CharDirection -> IO CharDirection
pokeByteOff :: forall b. Ptr b -> Int -> CharDirection -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> CharDirection -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO CharDirection
$cpeekByteOff :: forall b. Ptr b -> Int -> IO CharDirection
pokeElemOff :: Ptr CharDirection -> Int -> CharDirection -> IO ()
$cpokeElemOff :: Ptr CharDirection -> Int -> CharDirection -> IO ()
peekElemOff :: Ptr CharDirection -> Int -> IO CharDirection
$cpeekElemOff :: Ptr CharDirection -> Int -> IO CharDirection
alignment :: CharDirection -> Int
$calignment :: CharDirection -> Int
sizeOf :: CharDirection -> Int
$csizeOf :: CharDirection -> Int
Storable,Addr# -> Int# -> CharDirection
ByteArray# -> Int# -> CharDirection
CharDirection -> Int#
(CharDirection -> Int#)
-> (CharDirection -> Int#)
-> (ByteArray# -> Int# -> CharDirection)
-> (forall s.
    MutableByteArray# s
    -> Int# -> State# s -> (# State# s, CharDirection #))
-> (forall s.
    MutableByteArray# s
    -> Int# -> CharDirection -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> CharDirection -> State# s -> State# s)
-> (Addr# -> Int# -> CharDirection)
-> (forall s.
    Addr# -> Int# -> State# s -> (# State# s, CharDirection #))
-> (forall s.
    Addr# -> Int# -> CharDirection -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> CharDirection -> State# s -> State# s)
-> Prim CharDirection
forall s.
Addr# -> Int# -> Int# -> CharDirection -> State# s -> State# s
forall s.
Addr# -> Int# -> State# s -> (# State# s, CharDirection #)
forall s. Addr# -> Int# -> CharDirection -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> CharDirection -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, CharDirection #)
forall s.
MutableByteArray# s
-> Int# -> CharDirection -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
setOffAddr# :: forall s.
Addr# -> Int# -> Int# -> CharDirection -> State# s -> State# s
$csetOffAddr# :: forall s.
Addr# -> Int# -> Int# -> CharDirection -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> CharDirection -> State# s -> State# s
$cwriteOffAddr# :: forall s. Addr# -> Int# -> CharDirection -> State# s -> State# s
readOffAddr# :: forall s.
Addr# -> Int# -> State# s -> (# State# s, CharDirection #)
$creadOffAddr# :: forall s.
Addr# -> Int# -> State# s -> (# State# s, CharDirection #)
indexOffAddr# :: Addr# -> Int# -> CharDirection
$cindexOffAddr# :: Addr# -> Int# -> CharDirection
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> CharDirection -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> CharDirection -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s
-> Int# -> CharDirection -> State# s -> State# s
$cwriteByteArray# :: forall s.
MutableByteArray# s
-> Int# -> CharDirection -> State# s -> State# s
readByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, CharDirection #)
$creadByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, CharDirection #)
indexByteArray# :: ByteArray# -> Int# -> CharDirection
$cindexByteArray# :: ByteArray# -> Int# -> CharDirection
alignment# :: CharDirection -> Int#
$calignment# :: CharDirection -> Int#
sizeOf# :: CharDirection -> Int#
$csizeOf# :: CharDirection -> Int#
Prim)


{-# LINE 282 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | L @\@stable@ ICU 2.0
pattern $bLEFT_TO_RIGHT :: CharDirection
$mLEFT_TO_RIGHT :: forall {r}. CharDirection -> (Void# -> r) -> (Void# -> r) -> r
LEFT_TO_RIGHT = CharDirection (0)
{-# LINE 284 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | R @\@stable@ ICU 2.0
pattern $bRIGHT_TO_LEFT :: CharDirection
$mRIGHT_TO_LEFT :: forall {r}. CharDirection -> (Void# -> r) -> (Void# -> r) -> r
RIGHT_TO_LEFT = CharDirection (1)
{-# LINE 286 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | EN @\@stable@ ICU 2.0
pattern $bEUROPEAN_NUMBER :: CharDirection
$mEUROPEAN_NUMBER :: forall {r}. CharDirection -> (Void# -> r) -> (Void# -> r) -> r
EUROPEAN_NUMBER = CharDirection (2)
{-# LINE 288 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | ES @\@stable@ ICU 2.0
pattern $bEUROPEAN_NUMBER_SEPARATOR :: CharDirection
$mEUROPEAN_NUMBER_SEPARATOR :: forall {r}. CharDirection -> (Void# -> r) -> (Void# -> r) -> r
EUROPEAN_NUMBER_SEPARATOR = CharDirection (3)
{-# LINE 290 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | ET @\@stable@ ICU 2.0
pattern $bEUROPEAN_NUMBER_TERMINATOR :: CharDirection
$mEUROPEAN_NUMBER_TERMINATOR :: forall {r}. CharDirection -> (Void# -> r) -> (Void# -> r) -> r
EUROPEAN_NUMBER_TERMINATOR = CharDirection (4)
{-# LINE 292 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | AN @\@stable@ ICU 2.0
pattern $bARABIC_NUMBER :: CharDirection
$mARABIC_NUMBER :: forall {r}. CharDirection -> (Void# -> r) -> (Void# -> r) -> r
ARABIC_NUMBER = CharDirection (5)
{-# LINE 294 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | CS @\@stable@ ICU 2.0
pattern $bCOMMON_NUMBER_SEPARATOR :: CharDirection
$mCOMMON_NUMBER_SEPARATOR :: forall {r}. CharDirection -> (Void# -> r) -> (Void# -> r) -> r
COMMON_NUMBER_SEPARATOR = CharDirection (6)
{-# LINE 296 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | B @\@stable@ ICU 2.0
pattern $bBLOCK_SEPARATOR :: CharDirection
$mBLOCK_SEPARATOR :: forall {r}. CharDirection -> (Void# -> r) -> (Void# -> r) -> r
BLOCK_SEPARATOR = CharDirection (7)
{-# LINE 298 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | SS@\@stable@ ICU 2.0
pattern $bSEGMENT_SEPARATOR :: CharDirection
$mSEGMENT_SEPARATOR :: forall {r}. CharDirection -> (Void# -> r) -> (Void# -> r) -> r
SEGMENT_SEPARATOR = CharDirection (8)
{-# LINE 300 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | WS @\@stable@ ICU 2.0
pattern $bWHITE_SPACE_NEUTRAL :: CharDirection
$mWHITE_SPACE_NEUTRAL :: forall {r}. CharDirection -> (Void# -> r) -> (Void# -> r) -> r
WHITE_SPACE_NEUTRAL = CharDirection (9)
{-# LINE 302 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | ON @\@stable@ ICU 2.0
pattern $bOTHER_NEUTRAL :: CharDirection
$mOTHER_NEUTRAL :: forall {r}. CharDirection -> (Void# -> r) -> (Void# -> r) -> r
OTHER_NEUTRAL = CharDirection (10)
{-# LINE 304 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | LRE @\@stable@ ICU 2.0
pattern $bLEFT_TO_RIGHT_EMBEDDING :: CharDirection
$mLEFT_TO_RIGHT_EMBEDDING :: forall {r}. CharDirection -> (Void# -> r) -> (Void# -> r) -> r
LEFT_TO_RIGHT_EMBEDDING = CharDirection (11)
{-# LINE 306 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | LRO @\@stable@ ICU 2.0
pattern $bLEFT_TO_RIGHT_OVERRIDE :: CharDirection
$mLEFT_TO_RIGHT_OVERRIDE :: forall {r}. CharDirection -> (Void# -> r) -> (Void# -> r) -> r
LEFT_TO_RIGHT_OVERRIDE = CharDirection (12)
{-# LINE 308 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | AL @\@stable@ ICU 2.0
pattern $bRIGHT_TO_LEFT_ARABIC :: CharDirection
$mRIGHT_TO_LEFT_ARABIC :: forall {r}. CharDirection -> (Void# -> r) -> (Void# -> r) -> r
RIGHT_TO_LEFT_ARABIC = CharDirection (13)
{-# LINE 310 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | RLE @\@stable@ ICU 2.0
pattern $bRIGHT_TO_LEFT_EMBEDDING :: CharDirection
$mRIGHT_TO_LEFT_EMBEDDING :: forall {r}. CharDirection -> (Void# -> r) -> (Void# -> r) -> r
RIGHT_TO_LEFT_EMBEDDING = CharDirection (14)
{-# LINE 312 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | RLO @\@stable@ ICU 2.0
pattern $bRIGHT_TO_LEFT_OVERRIDE :: CharDirection
$mRIGHT_TO_LEFT_OVERRIDE :: forall {r}. CharDirection -> (Void# -> r) -> (Void# -> r) -> r
RIGHT_TO_LEFT_OVERRIDE = CharDirection (15)
{-# LINE 314 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | PDF @\@stable@ ICU 2.0
pattern $bPOP_DIRECTIONAL_FORMAT :: CharDirection
$mPOP_DIRECTIONAL_FORMAT :: forall {r}. CharDirection -> (Void# -> r) -> (Void# -> r) -> r
POP_DIRECTIONAL_FORMAT = CharDirection (16)
{-# LINE 316 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | NSM @\@stable@ ICU 2.0
pattern $bDIR_NON_SPACING_MARK :: CharDirection
$mDIR_NON_SPACING_MARK :: forall {r}. CharDirection -> (Void# -> r) -> (Void# -> r) -> r
DIR_NON_SPACING_MARK = CharDirection (17)
{-# LINE 318 "src/Data/Text/ICU/Bidi.hsc" #-}

-- after text-icu scanned the headers

-- | BN @\@stable@ ICU 52
pattern $bBOUNDARY_NEUTRAL :: CharDirection
$mBOUNDARY_NEUTRAL :: forall {r}. CharDirection -> (Void# -> r) -> (Void# -> r) -> r
BOUNDARY_NEUTRAL = CharDirection (18)
{-# LINE 323 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | FSI @\@stable@ ICU 52
pattern $bFIRST_STRONG_ISOLATE :: CharDirection
$mFIRST_STRONG_ISOLATE :: forall {r}. CharDirection -> (Void# -> r) -> (Void# -> r) -> r
FIRST_STRONG_ISOLATE = CharDirection (19)
{-# LINE 325 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | LRI @\@stable@ ICU 52
pattern $bLEFT_TO_RIGHT_ISOLATE :: CharDirection
$mLEFT_TO_RIGHT_ISOLATE :: forall {r}. CharDirection -> (Void# -> r) -> (Void# -> r) -> r
LEFT_TO_RIGHT_ISOLATE = CharDirection (20)
{-# LINE 327 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | RLI @\@stable@ ICU 52
pattern $bRIGHT_TO_LEFT_ISOLATE :: CharDirection
$mRIGHT_TO_LEFT_ISOLATE :: forall {r}. CharDirection -> (Void# -> r) -> (Void# -> r) -> r
RIGHT_TO_LEFT_ISOLATE = CharDirection (21)
{-# LINE 329 "src/Data/Text/ICU/Bidi.hsc" #-}
-- | PDI @\@stable@ ICU 52
pattern $bPOP_DIRECTIONAL_ISOLATE :: CharDirection
$mPOP_DIRECTIONAL_ISOLATE :: forall {r}. CharDirection -> (Void# -> r) -> (Void# -> r) -> r
POP_DIRECTIONAL_ISOLATE = CharDirection (22)
{-# LINE 331 "src/Data/Text/ICU/Bidi.hsc" #-}

-- | ICU 58 The numeric value may change over time, see ICU ticket #12420.
pattern $bBIDI_CLASS_DEFAULT :: CharDirection
$mBIDI_CLASS_DEFAULT :: forall {r}. CharDirection -> (Void# -> r) -> (Void# -> r) -> r
BIDI_CLASS_DEFAULT = CharDirection (23) -- a damn lie
{-# LINE 334 "src/Data/Text/ICU/Bidi.hsc" #-}

{-# LINE 335 "src/Data/Text/ICU/Bidi.hsc" #-}

type ClassCallback = Ptr () -> Int32 -> IO CharDirection

foreign import ccall "wrapper" mkClassCallback :: ClassCallback -> IO (FunPtr ClassCallback)

ubool :: Int8 -> Bool
ubool :: Int8 -> Bool
ubool = (Int8
0Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
/=)

boolu :: Bool -> Int8
boolu :: Bool -> Int8
boolu = Int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int8) -> (Bool -> Int) -> Bool -> Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum

data Direction
  = LTR
  | RTL
  | Mixed
  | Neutral
  deriving (Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
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,Eq Direction
Eq Direction
-> (Direction -> Direction -> Ordering)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Direction)
-> (Direction -> Direction -> Direction)
-> Ord 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,Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
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,Ord Direction
Ord Direction
-> ((Direction, Direction) -> [Direction])
-> ((Direction, Direction) -> Direction -> Int)
-> ((Direction, Direction) -> Direction -> Int)
-> ((Direction, Direction) -> Direction -> Bool)
-> ((Direction, Direction) -> Int)
-> ((Direction, Direction) -> Int)
-> Ix Direction
(Direction, Direction) -> Int
(Direction, Direction) -> [Direction]
(Direction, Direction) -> Direction -> Bool
(Direction, Direction) -> Direction -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Direction, Direction) -> Int
$cunsafeRangeSize :: (Direction, Direction) -> Int
rangeSize :: (Direction, Direction) -> Int
$crangeSize :: (Direction, Direction) -> Int
inRange :: (Direction, Direction) -> Direction -> Bool
$cinRange :: (Direction, Direction) -> Direction -> Bool
unsafeIndex :: (Direction, Direction) -> Direction -> Int
$cunsafeIndex :: (Direction, Direction) -> Direction -> Int
index :: (Direction, Direction) -> Direction -> Int
$cindex :: (Direction, Direction) -> Direction -> Int
range :: (Direction, Direction) -> [Direction]
$crange :: (Direction, Direction) -> [Direction]
Ix,Int -> Direction
Direction -> Int
Direction -> [Direction]
Direction -> Direction
Direction -> Direction -> [Direction]
Direction -> Direction -> Direction -> [Direction]
(Direction -> Direction)
-> (Direction -> Direction)
-> (Int -> Direction)
-> (Direction -> Int)
-> (Direction -> [Direction])
-> (Direction -> Direction -> [Direction])
-> (Direction -> Direction -> [Direction])
-> (Direction -> Direction -> Direction -> [Direction])
-> Enum Direction
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Direction -> Direction -> Direction -> [Direction]
$cenumFromThenTo :: Direction -> Direction -> Direction -> [Direction]
enumFromTo :: Direction -> Direction -> [Direction]
$cenumFromTo :: Direction -> Direction -> [Direction]
enumFromThen :: Direction -> Direction -> [Direction]
$cenumFromThen :: Direction -> Direction -> [Direction]
enumFrom :: Direction -> [Direction]
$cenumFrom :: Direction -> [Direction]
fromEnum :: Direction -> Int
$cfromEnum :: Direction -> Int
toEnum :: Int -> Direction
$ctoEnum :: Int -> Direction
pred :: Direction -> Direction
$cpred :: Direction -> Direction
succ :: Direction -> Direction
$csucc :: Direction -> Direction
Enum,Direction
Direction -> Direction -> Bounded Direction
forall a. a -> a -> Bounded a
maxBound :: Direction
$cmaxBound :: Direction
minBound :: Direction
$cminBound :: Direction
Bounded,Typeable Direction
Typeable Direction
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Direction -> c Direction)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Direction)
-> (Direction -> Constr)
-> (Direction -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Direction))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Direction))
-> ((forall b. Data b => b -> b) -> Direction -> Direction)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Direction -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Direction -> r)
-> (forall u. (forall d. Data d => d -> u) -> Direction -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Direction -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Direction -> m Direction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Direction -> m Direction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Direction -> m Direction)
-> Data Direction
Direction -> DataType
Direction -> Constr
(forall b. Data b => b -> b) -> Direction -> Direction
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Direction -> u
forall u. (forall d. Data d => d -> u) -> Direction -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Direction -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Direction -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Direction
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Direction -> c Direction
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Direction)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Direction)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Direction -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Direction -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Direction -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Direction -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Direction -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Direction -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Direction -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Direction -> r
gmapT :: (forall b. Data b => b -> b) -> Direction -> Direction
$cgmapT :: (forall b. Data b => b -> b) -> Direction -> Direction
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Direction)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Direction)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Direction)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Direction)
dataTypeOf :: Direction -> DataType
$cdataTypeOf :: Direction -> DataType
toConstr :: Direction -> Constr
$ctoConstr :: Direction -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Direction
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Direction
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Direction -> c Direction
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Direction -> c Direction
Data,(forall x. Direction -> Rep Direction x)
-> (forall x. Rep Direction x -> Direction) -> Generic Direction
forall x. Rep Direction x -> Direction
forall x. Direction -> Rep Direction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Direction x -> Direction
$cfrom :: forall x. Direction -> Rep Direction x
Generic)

data ReorderingMode
  = ReorderDefault
  | ReorderNumbersSpecial
  | ReorderGroupNumbersWithR
  | ReorderRunsOnly
  | ReorderInverseNumbersAsL
  | ReorderInverseLikeDirect
  | ReorderInverseForNumbersSpecial
  | ReorderCount
  deriving (ReorderingMode -> ReorderingMode -> Bool
(ReorderingMode -> ReorderingMode -> Bool)
-> (ReorderingMode -> ReorderingMode -> Bool) -> Eq ReorderingMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReorderingMode -> ReorderingMode -> Bool
$c/= :: ReorderingMode -> ReorderingMode -> Bool
== :: ReorderingMode -> ReorderingMode -> Bool
$c== :: ReorderingMode -> ReorderingMode -> Bool
Eq,Eq ReorderingMode
Eq ReorderingMode
-> (ReorderingMode -> ReorderingMode -> Ordering)
-> (ReorderingMode -> ReorderingMode -> Bool)
-> (ReorderingMode -> ReorderingMode -> Bool)
-> (ReorderingMode -> ReorderingMode -> Bool)
-> (ReorderingMode -> ReorderingMode -> Bool)
-> (ReorderingMode -> ReorderingMode -> ReorderingMode)
-> (ReorderingMode -> ReorderingMode -> ReorderingMode)
-> Ord ReorderingMode
ReorderingMode -> ReorderingMode -> Bool
ReorderingMode -> ReorderingMode -> Ordering
ReorderingMode -> ReorderingMode -> ReorderingMode
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 :: ReorderingMode -> ReorderingMode -> ReorderingMode
$cmin :: ReorderingMode -> ReorderingMode -> ReorderingMode
max :: ReorderingMode -> ReorderingMode -> ReorderingMode
$cmax :: ReorderingMode -> ReorderingMode -> ReorderingMode
>= :: ReorderingMode -> ReorderingMode -> Bool
$c>= :: ReorderingMode -> ReorderingMode -> Bool
> :: ReorderingMode -> ReorderingMode -> Bool
$c> :: ReorderingMode -> ReorderingMode -> Bool
<= :: ReorderingMode -> ReorderingMode -> Bool
$c<= :: ReorderingMode -> ReorderingMode -> Bool
< :: ReorderingMode -> ReorderingMode -> Bool
$c< :: ReorderingMode -> ReorderingMode -> Bool
compare :: ReorderingMode -> ReorderingMode -> Ordering
$ccompare :: ReorderingMode -> ReorderingMode -> Ordering
Ord,Int -> ReorderingMode -> ShowS
[ReorderingMode] -> ShowS
ReorderingMode -> String
(Int -> ReorderingMode -> ShowS)
-> (ReorderingMode -> String)
-> ([ReorderingMode] -> ShowS)
-> Show ReorderingMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReorderingMode] -> ShowS
$cshowList :: [ReorderingMode] -> ShowS
show :: ReorderingMode -> String
$cshow :: ReorderingMode -> String
showsPrec :: Int -> ReorderingMode -> ShowS
$cshowsPrec :: Int -> ReorderingMode -> ShowS
Show,Ord ReorderingMode
Ord ReorderingMode
-> ((ReorderingMode, ReorderingMode) -> [ReorderingMode])
-> ((ReorderingMode, ReorderingMode) -> ReorderingMode -> Int)
-> ((ReorderingMode, ReorderingMode) -> ReorderingMode -> Int)
-> ((ReorderingMode, ReorderingMode) -> ReorderingMode -> Bool)
-> ((ReorderingMode, ReorderingMode) -> Int)
-> ((ReorderingMode, ReorderingMode) -> Int)
-> Ix ReorderingMode
(ReorderingMode, ReorderingMode) -> Int
(ReorderingMode, ReorderingMode) -> [ReorderingMode]
(ReorderingMode, ReorderingMode) -> ReorderingMode -> Bool
(ReorderingMode, ReorderingMode) -> ReorderingMode -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (ReorderingMode, ReorderingMode) -> Int
$cunsafeRangeSize :: (ReorderingMode, ReorderingMode) -> Int
rangeSize :: (ReorderingMode, ReorderingMode) -> Int
$crangeSize :: (ReorderingMode, ReorderingMode) -> Int
inRange :: (ReorderingMode, ReorderingMode) -> ReorderingMode -> Bool
$cinRange :: (ReorderingMode, ReorderingMode) -> ReorderingMode -> Bool
unsafeIndex :: (ReorderingMode, ReorderingMode) -> ReorderingMode -> Int
$cunsafeIndex :: (ReorderingMode, ReorderingMode) -> ReorderingMode -> Int
index :: (ReorderingMode, ReorderingMode) -> ReorderingMode -> Int
$cindex :: (ReorderingMode, ReorderingMode) -> ReorderingMode -> Int
range :: (ReorderingMode, ReorderingMode) -> [ReorderingMode]
$crange :: (ReorderingMode, ReorderingMode) -> [ReorderingMode]
Ix,Int -> ReorderingMode
ReorderingMode -> Int
ReorderingMode -> [ReorderingMode]
ReorderingMode -> ReorderingMode
ReorderingMode -> ReorderingMode -> [ReorderingMode]
ReorderingMode
-> ReorderingMode -> ReorderingMode -> [ReorderingMode]
(ReorderingMode -> ReorderingMode)
-> (ReorderingMode -> ReorderingMode)
-> (Int -> ReorderingMode)
-> (ReorderingMode -> Int)
-> (ReorderingMode -> [ReorderingMode])
-> (ReorderingMode -> ReorderingMode -> [ReorderingMode])
-> (ReorderingMode -> ReorderingMode -> [ReorderingMode])
-> (ReorderingMode
    -> ReorderingMode -> ReorderingMode -> [ReorderingMode])
-> Enum ReorderingMode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ReorderingMode
-> ReorderingMode -> ReorderingMode -> [ReorderingMode]
$cenumFromThenTo :: ReorderingMode
-> ReorderingMode -> ReorderingMode -> [ReorderingMode]
enumFromTo :: ReorderingMode -> ReorderingMode -> [ReorderingMode]
$cenumFromTo :: ReorderingMode -> ReorderingMode -> [ReorderingMode]
enumFromThen :: ReorderingMode -> ReorderingMode -> [ReorderingMode]
$cenumFromThen :: ReorderingMode -> ReorderingMode -> [ReorderingMode]
enumFrom :: ReorderingMode -> [ReorderingMode]
$cenumFrom :: ReorderingMode -> [ReorderingMode]
fromEnum :: ReorderingMode -> Int
$cfromEnum :: ReorderingMode -> Int
toEnum :: Int -> ReorderingMode
$ctoEnum :: Int -> ReorderingMode
pred :: ReorderingMode -> ReorderingMode
$cpred :: ReorderingMode -> ReorderingMode
succ :: ReorderingMode -> ReorderingMode
$csucc :: ReorderingMode -> ReorderingMode
Enum,ReorderingMode
ReorderingMode -> ReorderingMode -> Bounded ReorderingMode
forall a. a -> a -> Bounded a
maxBound :: ReorderingMode
$cmaxBound :: ReorderingMode
minBound :: ReorderingMode
$cminBound :: ReorderingMode
Bounded,Typeable ReorderingMode
Typeable ReorderingMode
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ReorderingMode -> c ReorderingMode)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ReorderingMode)
-> (ReorderingMode -> Constr)
-> (ReorderingMode -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ReorderingMode))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ReorderingMode))
-> ((forall b. Data b => b -> b)
    -> ReorderingMode -> ReorderingMode)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ReorderingMode -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ReorderingMode -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ReorderingMode -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ReorderingMode -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ReorderingMode -> m ReorderingMode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ReorderingMode -> m ReorderingMode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ReorderingMode -> m ReorderingMode)
-> Data ReorderingMode
ReorderingMode -> DataType
ReorderingMode -> Constr
(forall b. Data b => b -> b) -> ReorderingMode -> ReorderingMode
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ReorderingMode -> u
forall u. (forall d. Data d => d -> u) -> ReorderingMode -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ReorderingMode -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ReorderingMode -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ReorderingMode -> m ReorderingMode
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ReorderingMode -> m ReorderingMode
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ReorderingMode
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ReorderingMode -> c ReorderingMode
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ReorderingMode)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ReorderingMode)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ReorderingMode -> m ReorderingMode
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ReorderingMode -> m ReorderingMode
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ReorderingMode -> m ReorderingMode
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ReorderingMode -> m ReorderingMode
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ReorderingMode -> m ReorderingMode
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ReorderingMode -> m ReorderingMode
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ReorderingMode -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ReorderingMode -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ReorderingMode -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ReorderingMode -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ReorderingMode -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ReorderingMode -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ReorderingMode -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ReorderingMode -> r
gmapT :: (forall b. Data b => b -> b) -> ReorderingMode -> ReorderingMode
$cgmapT :: (forall b. Data b => b -> b) -> ReorderingMode -> ReorderingMode
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ReorderingMode)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ReorderingMode)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ReorderingMode)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ReorderingMode)
dataTypeOf :: ReorderingMode -> DataType
$cdataTypeOf :: ReorderingMode -> DataType
toConstr :: ReorderingMode -> Constr
$ctoConstr :: ReorderingMode -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ReorderingMode
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ReorderingMode
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ReorderingMode -> c ReorderingMode
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ReorderingMode -> c ReorderingMode
Data,(forall x. ReorderingMode -> Rep ReorderingMode x)
-> (forall x. Rep ReorderingMode x -> ReorderingMode)
-> Generic ReorderingMode
forall x. Rep ReorderingMode x -> ReorderingMode
forall x. ReorderingMode -> Rep ReorderingMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReorderingMode x -> ReorderingMode
$cfrom :: forall x. ReorderingMode -> Rep ReorderingMode x
Generic)

data UBiDi

data Bidi s = Bidi
  { forall {k} (s :: k). Bidi s -> IORef (Ptr Level)
embeddingLevels :: IORef (Ptr Level)  -- used to deal with ubidi_setPara shared content issues
  , forall {k} (s :: k). Bidi s -> IORef (Maybe (Bidi s))
parentLink :: IORef (Maybe (Bidi s))  -- used to deal with ubidi_setLine shared content issues
  , forall {k} (s :: k). Bidi s -> ForeignPtr UBiDi
getBidi :: ForeignPtr UBiDi
  }

withBidi :: Bidi s -> (Ptr UBiDi -> IO r) -> IO r
withBidi :: forall {k} (s :: k) r. Bidi s -> (Ptr UBiDi -> IO r) -> IO r
withBidi = ForeignPtr UBiDi -> (Ptr UBiDi -> IO r) -> IO r
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (ForeignPtr UBiDi -> (Ptr UBiDi -> IO r) -> IO r)
-> (Bidi s -> ForeignPtr UBiDi)
-> Bidi s
-> (Ptr UBiDi -> IO r)
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bidi s -> ForeignPtr UBiDi
forall {k} (s :: k). Bidi s -> ForeignPtr UBiDi
getBidi

let
  anti cTy hsTyQ w = C.SomeAntiQuoter C.AntiQuoter
    { C.aqParser = C.parseIdentifier <&> \hId -> (C.mangleHaskellIdentifier False hId, cTy, hId)
    , C.aqMarshaller = \_ _ _ cId -> (,) <$> hsTyQ <*> [|$w (coerce $(getHsVariable "bidirectionalCtx" cId))|]
    }
  getHsVariable err s = TH.lookupValueName (C.unHaskellIdentifier s) >>= \ case
    Nothing -> fail $ "Cannot capture Haskell variable " ++ C.unHaskellIdentifier s ++ ", because it's not in scope. (" ++ err ++ ")"
    Just hsName -> TH.varE hsName
 in C.context $ C.baseCtx <> C.fptrCtx <> mempty
      { C.ctxTypesTable = Map.fromList
        [ (C.TypeName "UBiDi", [t|UBiDi|])
        , (C.TypeName "UBiDiDirection", [t|Int32|])
        , (C.TypeName "UBiDiLevel", [t|Level|])
        , (C.TypeName "UBiDiReorderingMode", [t|Int32|])
        , (C.TypeName "UBiDiReorderingOption", [t|ReorderingOption|])
        , (C.TypeName "UBiDiClassCallbackPtr", [t|FunPtr ClassCallback|])
        , (C.TypeName "UBool", [t|Int8|])
        , (C.TypeName "UChar", [t|Word16|])
        , (C.TypeName "UChar32", [t|Int32|])
        , (C.TypeName "UCharDirection", [t|CharDirection|])
        , (C.TypeName "UErrorCode", [t|UErrorCode|])
        , (C.TypeName "WriteOptions", [t|WriteOptions|])
        ]
      , C.ctxAntiQuoters = Map.fromList
        [ ("bidi", anti (C.Ptr [] $ C.TypeSpecifier mempty $ C.TypeName "UBiDi") 
                        [t|Ptr UBiDi|] [|withBidi|]
          )
        ]
      }

C.include "HsFFI.h"
C.include "unicode/utypes.h"
C.include "unicode/uchar.h"
C.include "unicode/localpointer.h"
C.include "unicode/ubidi.h"

C.verbatim "typedef UBiDiClassCallback * UBiDiClassCallbackPtr;"
C.verbatim "typedef int16_t WriteOptions;"

instance Exception UErrorCode where
  displayException :: UErrorCode -> String
displayException UErrorCode
e = IO String -> String
forall a. IO a -> a
unsafeLocalState (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$ CString -> IO String
peekCString 
    [C.pure|const char * { u_errorName($(UErrorCode e)) }|]

foreignBidi :: Ptr UBiDi -> IO (Bidi s)
foreignBidi :: forall {k} (s :: k). Ptr UBiDi -> IO (Bidi s)
foreignBidi Ptr UBiDi
self_ptr = do
  IORef (Ptr Level)
embeddings_ref <- Ptr Level -> IO (IORef (Ptr Level))
forall a. a -> IO (IORef a)
newIORef Ptr Level
forall a. Ptr a
nullPtr -- embeddingLevels
  IORef (Maybe (Bidi s))
parent_ref <- Maybe (Bidi s) -> IO (IORef (Maybe (Bidi s)))
forall a. a -> IO (IORef a)
newIORef Maybe (Bidi s)
forall a. Maybe a
Nothing -- parentLink
  ForeignPtr UBiDi
self_fptr <- Ptr UBiDi -> IO () -> IO (ForeignPtr UBiDi)
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
Concurrent.newForeignPtr Ptr UBiDi
self_ptr do
    [C.block|void { ubidi_close($(UBiDi * self_ptr)); }|] -- delete self
    Ptr Level
embeddings <- IORef (Ptr Level) -> IO (Ptr Level)
forall a. IORef a -> IO a
readIORef IORef (Ptr Level)
embeddings_ref -- clean up embeddings
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr Level
embeddings Ptr Level -> Ptr Level -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Level
forall a. Ptr a
nullPtr) do Ptr Level -> IO ()
forall a. Ptr a -> IO ()
free Ptr Level
embeddings
    -- garbage collecting the parent link will allow parent to now possibly be freed if it has no references
  Bidi s -> IO (Bidi s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bidi s -> IO (Bidi s)) -> Bidi s -> IO (Bidi s)
forall a b. (a -> b) -> a -> b
$ IORef (Ptr Level)
-> IORef (Maybe (Bidi s)) -> ForeignPtr UBiDi -> Bidi s
forall {k} (s :: k).
IORef (Ptr Level)
-> IORef (Maybe (Bidi s)) -> ForeignPtr UBiDi -> Bidi s
Bidi IORef (Ptr Level)
embeddings_ref IORef (Maybe (Bidi s))
parent_ref ForeignPtr UBiDi
self_fptr

bad :: UErrorCode -> Bool
bad :: UErrorCode -> Bool
bad UErrorCode
e = [C.pure|int { U_FAILURE($(UErrorCode e)) }|] CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0

ok :: UErrorCode -> IO ()
ok :: UErrorCode -> IO ()
ok UErrorCode
e = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UErrorCode -> Bool
bad UErrorCode
e) do UErrorCode -> IO ()
forall e a. Exception e => e -> IO a
throwIO UErrorCode
e

open :: PrimMonad m => m (Bidi (PrimState m))
open :: forall (m :: * -> *). PrimMonad m => m (Bidi (PrimState m))
open = IO (Bidi (PrimState m)) -> m (Bidi (PrimState m))
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim do [C.exp|UBiDi * { ubidi_open() }|] IO (Ptr UBiDi)
-> (Ptr UBiDi -> IO (Bidi (PrimState m)))
-> IO (Bidi (PrimState m))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr UBiDi -> IO (Bidi (PrimState m))
forall {k} (s :: k). Ptr UBiDi -> IO (Bidi s)
foreignBidi

openSized :: PrimMonad m => Int32 -> Int32 -> m (Bidi (PrimState m))
openSized :: forall (m :: * -> *).
PrimMonad m =>
Int32 -> Int32 -> m (Bidi (PrimState m))
openSized Int32
maxLength Int32
maxRunCount = IO (Bidi (PrimState m)) -> m (Bidi (PrimState m))
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim do
  UErrorCode
-> (Ptr UErrorCode -> IO (Bidi (PrimState m)))
-> IO (Bidi (PrimState m))
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with UErrorCode
forall a. Default a => a
def \Ptr UErrorCode
pErrorCode -> do
    Ptr UBiDi
bidi <- [C.exp|UBiDi * { ubidi_openSized($(int32_t maxLength),$(int32_t maxRunCount),$(UErrorCode * pErrorCode)) }|]
    Ptr UErrorCode -> IO UErrorCode
forall a. Storable a => Ptr a -> IO a
peek Ptr UErrorCode
pErrorCode IO UErrorCode -> (UErrorCode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UErrorCode -> IO ()
ok
    Ptr UBiDi -> IO (Bidi (PrimState m))
forall {k} (s :: k). Ptr UBiDi -> IO (Bidi s)
foreignBidi Ptr UBiDi
bidi

getText :: PrimMonad m => Bidi (PrimState m) -> m Text
getText :: forall (m :: * -> *). PrimMonad m => Bidi (PrimState m) -> m Text
getText Bidi (PrimState m)
bidi = IO Text -> m Text
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim do
  Bidi (PrimState m) -> (Ptr UBiDi -> IO Text) -> IO Text
forall {k} (s :: k) r. Bidi s -> (Ptr UBiDi -> IO r) -> IO r
withBidi Bidi (PrimState m)
bidi \Ptr UBiDi
p -> do
    Ptr Word16
cwstr <- [C.exp|const UChar * { ubidi_getText($(const UBiDi * p))}|]
    Int32
len <- [C.exp|int32_t { ubidi_getLength($(const UBiDi * p))}|]
    Ptr Word16 -> I16 -> IO Text
fromPtr Ptr Word16
cwstr (Int32 -> I16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
len)

getLength :: PrimMonad m => Bidi (PrimState m) -> m Int32
getLength :: forall (m :: * -> *). PrimMonad m => Bidi (PrimState m) -> m Int32
getLength Bidi (PrimState m)
bidi = IO Int32 -> m Int32
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim [C.exp|int32_t { ubidi_getLength($bidi:bidi) }|]

setInverse :: PrimMonad m => Bidi (PrimState m) -> Bool -> m ()
setInverse :: forall (m :: * -> *).
PrimMonad m =>
Bidi (PrimState m) -> Bool -> m ()
setInverse Bidi (PrimState m)
bidi (Bool -> Int8
boolu -> Int8
b) = IO () -> m ()
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim [C.block|void { ubidi_setInverse($bidi:bidi,$(UBool b)); }|]

isInverse :: PrimMonad m => Bidi (PrimState m) -> m Bool
isInverse :: forall (m :: * -> *). PrimMonad m => Bidi (PrimState m) -> m Bool
isInverse Bidi (PrimState m)
bidi = IO Bool -> m Bool
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim do [C.exp|UBool { ubidi_isInverse($bidi:bidi) }|] IO Int8 -> (Int8 -> Bool) -> IO Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Int8 -> Bool
ubool

orderParagraphsLTR :: PrimMonad m => Bidi (PrimState m) -> Bool -> m ()
orderParagraphsLTR :: forall (m :: * -> *).
PrimMonad m =>
Bidi (PrimState m) -> Bool -> m ()
orderParagraphsLTR Bidi (PrimState m)
bidi (Bool -> Int8
boolu -> Int8
b) = IO () -> m ()
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim [C.block|void { ubidi_orderParagraphsLTR($bidi:bidi,$(UBool b)); }|]

isOrderParagraphsLTR :: PrimMonad m => Bidi (PrimState m) -> m Bool
isOrderParagraphsLTR :: forall (m :: * -> *). PrimMonad m => Bidi (PrimState m) -> m Bool
isOrderParagraphsLTR Bidi (PrimState m)
bidi = IO Bool -> m Bool
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim do [C.exp|UBool { ubidi_isOrderParagraphsLTR($bidi:bidi) }|] IO Int8 -> (Int8 -> Bool) -> IO Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Int8 -> Bool
ubool

setReorderingMode :: PrimMonad m => Bidi (PrimState m) -> ReorderingMode -> m ()
setReorderingMode :: forall (m :: * -> *).
PrimMonad m =>
Bidi (PrimState m) -> ReorderingMode -> m ()
setReorderingMode Bidi (PrimState m)
bidi (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32)
-> (ReorderingMode -> Int) -> ReorderingMode -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReorderingMode -> Int
forall a. Enum a => a -> Int
fromEnum -> Int32
mode) = IO () -> m ()
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim [C.block|void { ubidi_setReorderingMode($bidi:bidi,$(UBiDiReorderingMode mode)); }|]

getReorderingMode :: PrimMonad m => Bidi (PrimState m) -> m ReorderingMode
getReorderingMode :: forall (m :: * -> *).
PrimMonad m =>
Bidi (PrimState m) -> m ReorderingMode
getReorderingMode Bidi (PrimState m)
bidi = IO ReorderingMode -> m ReorderingMode
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim do [C.exp|UBiDiReorderingMode{ ubidi_getReorderingMode($bidi:bidi)}|] IO Int32 -> (Int32 -> ReorderingMode) -> IO ReorderingMode
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Int -> ReorderingMode
forall a. Enum a => Int -> a
toEnum (Int -> ReorderingMode)
-> (Int32 -> Int) -> Int32 -> ReorderingMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

setReorderingOptions :: PrimMonad m => Bidi (PrimState m) -> ReorderingOption -> m ()
setReorderingOptions :: forall (m :: * -> *).
PrimMonad m =>
Bidi (PrimState m) -> ReorderingOption -> m ()
setReorderingOptions Bidi (PrimState m)
bidi ReorderingOption
options = IO () -> m ()
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim [C.block|void { ubidi_setReorderingOptions($bidi:bidi,$(UBiDiReorderingOption options)); }|]

getReorderingOptions :: PrimMonad m => Bidi (PrimState m) -> m ReorderingOption
getReorderingOptions :: forall (m :: * -> *).
PrimMonad m =>
Bidi (PrimState m) -> m ReorderingOption
getReorderingOptions Bidi (PrimState m)
bidi = IO ReorderingOption -> m ReorderingOption
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim do [C.exp|UBiDiReorderingOption { ubidi_getReorderingOptions($bidi:bidi) }|]

setContext :: PrimMonad m => Bidi (PrimState m) -> Text -> Text -> m ()
setContext :: forall (m :: * -> *).
PrimMonad m =>
Bidi (PrimState m) -> Text -> Text -> m ()
setContext Bidi (PrimState m)
bidi Text
prologue_text Text
epilogue_text = IO () -> m ()
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim do
  Text -> (Ptr Word16 -> I16 -> IO ()) -> IO ()
forall a. Text -> (Ptr Word16 -> I16 -> IO a) -> IO a
useAsPtr Text
prologue_text \Ptr Word16
prologue (I16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int32
prologue_len) ->
    Text -> (Ptr Word16 -> I16 -> IO ()) -> IO ()
forall a. Text -> (Ptr Word16 -> I16 -> IO a) -> IO a
useAsPtr Text
epilogue_text \Ptr Word16
epilogue (I16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int32
epilogue_len) ->
      [C.block|UErrorCode {
        UErrorCode error_code = 0;
        ubidi_setContext(
          $bidi:bidi,
          $(const UChar * prologue),
          $(int32_t prologue_len),
          $(const UChar * epilogue),
          $(int32_t epilogue_len),
          &error_code
        );
        return error_code;
      }|] IO UErrorCode -> (UErrorCode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UErrorCode -> IO ()
ok

setPara :: PrimMonad m => Bidi (PrimState m) -> Text -> Level -> Maybe (Prim.Vector Level) -> m ()
setPara :: forall (m :: * -> *).
PrimMonad m =>
Bidi (PrimState m) -> Text -> Level -> Maybe (Vector Level) -> m ()
setPara Bidi (PrimState m)
bidi Text
text Level
paraLevel Maybe (Vector Level)
els = IO () -> m ()
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim do
  Text -> (Ptr Word16 -> I16 -> IO ()) -> IO ()
forall a. Text -> (Ptr Word16 -> I16 -> IO a) -> IO a
useAsPtr Text
text \Ptr Word16
t i16 :: I16
i16@(I16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
len) -> do
    (Ptr Level -> Maybe (Ptr Level) -> Ptr Level
forall a. a -> Maybe a -> a
fromMaybe Ptr Level
forall a. Ptr a
nullPtr -> Ptr Level
u) <- Maybe (Vector Level)
-> (Vector Level -> IO (Ptr Level)) -> IO (Maybe (Ptr Level))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Maybe (Vector Level)
els \(Prim.Vector Int
vofs Int
vlen (ByteArray ByteArray#
vba)) -> do
      Ptr Level
u <- if Int
vlen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len
           then Int -> IO (Ptr Level)
forall a. Int -> IO (Ptr a)
callocBytes (I16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral I16
i16)
           else Int -> IO (Ptr Level)
forall a. Int -> IO (Ptr a)
mallocBytes (I16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral I16
i16)
      Ptr Level
u Ptr Level -> IO () -> IO (Ptr Level)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Ptr Level -> PrimArray Level -> Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Ptr a -> PrimArray a -> Int -> Int -> m ()
copyPrimArrayToPtr Ptr Level
u (ByteArray# -> PrimArray Level
forall a. ByteArray# -> PrimArray a
PrimArray ByteArray#
vba) Int
vofs Int
vlen -- missing from Data.Vector
    let n :: Int32
n = I16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral I16
i16
    [C.block|UErrorCode {
      UErrorCode error_code =0;
      ubidi_setPara(
        $bidi:bidi,
        $(const UChar * t),
        $(int32_t n),
        $(UBiDiLevel paraLevel),
        $(UBiDiLevel * u),
        &error_code
      );
      return error_code;
    }|] IO UErrorCode -> (UErrorCode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UErrorCode -> IO ()
ok
    Ptr Level
v <- IORef (Ptr Level)
-> (Ptr Level -> (Ptr Level, Ptr Level)) -> IO (Ptr Level)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef (Bidi (PrimState m) -> IORef (Ptr Level)
forall {k} (s :: k). Bidi s -> IORef (Ptr Level)
embeddingLevels Bidi (PrimState m)
bidi) (Ptr Level
u,)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr Level
v Ptr Level -> Ptr Level -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Level
forall a. Ptr a
nullPtr) do Ptr Level -> IO ()
forall a. Ptr a -> IO ()
free Ptr Level
v

setLine :: PrimMonad m => Bidi (PrimState m) -> Int32 -> Int32 -> Bidi (PrimState m) -> m ()
setLine :: forall (m :: * -> *).
PrimMonad m =>
Bidi (PrimState m) -> Int32 -> Int32 -> Bidi (PrimState m) -> m ()
setLine Bidi (PrimState m)
para Int32
start Int32
limit Bidi (PrimState m)
line = IO () -> m ()
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim do
  [C.block|UErrorCode {
    UErrorCode error_code = 0;
    ubidi_setLine(
      $bidi:para,
      $(int32_t start),
      $(int32_t limit),
      $bidi:line,
      &error_code
    );
    return error_code;
  }|] IO UErrorCode -> (UErrorCode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UErrorCode -> IO ()
ok
  IORef (Maybe (Bidi (PrimState m)))
-> Maybe (Bidi (PrimState m)) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Bidi (PrimState m) -> IORef (Maybe (Bidi (PrimState m)))
forall {k} (s :: k). Bidi s -> IORef (Maybe (Bidi s))
parentLink Bidi (PrimState m)
line) (Maybe (Bidi (PrimState m)) -> IO ())
-> Maybe (Bidi (PrimState m)) -> IO ()
forall a b. (a -> b) -> a -> b
$ Bidi (PrimState m) -> Maybe (Bidi (PrimState m))
forall a. a -> Maybe a
Just Bidi (PrimState m)
para -- prevents deallocation of the paragraph bidi before we at least repurpose the line

getDirection :: PrimMonad m => Bidi (PrimState m) -> m Direction
getDirection :: forall (m :: * -> *).
PrimMonad m =>
Bidi (PrimState m) -> m Direction
getDirection Bidi (PrimState m)
bidi = IO Direction -> m Direction
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim do
  [C.exp|UBiDiDirection { ubidi_getDirection($bidi:bidi) }|] IO Int32 -> (Int32 -> Direction) -> IO Direction
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Int -> Direction
forall a. Enum a => Int -> a
toEnum (Int -> Direction) -> (Int32 -> Int) -> Int32 -> Direction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

getBaseDirection :: Text -> Direction
getBaseDirection :: Text -> Direction
getBaseDirection Text
text = IO Direction -> Direction
forall a. IO a -> a
unsafeLocalState do
  Text -> (Ptr Word16 -> I16 -> IO Direction) -> IO Direction
forall a. Text -> (Ptr Word16 -> I16 -> IO a) -> IO a
useAsPtr Text
text \Ptr Word16
t (I16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int32
len) ->
    [C.exp|UBiDiDirection { ubidi_getBaseDirection($(const UChar * t),$(int32_t len)) }|] IO Int32 -> (Int32 -> Direction) -> IO Direction
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Int -> Direction
forall a. Enum a => Int -> a
toEnum (Int -> Direction) -> (Int32 -> Int) -> Int32 -> Direction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

getParaLevel :: PrimMonad m => Bidi (PrimState m) -> m Level
getParaLevel :: forall (m :: * -> *). PrimMonad m => Bidi (PrimState m) -> m Level
getParaLevel Bidi (PrimState m)
bidi = IO Level -> m Level
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim [C.exp|UBiDiLevel { ubidi_getParaLevel($bidi:bidi) }|]

countParagraphs :: PrimMonad m => Bidi (PrimState m) -> m Int32
countParagraphs :: forall (m :: * -> *). PrimMonad m => Bidi (PrimState m) -> m Int32
countParagraphs Bidi (PrimState m)
bidi = IO Int32 -> m Int32
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim [C.exp|int32_t { ubidi_countParagraphs($bidi:bidi) }|]

-- | Given a paragraph or line bidirectional object @bidi@, and a @charIndex@ into the text
-- in the range @0@ to @'getProcessedLength' bidi -1@, this will return
-- the index of the paragraph, the index of the first character in the text,
-- the index of the end of the paragraph, and the level of the paragraph.
--
-- If the paragraph index is known, it can be more efficient to use 'getParagraphByIndex'
getParagraph :: PrimMonad m => Bidi (PrimState m) -> Int32 -> m (Int32, Int32, Int32, Level)
getParagraph :: forall (m :: * -> *).
PrimMonad m =>
Bidi (PrimState m) -> Int32 -> m (Int32, Int32, Int32, Level)
getParagraph Bidi (PrimState m)
bidi Int32
charIndex = IO (Int32, Int32, Int32, Level) -> m (Int32, Int32, Int32, Level)
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim do
  Int
-> (Ptr Int32 -> IO (Int32, Int32, Int32, Level))
-> IO (Int32, Int32, Int32, Level)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
2 \Ptr Int32
pParaStart ->
    (Ptr Level -> IO (Int32, Int32, Int32, Level))
-> IO (Int32, Int32, Int32, Level)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr Level
pParaLevel ->
      UErrorCode
-> (Ptr UErrorCode -> IO (Int32, Int32, Int32, Level))
-> IO (Int32, Int32, Int32, Level)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with UErrorCode
forall a. Default a => a
def \Ptr UErrorCode
pErrorCode -> do
        Int32
result <- [C.block|int32_t {
          int32_t * pPara = $(int32_t * pParaStart);
          return ubidi_getParagraph(
            $bidi:bidi,
            $(int32_t charIndex),
            pPara,
            pPara+1,
            $(UBiDiLevel * pParaLevel),
            $(UErrorCode * pErrorCode)
          );
        }|]
        Ptr UErrorCode -> IO UErrorCode
forall a. Storable a => Ptr a -> IO a
peek Ptr UErrorCode
pErrorCode IO UErrorCode -> (UErrorCode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UErrorCode -> IO ()
ok
        (,,,) Int32
result
          (Int32 -> Int32 -> Level -> (Int32, Int32, Int32, Level))
-> IO Int32 -> IO (Int32 -> Level -> (Int32, Int32, Int32, Level))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
pParaStart
          IO (Int32 -> Level -> (Int32, Int32, Int32, Level))
-> IO Int32 -> IO (Level -> (Int32, Int32, Int32, Level))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Int32 -> Int -> Ptr Int32
forall a. Prim a => Ptr a -> Int -> Ptr a
Prim.advancePtr Ptr Int32
pParaStart Int
1) -- pParaLimit
          IO (Level -> (Int32, Int32, Int32, Level))
-> IO Level -> IO (Int32, Int32, Int32, Level)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Level -> IO Level
forall a. Storable a => Ptr a -> IO a
peek Ptr Level
pParaLevel

getParagraphByIndex :: PrimMonad m => Bidi (PrimState m) -> Int32 -> m (Int32, Int32, Level)
getParagraphByIndex :: forall (m :: * -> *).
PrimMonad m =>
Bidi (PrimState m) -> Int32 -> m (Int32, Int32, Level)
getParagraphByIndex Bidi (PrimState m)
bidi Int32
paragraphIndex = IO (Int32, Int32, Level) -> m (Int32, Int32, Level)
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim do
  Int
-> (Ptr Int32 -> IO (Int32, Int32, Level))
-> IO (Int32, Int32, Level)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
2 \Ptr Int32
pParaStart ->
    (Ptr Level -> IO (Int32, Int32, Level)) -> IO (Int32, Int32, Level)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr Level
pParaLevel -> do
        [C.block|UErrorCode {
          int32_t * pPara = $(int32_t * pParaStart);
          UErrorCode error_code = 0;
          ubidi_getParagraph(
            $bidi:bidi,
            $(int32_t paragraphIndex),
            pPara,
            pPara+1,
            $(UBiDiLevel * pParaLevel),
            &error_code
          );
          return error_code;
        }|] IO UErrorCode -> (UErrorCode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UErrorCode -> IO ()
ok
        (,,) (Int32 -> Int32 -> Level -> (Int32, Int32, Level))
-> IO Int32 -> IO (Int32 -> Level -> (Int32, Int32, Level))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
pParaStart
             IO (Int32 -> Level -> (Int32, Int32, Level))
-> IO Int32 -> IO (Level -> (Int32, Int32, Level))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Int32 -> Int -> Ptr Int32
forall a. Prim a => Ptr a -> Int -> Ptr a
Prim.advancePtr Ptr Int32
pParaStart Int
1) -- pParaLimit
             IO (Level -> (Int32, Int32, Level))
-> IO Level -> IO (Int32, Int32, Level)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Level -> IO Level
forall a. Storable a => Ptr a -> IO a
peek Ptr Level
pParaLevel


getLevelAt :: PrimMonad m => Bidi (PrimState m) -> Int32 -> m Level
getLevelAt :: forall (m :: * -> *).
PrimMonad m =>
Bidi (PrimState m) -> Int32 -> m Level
getLevelAt Bidi (PrimState m)
bidi Int32
charIndex = IO Level -> m Level
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim [C.exp|UBiDiLevel { ubidi_getLevelAt($bidi:bidi,$(int32_t charIndex)) }|]

getLogicalRun :: PrimMonad m => Bidi (PrimState m) -> Int32 -> m (Int32, Level)
getLogicalRun :: forall (m :: * -> *).
PrimMonad m =>
Bidi (PrimState m) -> Int32 -> m (Int32, Level)
getLogicalRun Bidi (PrimState m)
bidi Int32
logicalPosition = IO (Int32, Level) -> m (Int32, Level)
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim do
  (Ptr Level -> IO (Int32, Level)) -> IO (Int32, Level)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr Level
pLevel ->
    (,) (Int32 -> Level -> (Int32, Level))
-> IO Int32 -> IO (Level -> (Int32, Level))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [C.block|int32_t {
              int32_t logicalLimit;
              ubidi_getLogicalRun(
                $bidi:bidi,
                $(int32_t logicalPosition),
                &logicalLimit,
                $(UBiDiLevel * pLevel)
              );
              return logicalLimit;
            }|]
        IO (Level -> (Int32, Level)) -> IO Level -> IO (Int32, Level)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Level -> IO Level
forall a. Storable a => Ptr a -> IO a
peek Ptr Level
pLevel

countRuns :: PrimMonad m => Bidi (PrimState m) -> m Int32
countRuns :: forall (m :: * -> *). PrimMonad m => Bidi (PrimState m) -> m Int32
countRuns Bidi (PrimState m)
bidi = IO Int32 -> m Int32
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim do
  UErrorCode -> (Ptr UErrorCode -> IO Int32) -> IO Int32
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with UErrorCode
forall a. Default a => a
def \Ptr UErrorCode
pErrorCode -> do
    [C.exp|int32_t {
      ubidi_countRuns($bidi:bidi, $(UErrorCode * pErrorCode))
    }|] IO Int32 -> IO () -> IO Int32
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Ptr UErrorCode -> IO UErrorCode
forall a. Storable a => Ptr a -> IO a
peek Ptr UErrorCode
pErrorCode IO UErrorCode -> (UErrorCode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UErrorCode -> IO ()
ok)

-- | Get one run's logical start, length, and directionality which will be LTR or RTL.
--
-- 'countRuns' should be called before the runs are retrieved
getVisualRun :: PrimMonad m => Bidi (PrimState m) -> Int32 -> m (Int32, Int32, Direction)
getVisualRun :: forall (m :: * -> *).
PrimMonad m =>
Bidi (PrimState m) -> Int32 -> m (Int32, Int32, Direction)
getVisualRun Bidi (PrimState m)
bidi Int32
runIndex = IO (Int32, Int32, Direction) -> m (Int32, Int32, Direction)
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim do
  Int
-> (Ptr Int32 -> IO (Int32, Int32, Direction))
-> IO (Int32, Int32, Direction)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
2 \Ptr Int32
pLogicalStart -> do
    Direction
dir <- [C.block|UBiDiDirection {
      int32_t * pLogicalStart = $(int32_t * pLogicalStart);
      return ubidi_getVisualRun(
        $bidi:bidi,
        $(int32_t runIndex),
        pLogicalStart,
        pLogicalStart+1 /* pLength */
      );
    }|] IO Int32 -> (Int32 -> Direction) -> IO Direction
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Int -> Direction
forall a. Enum a => Int -> a
toEnum (Int -> Direction) -> (Int32 -> Int) -> Int32 -> Direction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    Int32
logical_start <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
pLogicalStart
    Int32
len <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Int32 -> Int -> Ptr Int32
forall a. Prim a => Ptr a -> Int -> Ptr a
Prim.advancePtr Ptr Int32
pLogicalStart Int
1) -- pLength
    (Int32, Int32, Direction) -> IO (Int32, Int32, Direction)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int32
logical_start, Int32
len, Direction
dir)

invertMap :: PrimArray Int32 -> PrimArray Int32
invertMap :: PrimArray Int32 -> PrimArray Int32
invertMap PrimArray Int32
pa = IO (PrimArray Int32) -> PrimArray Int32
forall a. IO a -> a
unsafePerformIO do -- use a full heavy weight dup check as this can be slow for large maps
  let !n :: Int
n = PrimArray Int32 -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Int32
pa
  let !m :: Int
m = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int32 -> Int32 -> Int32) -> Int32 -> PrimArray Int32 -> Int32
forall a b. Prim a => (b -> a -> b) -> b -> PrimArray a -> b
foldlPrimArray' Int32 -> Int32 -> Int32
forall a. Ord a => a -> a -> a
max (-Int32
1) PrimArray Int32
pa Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1)
  Int -> (Ptr Int32 -> IO (PrimArray Int32)) -> IO (PrimArray Int32)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
m) \Ptr Int32
srcMap -> do
    Ptr Int32 -> PrimArray Int32 -> Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Ptr a -> PrimArray a -> Int -> Int -> m ()
copyPrimArrayToPtr Ptr Int32
srcMap PrimArray Int32
pa Int
0 Int
n
    let len :: Int32
len = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
    [C.block|void {
      int32_t * srcMap = $(int32_t * srcMap);
      int32_t len = $(int32_t len);
      ubidi_invertMap(srcMap,srcMap+len,len);
    }|]
    Int -> Ptr Int32 -> IO (PrimArray Int32)
forall a. Prim a => Int -> Ptr a -> IO (PrimArray a)
peekPrimArray Int
m (Ptr Int32 -> Int -> Ptr Int32
forall a. Prim a => Ptr a -> Int -> Ptr a
Prim.advancePtr Ptr Int32
srcMap Int
n) -- dstMap

getVisualIndex :: PrimMonad m => Bidi (PrimState m) -> Int32 -> m Int32
getVisualIndex :: forall (m :: * -> *).
PrimMonad m =>
Bidi (PrimState m) -> Int32 -> m Int32
getVisualIndex Bidi (PrimState m)
bidi Int32
logicalIndex = IO Int32 -> m Int32
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim do
  UErrorCode -> (Ptr UErrorCode -> IO Int32) -> IO Int32
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with UErrorCode
forall a. Default a => a
def \Ptr UErrorCode
pErrorCode ->
    [C.exp|int32_t {
      ubidi_getVisualIndex($bidi:bidi,$(int32_t logicalIndex),$(UErrorCode * pErrorCode))
    }|] IO Int32 -> IO () -> IO Int32
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Ptr UErrorCode -> IO UErrorCode
forall a. Storable a => Ptr a -> IO a
peek Ptr UErrorCode
pErrorCode IO UErrorCode -> (UErrorCode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UErrorCode -> IO ()
ok)

getLogicalIndex :: PrimMonad m => Bidi (PrimState m) -> Int32 -> m Int32
getLogicalIndex :: forall (m :: * -> *).
PrimMonad m =>
Bidi (PrimState m) -> Int32 -> m Int32
getLogicalIndex Bidi (PrimState m)
bidi Int32
visualIndex = IO Int32 -> m Int32
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim do
  UErrorCode -> (Ptr UErrorCode -> IO Int32) -> IO Int32
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with UErrorCode
forall a. Default a => a
def \Ptr UErrorCode
pErrorCode ->
    [C.exp|int32_t {
      ubidi_getLogicalIndex($bidi:bidi,$(int32_t visualIndex),$(UErrorCode * pErrorCode))
    }|] IO Int32 -> IO () -> IO Int32
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Ptr UErrorCode -> IO UErrorCode
forall a. Storable a => Ptr a -> IO a
peek Ptr UErrorCode
pErrorCode IO UErrorCode -> (UErrorCode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UErrorCode -> IO ()
ok)

getLogicalMap :: PrimMonad m => Bidi (PrimState m) -> m (PrimArray Int32)
getLogicalMap :: forall (m :: * -> *).
PrimMonad m =>
Bidi (PrimState m) -> m (PrimArray Int32)
getLogicalMap Bidi (PrimState m)
bidi = ST (PrimState m) (PrimArray Int32) -> m (PrimArray Int32)
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim do
  Int
len <- Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> ST (PrimState m) Int32 -> ST (PrimState m) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    ReorderingOption
opts <- Bidi (PrimState (ST (PrimState m)))
-> ST (PrimState m) ReorderingOption
forall (m :: * -> *).
PrimMonad m =>
Bidi (PrimState m) -> m ReorderingOption
getReorderingOptions Bidi (PrimState m)
Bidi (PrimState (ST (PrimState m)))
bidi
    Int32
processed_len <- Bidi (PrimState (ST (PrimState m))) -> ST (PrimState m) Int32
forall (m :: * -> *). PrimMonad m => Bidi (PrimState m) -> m Int32
getProcessedLength Bidi (PrimState m)
Bidi (PrimState (ST (PrimState m)))
bidi
    if ReorderingOption
opts ReorderingOption -> ReorderingOption -> ReorderingOption
forall a. Bits a => a -> a -> a
.&. ReorderingOption
OPTION_INSERT_MARKS ReorderingOption -> ReorderingOption -> Bool
forall a. Eq a => a -> a -> Bool
/= ReorderingOption
OPTION_DEFAULT
    then Int32 -> Int32 -> Int32
forall a. Ord a => a -> a -> a
max Int32
processed_len (Int32 -> Int32)
-> ST (PrimState m) Int32 -> ST (PrimState m) Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bidi (PrimState (ST (PrimState m))) -> ST (PrimState m) Int32
forall (m :: * -> *). PrimMonad m => Bidi (PrimState m) -> m Int32
getResultLength Bidi (PrimState m)
Bidi (PrimState (ST (PrimState m)))
bidi
    else Int32 -> ST (PrimState m) Int32
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
processed_len
  IO (PrimArray Int32) -> ST (PrimState m) (PrimArray Int32)
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim do
    Int -> (Ptr Int32 -> IO (PrimArray Int32)) -> IO (PrimArray Int32)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
len \ Ptr Int32
indexMap -> do
      [C.block|UErrorCode {
        UErrorCode error_code = 0;
        ubidi_getLogicalMap($bidi:bidi,$(int32_t * indexMap),&error_code);
        return error_code;
      }|] IO UErrorCode -> (UErrorCode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UErrorCode -> IO ()
ok
      Int -> Ptr Int32 -> IO (PrimArray Int32)
forall a. Prim a => Int -> Ptr a -> IO (PrimArray a)
peekPrimArray Int
len Ptr Int32
indexMap

getVisualMap :: PrimMonad m => Bidi (PrimState m) -> m (PrimArray Int32)
getVisualMap :: forall (m :: * -> *).
PrimMonad m =>
Bidi (PrimState m) -> m (PrimArray Int32)
getVisualMap Bidi (PrimState m)
bidi = ST (PrimState m) (PrimArray Int32) -> m (PrimArray Int32)
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim do
  Int
len <- Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> ST (PrimState m) Int32 -> ST (PrimState m) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    ReorderingOption
opts <- Bidi (PrimState (ST (PrimState m)))
-> ST (PrimState m) ReorderingOption
forall (m :: * -> *).
PrimMonad m =>
Bidi (PrimState m) -> m ReorderingOption
getReorderingOptions Bidi (PrimState m)
Bidi (PrimState (ST (PrimState m)))
bidi
    Int32
result_len <- Bidi (PrimState (ST (PrimState m))) -> ST (PrimState m) Int32
forall (m :: * -> *). PrimMonad m => Bidi (PrimState m) -> m Int32
getResultLength Bidi (PrimState m)
Bidi (PrimState (ST (PrimState m)))
bidi
    if ReorderingOption
opts ReorderingOption -> ReorderingOption -> ReorderingOption
forall a. Bits a => a -> a -> a
.&. ReorderingOption
OPTION_INSERT_MARKS ReorderingOption -> ReorderingOption -> Bool
forall a. Eq a => a -> a -> Bool
/= ReorderingOption
OPTION_DEFAULT
    then Int32 -> Int32 -> Int32
forall a. Ord a => a -> a -> a
max Int32
result_len (Int32 -> Int32)
-> ST (PrimState m) Int32 -> ST (PrimState m) Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bidi (PrimState (ST (PrimState m))) -> ST (PrimState m) Int32
forall (m :: * -> *). PrimMonad m => Bidi (PrimState m) -> m Int32
getProcessedLength Bidi (PrimState m)
Bidi (PrimState (ST (PrimState m)))
bidi
    else Int32 -> ST (PrimState m) Int32
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
result_len
  IO (PrimArray Int32) -> ST (PrimState m) (PrimArray Int32)
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim do
    Int -> (Ptr Int32 -> IO (PrimArray Int32)) -> IO (PrimArray Int32)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
len \Ptr Int32
indexMap -> do
      [C.block|UErrorCode {
        UErrorCode error_code = 0;
        ubidi_getVisualMap($bidi:bidi,$(int32_t * indexMap),&error_code);
        return error_code;
      }|] IO UErrorCode -> (UErrorCode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UErrorCode -> IO ()
ok
      Int -> Ptr Int32 -> IO (PrimArray Int32)
forall a. Prim a => Int -> Ptr a -> IO (PrimArray a)
peekPrimArray Int
len Ptr Int32
indexMap

getResultLength :: PrimMonad m => Bidi (PrimState m) -> m Int32
getResultLength :: forall (m :: * -> *). PrimMonad m => Bidi (PrimState m) -> m Int32
getResultLength Bidi (PrimState m)
bidi = IO Int32 -> m Int32
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim [C.exp|int32_t { ubidi_getProcessedLength($bidi:bidi) }|]

getProcessedLength :: PrimMonad m => Bidi (PrimState m) -> m Int32
getProcessedLength :: forall (m :: * -> *). PrimMonad m => Bidi (PrimState m) -> m Int32
getProcessedLength Bidi (PrimState m)
bidi = IO Int32 -> m Int32
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim [C.exp|int32_t { ubidi_getProcessedLength($bidi:bidi) }|]

getLevels :: PrimMonad m => Bidi (PrimState m) -> m (PrimArray Level)
getLevels :: forall (m :: * -> *).
PrimMonad m =>
Bidi (PrimState m) -> m (PrimArray Level)
getLevels Bidi (PrimState m)
bidi = ST (PrimState m) (PrimArray Level) -> m (PrimArray Level)
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim do
  Int
len <- Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> ST (PrimState m) Int32 -> ST (PrimState m) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bidi (PrimState (ST (PrimState m))) -> ST (PrimState m) Int32
forall (m :: * -> *). PrimMonad m => Bidi (PrimState m) -> m Int32
getProcessedLength Bidi (PrimState m)
Bidi (PrimState (ST (PrimState m)))
bidi
  IO (PrimArray Level) -> ST (PrimState m) (PrimArray Level)
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim (IO (PrimArray Level) -> ST (PrimState m) (PrimArray Level))
-> IO (PrimArray Level) -> ST (PrimState m) (PrimArray Level)
forall a b. (a -> b) -> a -> b
$
    UErrorCode
-> (Ptr UErrorCode -> IO (PrimArray Level)) -> IO (PrimArray Level)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with UErrorCode
forall a. Default a => a
def \Ptr UErrorCode
pErrorCode -> do
       Ptr Level
levels <- [C.exp|const UBiDiLevel * { ubidi_getLevels($bidi:bidi, $(UErrorCode * pErrorCode)) }|]
       Ptr UErrorCode -> IO UErrorCode
forall a. Storable a => Ptr a -> IO a
peek Ptr UErrorCode
pErrorCode IO UErrorCode -> (UErrorCode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UErrorCode -> IO ()
ok
       Int -> Ptr Level -> IO (PrimArray Level)
forall a. Prim a => Int -> Ptr a -> IO (PrimArray a)
peekPrimArray Int
len Ptr Level
levels

reorderLogical :: PrimArray Level -> PrimArray Int32
reorderLogical :: PrimArray Level -> PrimArray Int32
reorderLogical PrimArray Level
pa = IO (PrimArray Int32) -> PrimArray Int32
forall a. IO a -> a
unsafePerformIO do
  PrimArray Level
-> (Int -> Ptr Level -> IO (PrimArray Int32))
-> IO (PrimArray Int32)
forall a r. Prim a => PrimArray a -> (Int -> Ptr a -> IO r) -> IO r
withPrimArrayLen PrimArray Level
pa \n :: Int
n@(Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int32
len) Ptr Level
levels ->
    Int -> (Ptr Int32 -> IO (PrimArray Int32)) -> IO (PrimArray Int32)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
n \Ptr Int32
indexMap ->
      [C.block|void {
        ubidi_reorderLogical($(const UBiDiLevel * levels),$(int32_t len),$(int32_t * indexMap));
      }|] IO () -> IO (PrimArray Int32) -> IO (PrimArray Int32)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Ptr Int32 -> IO (PrimArray Int32)
forall a. Prim a => Int -> Ptr a -> IO (PrimArray a)
peekPrimArray Int
n Ptr Int32
indexMap

reorderVisual :: PrimArray Level -> PrimArray Int32
reorderVisual :: PrimArray Level -> PrimArray Int32
reorderVisual PrimArray Level
pa = IO (PrimArray Int32) -> PrimArray Int32
forall a. IO a -> a
unsafePerformIO do
  PrimArray Level
-> (Int -> Ptr Level -> IO (PrimArray Int32))
-> IO (PrimArray Int32)
forall a r. Prim a => PrimArray a -> (Int -> Ptr a -> IO r) -> IO r
withPrimArrayLen PrimArray Level
pa \n :: Int
n@(Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int32
len) Ptr Level
levels ->
    Int -> (Ptr Int32 -> IO (PrimArray Int32)) -> IO (PrimArray Int32)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
n \Ptr Int32
indexMap ->
      [C.block|void {
        ubidi_reorderVisual($(const UBiDiLevel * levels),$(int32_t len),$(int32_t * indexMap));
      }|] IO () -> IO (PrimArray Int32) -> IO (PrimArray Int32)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Ptr Int32 -> IO (PrimArray Int32)
forall a. Prim a => Int -> Ptr a -> IO (PrimArray a)
peekPrimArray Int
n Ptr Int32
indexMap

getCustomizedClass :: PrimMonad m => Bidi (PrimState m) -> Char -> m CharDirection
getCustomizedClass :: forall (m :: * -> *).
PrimMonad m =>
Bidi (PrimState m) -> Char -> m CharDirection
getCustomizedClass Bidi (PrimState m)
bidi (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> (Char -> Int) -> Char -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum -> Int32
c) = IO CharDirection -> m CharDirection
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim
  [C.exp|UCharDirection { ubidi_getCustomizedClass($bidi:bidi, $(UChar32 c)) }|]

setClassCallback :: PrimMonad m => Bidi (PrimState m) -> FunPtr ClassCallback -> Ptr () -> m (FunPtr ClassCallback, Ptr ())
setClassCallback :: forall (m :: * -> *).
PrimMonad m =>
Bidi (PrimState m)
-> FunPtr ClassCallback
-> Ptr ()
-> m (FunPtr ClassCallback, Ptr ())
setClassCallback Bidi (PrimState m)
bidi FunPtr ClassCallback
newFn Ptr ()
newCtx = IO (FunPtr ClassCallback, Ptr ())
-> m (FunPtr ClassCallback, Ptr ())
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim do
  (Ptr (FunPtr ClassCallback) -> IO (FunPtr ClassCallback, Ptr ()))
-> IO (FunPtr ClassCallback, Ptr ())
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr (FunPtr ClassCallback)
oldFn ->
    (Ptr (Ptr ()) -> IO (FunPtr ClassCallback, Ptr ()))
-> IO (FunPtr ClassCallback, Ptr ())
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr (Ptr ())
oldCtx -> do
      [C.block|UErrorCode {
        UErrorCode error_code = 0;
        ubidi_setClassCallback(
          $bidi:bidi,
          $(UBiDiClassCallbackPtr newFn),
          $(const void * newCtx),
          $(UBiDiClassCallbackPtr * oldFn),
          $(const void ** oldCtx),
          &error_code
        );
        return error_code;
      }|] IO UErrorCode -> (UErrorCode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UErrorCode -> IO ()
ok
      (,) (FunPtr ClassCallback -> Ptr () -> (FunPtr ClassCallback, Ptr ()))
-> IO (FunPtr ClassCallback)
-> IO (Ptr () -> (FunPtr ClassCallback, Ptr ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr (FunPtr ClassCallback) -> IO (FunPtr ClassCallback)
forall a. Storable a => Ptr a -> IO a
peek Ptr (FunPtr ClassCallback)
oldFn IO (Ptr () -> (FunPtr ClassCallback, Ptr ()))
-> IO (Ptr ()) -> IO (FunPtr ClassCallback, Ptr ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr ())
oldCtx

getClassCallback :: PrimMonad m => Bidi (PrimState m) -> m (FunPtr ClassCallback, Ptr ())
getClassCallback :: forall (m :: * -> *).
PrimMonad m =>
Bidi (PrimState m) -> m (FunPtr ClassCallback, Ptr ())
getClassCallback Bidi (PrimState m)
bidi = IO (FunPtr ClassCallback, Ptr ())
-> m (FunPtr ClassCallback, Ptr ())
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim do
  (Ptr (FunPtr ClassCallback) -> IO (FunPtr ClassCallback, Ptr ()))
-> IO (FunPtr ClassCallback, Ptr ())
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr (FunPtr ClassCallback)
fn ->
    (Ptr (Ptr ()) -> IO (FunPtr ClassCallback, Ptr ()))
-> IO (FunPtr ClassCallback, Ptr ())
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr (Ptr ())
ctx ->
      (,) (FunPtr ClassCallback -> Ptr () -> (FunPtr ClassCallback, Ptr ()))
-> IO ()
-> IO
     (FunPtr ClassCallback -> Ptr () -> (FunPtr ClassCallback, Ptr ()))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  [C.block|void { ubidi_getClassCallback($bidi:bidi,$(UBiDiClassCallbackPtr * fn),$(const void ** ctx)); }|]
          IO
  (FunPtr ClassCallback -> Ptr () -> (FunPtr ClassCallback, Ptr ()))
-> IO (FunPtr ClassCallback)
-> IO (Ptr () -> (FunPtr ClassCallback, Ptr ()))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr (FunPtr ClassCallback) -> IO (FunPtr ClassCallback)
forall a. Storable a => Ptr a -> IO a
peek Ptr (FunPtr ClassCallback)
fn
          IO (Ptr () -> (FunPtr ClassCallback, Ptr ()))
-> IO (Ptr ()) -> IO (FunPtr ClassCallback, Ptr ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr ())
ctx

writeReordered :: PrimMonad m => Bidi (PrimState m) -> WriteOptions -> m Text
writeReordered :: forall (m :: * -> *).
PrimMonad m =>
Bidi (PrimState m) -> WriteOptions -> m Text
writeReordered Bidi (PrimState m)
bidi WriteOptions
options = ST (PrimState m) Text -> m Text
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim do
  destSize :: Int32
destSize@(Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
len) <- if WriteOptions
options WriteOptions -> WriteOptions -> WriteOptions
forall a. Bits a => a -> a -> a
.&. WriteOptions
INSERT_LRM_FOR_NUMERIC WriteOptions -> WriteOptions -> Bool
forall a. Eq a => a -> a -> Bool
/= WriteOptions
forall a. Default a => a
def
    then do
      Int32
len <- Bidi (PrimState (ST (PrimState m))) -> ST (PrimState m) Int32
forall (m :: * -> *). PrimMonad m => Bidi (PrimState m) -> m Int32
getLength Bidi (PrimState m)
Bidi (PrimState (ST (PrimState m)))
bidi
      Int32
runs <- Bidi (PrimState (ST (PrimState m))) -> ST (PrimState m) Int32
forall (m :: * -> *). PrimMonad m => Bidi (PrimState m) -> m Int32
countRuns Bidi (PrimState m)
Bidi (PrimState (ST (PrimState m)))
bidi
      Int32 -> ST (PrimState m) Int32
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int32 -> ST (PrimState m) Int32)
-> Int32 -> ST (PrimState m) Int32
forall a b. (a -> b) -> a -> b
$ Int32
len Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
2 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
runs
    else Bidi (PrimState (ST (PrimState m))) -> ST (PrimState m) Int32
forall (m :: * -> *). PrimMonad m => Bidi (PrimState m) -> m Int32
getProcessedLength Bidi (PrimState m)
Bidi (PrimState (ST (PrimState m)))
bidi
  IO Text -> ST (PrimState m) Text
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim do
    Int -> (Ptr Word16 -> IO Text) -> IO Text
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
len \Ptr Word16
dest ->
      UErrorCode -> (Ptr UErrorCode -> IO Text) -> IO Text
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with UErrorCode
forall a. Default a => a
def \Ptr UErrorCode
pErrorCode -> do
        Int32
actual_len <- [C.exp|int32_t {
          ubidi_writeReordered($bidi:bidi,$(UChar * dest),$(int32_t destSize),$(WriteOptions options),$(UErrorCode * pErrorCode))
        }|]
        Ptr UErrorCode -> IO UErrorCode
forall a. Storable a => Ptr a -> IO a
peek Ptr UErrorCode
pErrorCode IO UErrorCode -> (UErrorCode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UErrorCode -> IO ()
ok
        Ptr Word16 -> I16 -> IO Text
fromPtr Ptr Word16
dest (I16 -> IO Text) -> I16 -> IO Text
forall a b. (a -> b) -> a -> b
$ Int32 -> I16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
actual_len

writeReverse :: Text -> WriteOptions -> Text
writeReverse :: Text -> WriteOptions -> Text
writeReverse Text
t WriteOptions
options = IO Text -> Text
forall a. IO a -> a
unsafePerformIO do
  Text -> (Ptr Word16 -> I16 -> IO Text) -> IO Text
forall a. Text -> (Ptr Word16 -> I16 -> IO a) -> IO a
useAsPtr Text
t \Ptr Word16
src i16 :: I16
i16@(I16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int32
n) ->
    Int -> (Ptr Word16 -> IO Text) -> IO Text
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (I16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral I16
i16) \ Ptr Word16
dest ->
      UErrorCode -> (Ptr UErrorCode -> IO Text) -> IO Text
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with UErrorCode
forall a. Default a => a
def \Ptr UErrorCode
pErrorCode -> do
        Int32
actual_len <- [C.block|int32_t {
          int32_t len = $(int32_t n);
          return ubidi_writeReverse($(const UChar * src),len,$(UChar * dest),len,$(WriteOptions options),$(UErrorCode * pErrorCode));
        }|]
        Ptr UErrorCode -> IO UErrorCode
forall a. Storable a => Ptr a -> IO a
peek Ptr UErrorCode
pErrorCode IO UErrorCode -> (UErrorCode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UErrorCode -> IO ()
ok
        Ptr Word16 -> I16 -> IO Text
fromPtr Ptr Word16
dest (I16 -> IO Text) -> I16 -> IO Text
forall a b. (a -> b) -> a -> b
$ Int32 -> I16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
actual_len