{-# LINE 1 "Data/Text/ICU/Shape.hsc" #-}
{-# LANGUAGE CPP, ForeignFunctionInterface #-}
module Data.Text.ICU.Shape
(
shapeArabic
, ShapeOption(..)
) where
import Data.List (foldl')
import Data.Text.ICU.Error.Internal (UErrorCode, handleOverflowError)
import Data.Bits ((.|.))
import Data.Int (Int32)
import Foreign.Ptr (Ptr)
import Data.Text.ICU.Internal (UChar, useAsUCharPtr, fromUCharPtr)
import Data.Text (Text)
import System.IO.Unsafe (unsafePerformIO)
data ShapeOption =
AggregateTaskheel
| DigitTypeAnExtended
| DigitsAlen2AnInitAl
| DigitsAlen2AnInitLr
| DigitsAn2En
| DigitsEn2An
| LengthFixedSpacesAtBeginning
| LengthFixedSpacesAtEnd
| LengthFixedSpacesNear
|
| LettersUnshape
|
| PreservePresentation
| TextDirectionVisualLTR
deriving (Int -> ShapeOption -> ShowS
[ShapeOption] -> ShowS
ShapeOption -> String
(Int -> ShapeOption -> ShowS)
-> (ShapeOption -> String)
-> ([ShapeOption] -> ShowS)
-> Show ShapeOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShapeOption] -> ShowS
$cshowList :: [ShapeOption] -> ShowS
show :: ShapeOption -> String
$cshow :: ShapeOption -> String
showsPrec :: Int -> ShapeOption -> ShowS
$cshowsPrec :: Int -> ShapeOption -> ShowS
Show)
reduceShapeOpts :: [ShapeOption] -> Int32
reduceShapeOpts :: [ShapeOption] -> Int32
reduceShapeOpts = (Int32 -> ShapeOption -> Int32) -> Int32 -> [ShapeOption] -> Int32
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int32 -> ShapeOption -> Int32
orO Int32
0
where Int32
a orO :: Int32 -> ShapeOption -> Int32
`orO` ShapeOption
b = Int32
a Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
.|. ShapeOption -> Int32
fromShapeOption ShapeOption
b
fromShapeOption :: ShapeOption -> Int32
fromShapeOption :: ShapeOption -> Int32
fromShapeOption ShapeOption
AggregateTaskheel = Int32
16384
{-# LINE 72 "Data/Text/ICU/Shape.hsc" #-}
fromShapeOption DigitTypeAnExtended = 256
{-# LINE 73 "Data/Text/ICU/Shape.hsc" #-}
fromShapeOption DigitsAlen2AnInitAl = 128
{-# LINE 74 "Data/Text/ICU/Shape.hsc" #-}
fromShapeOption DigitsAlen2AnInitLr = 96
{-# LINE 75 "Data/Text/ICU/Shape.hsc" #-}
fromShapeOption DigitsAn2En = 64
{-# LINE 76 "Data/Text/ICU/Shape.hsc" #-}
fromShapeOption DigitsEn2An = 32
{-# LINE 77 "Data/Text/ICU/Shape.hsc" #-}
fromShapeOption LengthFixedSpacesAtBeginning = 3
{-# LINE 78 "Data/Text/ICU/Shape.hsc" #-}
fromShapeOption LengthFixedSpacesAtEnd = 2
{-# LINE 79 "Data/Text/ICU/Shape.hsc" #-}
fromShapeOption LengthFixedSpacesNear = 1
{-# LINE 80 "Data/Text/ICU/Shape.hsc" #-}
fromShapeOption LettersShape = 8
{-# LINE 81 "Data/Text/ICU/Shape.hsc" #-}
fromShapeOption LettersUnshape = 16
{-# LINE 82 "Data/Text/ICU/Shape.hsc" #-}
fromShapeOption LettersShapeTashkeelIsolated = 24
{-# LINE 83 "Data/Text/ICU/Shape.hsc" #-}
fromShapeOption PreservePresentation = 32768
{-# LINE 84 "Data/Text/ICU/Shape.hsc" #-}
fromShapeOption TextDirectionVisualLTR = 4
{-# LINE 85 "Data/Text/ICU/Shape.hsc" #-}
shapeArabic :: [ShapeOption] -> Text -> Text
shapeArabic :: [ShapeOption] -> Text -> Text
shapeArabic [ShapeOption]
options Text
t = IO Text -> Text
forall a. IO a -> a
unsafePerformIO (IO Text -> Text)
-> ((Ptr UChar -> I16 -> IO Text) -> IO Text)
-> (Ptr UChar -> I16 -> IO Text)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Ptr UChar -> I16 -> IO Text) -> IO Text
forall a. Text -> (Ptr UChar -> I16 -> IO a) -> IO a
useAsUCharPtr Text
t ((Ptr UChar -> I16 -> IO Text) -> Text)
-> (Ptr UChar -> I16 -> IO Text) -> Text
forall a b. (a -> b) -> a -> b
$ \Ptr UChar
sptr I16
slen ->
let slen' :: Int32
slen' = I16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral I16
slen
options' :: Int32
options' = [ShapeOption] -> Int32
reduceShapeOpts [ShapeOption]
options
in Int
-> (Ptr UChar -> Int32 -> Ptr UErrorCode -> IO Int32)
-> (Ptr UChar -> Int -> IO Text)
-> IO Text
forall a b.
Storable a =>
Int
-> (Ptr a -> Int32 -> Ptr UErrorCode -> IO Int32)
-> (Ptr a -> Int -> IO b)
-> IO b
handleOverflowError (I16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral I16
slen)
(\Ptr UChar
dptr Int32
dlen -> Ptr UChar
-> Int32
-> Ptr UChar
-> Int32
-> Int32
-> Ptr UErrorCode
-> IO Int32
u_shapeArabic Ptr UChar
sptr Int32
slen' Ptr UChar
dptr (Int32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
dlen) Int32
options')
(\Ptr UChar
dptr Int
dlen -> Ptr UChar -> I16 -> IO Text
fromUCharPtr Ptr UChar
dptr (Int -> I16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dlen))
foreign import ccall unsafe "hs_text_icu.h __hs_u_shapeArabic" u_shapeArabic
:: Ptr UChar -> Int32
-> Ptr UChar -> Int32
-> Int32 -> Ptr UErrorCode -> IO Int32