{-# LINE 1 "Data/Text/ICU/BiDi.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
-- |
-- Module      : Data.Text.ICU.BiDi
-- Copyright   : (c) 2018 Ondrej Palkovsky
--
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- Implementation of the Unicode Bidirectional Algorithm. See the documentation
-- of the libicu library for additional details.
--
-- -- /Note/: this module is not thread safe. /Do not/ call the
-- functions on one BiDi object from more than one thread!

module Data.Text.ICU.BiDi
  (
    BiDi
  -- ** Basic functions
  , open
  , openSized
  -- ** Set data
  , setPara
  , setLine
  -- ** Access the BiDi object
  , countParagraphs
  , getParagraphByIndex
  , getProcessedLength
  -- ** Output text
  , writeReordered
  , WriteOption(..)
  -- ** High-level functions
  , reorderParagraphs
  ) where



import Data.Text.ICU.BiDi.Internal
import Foreign.Marshal.Utils (with)
import Foreign.Storable (peek)
import Foreign.Ptr (FunPtr, Ptr)
import Data.Int (Int32, Int16)
import Data.Text.ICU.Error.Internal (UErrorCode, handleError, handleOverflowError)
import Data.Text (Text)
import Data.Text.ICU.Internal (UChar, useAsUCharPtr, fromUCharPtr, newICUPtr)
import Foreign.C.Types (CInt(..))
import Data.List (foldl')
import Data.Bits ((.|.))
import System.IO.Unsafe (unsafePerformIO)
import Data.Traversable (for)

-- | Allocate a BiDi structure.
open :: IO BiDi
open :: IO BiDi
open = (ForeignPtr UBiDi -> BiDi)
-> FinalizerPtr UBiDi -> IO (Ptr UBiDi) -> IO BiDi
forall a i.
(ForeignPtr a -> i) -> FinalizerPtr a -> IO (Ptr a) -> IO i
newICUPtr ForeignPtr UBiDi -> BiDi
BiDi FinalizerPtr UBiDi
ubidi_close IO (Ptr UBiDi)
ubidi_open

-- | Allocate a BiDi structure with preallocated memory for internal structures.
openSized ::
     Int32 -- ^ is the maximum text or line length that internal memory will be preallocated for.
           -- An attempt to associate this object with a longer text will fail, unless this value is 0.
  -> Int32 -- ^ is the maximum anticipated number of same-level runs that internal memory will be preallocated for.
           -- An attempt to access visual runs on an object that was not preallocated for as many runs as the text was actually resolved to will fail, unless this value is 0.
  -> IO BiDi
openSized :: Int32 -> Int32 -> IO BiDi
openSized Int32
maxlen Int32
maxruncount =
  (ForeignPtr UBiDi -> BiDi)
-> FinalizerPtr UBiDi -> IO (Ptr UBiDi) -> IO BiDi
forall a i.
(ForeignPtr a -> i) -> FinalizerPtr a -> IO (Ptr a) -> IO i
newICUPtr ForeignPtr UBiDi -> BiDi
BiDi FinalizerPtr UBiDi
ubidi_close (IO (Ptr UBiDi) -> IO BiDi) -> IO (Ptr UBiDi) -> IO BiDi
forall a b. (a -> b) -> a -> b
$ (Ptr CInt -> IO (Ptr UBiDi)) -> IO (Ptr UBiDi)
forall a. (Ptr CInt -> IO a) -> IO a
handleError (Int32 -> Int32 -> Ptr CInt -> IO (Ptr UBiDi)
ubidi_openSized Int32
maxlen Int32
maxruncount)

-- | Perform the Unicode Bidi algorithm. It is defined in the Unicode Standard Annex #9, version 13,
-- also described in The Unicode Standard, Version 4.0.
-- This function takes a piece of plain text containing one or more paragraphs,
-- with or without externally specified embedding levels from styled text and
-- computes the left-right-directionality of each character.
setPara ::
     BiDi
  -> Text
  -> Int32 -- ^ specifies the default level for the text; it is typically 0 (LTR) or 1 (RTL)
  -> IO ()
setPara :: BiDi -> Text -> Int32 -> IO ()
setPara BiDi
bidi Text
t Int32
paraLevel =
  BiDi -> (Ptr UBiDi -> IO ()) -> IO ()
forall a. BiDi -> (Ptr UBiDi -> IO a) -> IO a
withBiDi BiDi
bidi ((Ptr UBiDi -> IO ()) -> IO ()) -> (Ptr UBiDi -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr UBiDi
bptr ->
    Text -> (Ptr UChar -> I16 -> IO ()) -> IO ()
forall a. Text -> (Ptr UChar -> I16 -> IO a) -> IO a
useAsUCharPtr Text
t ((Ptr UChar -> I16 -> IO ()) -> IO ())
-> (Ptr UChar -> I16 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr UChar
sptr I16
slen -> (Ptr CInt -> IO ()) -> IO ()
forall a. (Ptr CInt -> IO a) -> IO a
handleError (Ptr UBiDi -> Ptr UChar -> Int32 -> Int32 -> Ptr CInt -> IO ()
ubidi_setPara Ptr UBiDi
bptr Ptr UChar
sptr (I16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral I16
slen) Int32
paraLevel)

-- | Sets a BiDi to contain the reordering information, especially the resolved levels,
-- for all the characters in a line of text
setLine ::
     BiDi -- ^  the parent paragraph object. It must have been set by a successful call to 'setPara'.
  -> Int32 -- ^ is the line's first index into the text
  -> Int32 -- ^ is just behind the line's last index into the text (its last index +1).
  -> BiDi -- ^ is the object that will now represent a line of the text
  -> IO ()
setLine :: BiDi -> Int32 -> Int32 -> BiDi -> IO ()
setLine BiDi
paraBidi Int32
start Int32
limit BiDi
lineBidi =
  BiDi -> (Ptr UBiDi -> IO ()) -> IO ()
forall a. BiDi -> (Ptr UBiDi -> IO a) -> IO a
withBiDi BiDi
paraBidi ((Ptr UBiDi -> IO ()) -> IO ()) -> (Ptr UBiDi -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr UBiDi
paraptr ->
    BiDi -> (Ptr UBiDi -> IO ()) -> IO ()
forall a. BiDi -> (Ptr UBiDi -> IO a) -> IO a
withBiDi BiDi
lineBidi ((Ptr UBiDi -> IO ()) -> IO ()) -> (Ptr UBiDi -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr UBiDi
lineptr ->
      (Ptr CInt -> IO ()) -> IO ()
forall a. (Ptr CInt -> IO a) -> IO a
handleError (Ptr UBiDi -> Int32 -> Int32 -> Ptr UBiDi -> Ptr CInt -> IO ()
ubidi_setLine Ptr UBiDi
paraptr Int32
start Int32
limit Ptr UBiDi
lineptr)

-- | Get the number of paragraphs.
countParagraphs :: BiDi -> IO Int32
countParagraphs :: BiDi -> IO Int32
countParagraphs BiDi
bidi = BiDi -> (Ptr UBiDi -> IO Int32) -> IO Int32
forall a. BiDi -> (Ptr UBiDi -> IO a) -> IO a
withBiDi BiDi
bidi Ptr UBiDi -> IO Int32
ubidi_countParagraphs

-- | Get a paragraph, given the index of this paragraph.
getParagraphByIndex ::
     BiDi
  -> Int32 -- ^ is the number of the paragraph, in the range [0..ubidi_countParagraphs(pBiDi)-1].
  -> IO (Int32, Int32) -- ^ index of the first character of the paragraph in the text and limit of the paragraph
getParagraphByIndex :: BiDi -> Int32 -> IO (Int32, Int32)
getParagraphByIndex BiDi
bidi Int32
paraIndex =
  BiDi -> (Ptr UBiDi -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a. BiDi -> (Ptr UBiDi -> IO a) -> IO a
withBiDi BiDi
bidi ((Ptr UBiDi -> IO (Int32, Int32)) -> IO (Int32, Int32))
-> (Ptr UBiDi -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ \Ptr UBiDi
bptr ->
    CInt -> (Ptr CInt -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with CInt
0 ((Ptr CInt -> IO (Int32, Int32)) -> IO (Int32, Int32))
-> (Ptr CInt -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
pstart ->
      CInt -> (Ptr CInt -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with CInt
0 ((Ptr CInt -> IO (Int32, Int32)) -> IO (Int32, Int32))
-> (Ptr CInt -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
pend -> do
        (Ptr CInt -> IO ()) -> IO ()
forall a. (Ptr CInt -> IO a) -> IO a
handleError (Ptr UBiDi -> Int32 -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()
ubidi_getParagraphByIndex Ptr UBiDi
bptr Int32
paraIndex Ptr CInt
pstart Ptr CInt
pend)
        (,) (Int32 -> Int32 -> (Int32, Int32))
-> IO Int32 -> IO (Int32 -> (Int32, Int32))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CInt -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int32) -> IO CInt -> IO Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
pstart)
            IO (Int32 -> (Int32, Int32)) -> IO Int32 -> IO (Int32, Int32)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (CInt -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int32) -> IO CInt -> IO Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
pend)

-- | Get the length of the source text processed by the last call to 'setPara'.
getProcessedLength :: BiDi -> IO Int32
getProcessedLength :: BiDi -> IO Int32
getProcessedLength BiDi
bidi = BiDi -> (Ptr UBiDi -> IO Int32) -> IO Int32
forall a. BiDi -> (Ptr UBiDi -> IO a) -> IO a
withBiDi BiDi
bidi Ptr UBiDi -> IO Int32
ubidi_getProcessedLength

data WriteOption =
  DoMirroring
  -- ^ replace characters with the "mirrored" property in RTL runs by their mirror-image mappings
  | InsertLrmForNumeric
  -- ^ surround the run with LRMs if necessary; this is part of the approximate "inverse Bidi" algorithm
  | KeepBaseCombining
  -- ^ keep combining characters after their base characters in RTL runs
  | OutputReverse
  -- ^ write the output in reverse order
  | RemoveBidiControls
  -- ^ remove Bidi control characters (this does not affect InsertLrmForNumeric)
  deriving (Int -> WriteOption -> ShowS
[WriteOption] -> ShowS
WriteOption -> String
(Int -> WriteOption -> ShowS)
-> (WriteOption -> String)
-> ([WriteOption] -> ShowS)
-> Show WriteOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WriteOption] -> ShowS
$cshowList :: [WriteOption] -> ShowS
show :: WriteOption -> String
$cshow :: WriteOption -> String
showsPrec :: Int -> WriteOption -> ShowS
$cshowsPrec :: Int -> WriteOption -> ShowS
Show)

reduceWriteOpts :: [WriteOption] -> Int16
reduceWriteOpts :: [WriteOption] -> Int16
reduceWriteOpts = (Int16 -> WriteOption -> Int16) -> Int16 -> [WriteOption] -> Int16
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int16 -> WriteOption -> Int16
orO Int16
0
    where Int16
a orO :: Int16 -> WriteOption -> Int16
`orO` WriteOption
b = Int16
a Int16 -> Int16 -> Int16
forall a. Bits a => a -> a -> a
.|. WriteOption -> Int16
fromWriteOption WriteOption
b

fromWriteOption :: WriteOption -> Int16
fromWriteOption :: WriteOption -> Int16
fromWriteOption WriteOption
DoMirroring   = Int16
2
{-# LINE 134 "Data/Text/ICU/BiDi.hsc" #-}
fromWriteOption InsertLrmForNumeric   = 4
{-# LINE 135 "Data/Text/ICU/BiDi.hsc" #-}
fromWriteOption KeepBaseCombining   = 1
{-# LINE 136 "Data/Text/ICU/BiDi.hsc" #-}
fromWriteOption OutputReverse   = 16
{-# LINE 137 "Data/Text/ICU/BiDi.hsc" #-}
fromWriteOption RemoveBidiControls   = 8
{-# LINE 138 "Data/Text/ICU/BiDi.hsc" #-}

-- | Take a BiDi object containing the reordering information for a piece of text
-- (one or more paragraphs) set by 'setPara' or for a line of text set by 'setLine'
-- and write a reordered string to the destination buffer.
writeReordered :: BiDi -> [WriteOption] -> IO Text
writeReordered :: BiDi -> [WriteOption] -> IO Text
writeReordered BiDi
bidi [WriteOption]
opts = do
  Int32
destLen <- BiDi -> IO Int32
getProcessedLength BiDi
bidi
  let options' :: Int16
options' = [WriteOption] -> Int16
reduceWriteOpts [WriteOption]
opts
  BiDi -> (Ptr UBiDi -> IO Text) -> IO Text
forall a. BiDi -> (Ptr UBiDi -> IO a) -> IO a
withBiDi BiDi
bidi ((Ptr UBiDi -> IO Text) -> IO Text)
-> (Ptr UBiDi -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \Ptr UBiDi
bptr ->
    Int
-> (Ptr UChar -> Int32 -> Ptr CInt -> IO Int32)
-> (Ptr UChar -> Int -> IO Text)
-> IO Text
forall a b.
Storable a =>
Int
-> (Ptr a -> Int32 -> Ptr CInt -> IO Int32)
-> (Ptr a -> Int -> IO b)
-> IO b
handleOverflowError (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
destLen)
      (\Ptr UChar
dptr Int32
dlen -> Ptr UBiDi -> Ptr UChar -> Int32 -> Int16 -> Ptr CInt -> IO Int32
ubidi_writeReordered Ptr UBiDi
bptr Ptr UChar
dptr (Int32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
dlen) Int16
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_ubidi_open" ubidi_open
  :: IO (Ptr UBiDi)

foreign import ccall unsafe "hs_text_icu.h __hs_ubidi_openSized" ubidi_openSized
  :: Int32 -> Int32 -> Ptr UErrorCode -> IO (Ptr UBiDi)

foreign import ccall unsafe "hs_text_icu.h &__hs_ubidi_close" ubidi_close
  :: FunPtr (Ptr UBiDi -> IO ())

foreign import ccall unsafe "hs_text_icu.h __hs_ubidi_setPara" ubidi_setPara
  :: Ptr UBiDi -> Ptr UChar -> Int32 -> Int32 -> Ptr UErrorCode -> IO ()

foreign import ccall unsafe "hs_text_icu.h __hs_ubidi_countParagraphs" ubidi_countParagraphs
  :: Ptr UBiDi -> IO Int32

foreign import ccall unsafe "hs_text_icu.h __hs_ubidi_getParagraphByIndex" ubidi_getParagraphByIndex
  :: Ptr UBiDi -> Int32 -> Ptr CInt -> Ptr CInt -> Ptr UErrorCode -> IO ()

foreign import ccall unsafe "hs_text_icu.h __hs_ubidi_getProcessedLength" ubidi_getProcessedLength
  :: Ptr UBiDi -> IO Int32

foreign import ccall unsafe "hs_text_icu.h __hs_ubidi_writeReordered" ubidi_writeReordered
  :: Ptr UBiDi -> Ptr UChar -> Int32 -> Int16 -> Ptr UErrorCode -> IO Int32

foreign import ccall unsafe "hs_text_icu.h __hs_ubidi_setLine" ubidi_setLine
  :: Ptr UBiDi -> Int32 -> Int32 -> Ptr UBiDi -> Ptr UErrorCode -> IO ()

-- | Helper function to reorder a text to a series of paragraphs.
reorderParagraphs :: [WriteOption] -> Text -> [Text]
reorderParagraphs :: [WriteOption] -> Text -> [Text]
reorderParagraphs [WriteOption]
options Text
input =
  IO [Text] -> [Text]
forall a. IO a -> a
unsafePerformIO (IO [Text] -> [Text]) -> IO [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ do
    BiDi
bidi <- IO BiDi
open
    BiDi -> Text -> Int32 -> IO ()
setPara BiDi
bidi Text
input Int32
0
    Int32
pcount <- BiDi -> IO Int32
countParagraphs BiDi
bidi
    BiDi
lineBidi <- IO BiDi
open
    [Int32] -> (Int32 -> IO Text) -> IO [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Int32
0..Int32
pcountInt32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
-Int32
1] ((Int32 -> IO Text) -> IO [Text])
-> (Int32 -> IO Text) -> IO [Text]
forall a b. (a -> b) -> a -> b
$ \Int32
pidx -> do
        (Int32
start,Int32
limit) <- BiDi -> Int32 -> IO (Int32, Int32)
getParagraphByIndex BiDi
bidi Int32
pidx
        BiDi -> Int32 -> Int32 -> BiDi -> IO ()
setLine BiDi
bidi Int32
start Int32
limit BiDi
lineBidi
        BiDi -> [WriteOption] -> IO Text
writeReordered BiDi
lineBidi [WriteOption]
options