diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,2 @@
+# 0
+* Library created
diff --git a/LICENSE.md b/LICENSE.md
new file mode 100644
--- /dev/null
+++ b/LICENSE.md
@@ -0,0 +1,230 @@
+# License
+
+Licensed under either of
+ * Apache License, Version 2.0 (http://www.apache.org/licenses/LICENSE-2.0)
+ * BSD 2-Clause license (https://opensource.org/licenses/BSD-2-Clause)
+at your option.
+
+## BSD 2-Clause License
+
+- Copyright 2019-2021 Edward Kmett
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+## Apache License
+
+_Version 2.0, January 2004_
+_<>_
+
+### Terms and Conditions for use, reproduction, and distribution
+
+#### 1. Definitions
+
+“License” shall mean the terms and conditions for use, reproduction, and
+distribution as defined by Sections 1 through 9 of this document.
+
+“Licensor” shall mean the copyright owner or entity authorized by the copyright
+owner that is granting the License.
+
+“Legal Entity” shall mean the union of the acting entity and all other entities
+that control, are controlled by, or are under common control with that entity.
+For the purposes of this definition, “control” means **(i)** the power, direct or
+indirect, to cause the direction or management of such entity, whether by
+contract or otherwise, or **(ii)** ownership of fifty percent (50%) or more of the
+outstanding shares, or **(iii)** beneficial ownership of such entity.
+
+“You” (or “Your”) shall mean an individual or Legal Entity exercising
+permissions granted by this License.
+
+“Source” form shall mean the preferred form for making modifications, including
+but not limited to software source code, documentation source, and configuration
+files.
+
+“Object” form shall mean any form resulting from mechanical transformation or
+translation of a Source form, including but not limited to compiled object code,
+generated documentation, and conversions to other media types.
+
+“Work” shall mean the work of authorship, whether in Source or Object form, made
+available under the License, as indicated by a copyright notice that is included
+in or attached to the work (an example is provided in the Appendix below).
+
+“Derivative Works” shall mean any work, whether in Source or Object form, that
+is based on (or derived from) the Work and for which the editorial revisions,
+annotations, elaborations, or other modifications represent, as a whole, an
+original work of authorship. For the purposes of this License, Derivative Works
+shall not include works that remain separable from, or merely link (or bind by
+name) to the interfaces of, the Work and Derivative Works thereof.
+
+“Contribution” shall mean any work of authorship, including the original version
+of the Work and any modifications or additions to that Work or Derivative Works
+thereof, that is intentionally submitted to Licensor for inclusion in the Work
+by the copyright owner or by an individual or Legal Entity authorized to submit
+on behalf of the copyright owner. For the purposes of this definition,
+“submitted” means any form of electronic, verbal, or written communication sent
+to the Licensor or its representatives, including but not limited to
+communication on electronic mailing lists, source code control systems, and
+issue tracking systems that are managed by, or on behalf of, the Licensor for
+the purpose of discussing and improving the Work, but excluding communication
+that is conspicuously marked or otherwise designated in writing by the copyright
+owner as “Not a Contribution.”
+
+“Contributor” shall mean Licensor and any individual or Legal Entity on behalf
+of whom a Contribution has been received by Licensor and subsequently
+incorporated within the Work.
+
+#### 2. Grant of Copyright License
+
+Subject to the terms and conditions of this License, each Contributor hereby
+grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free,
+irrevocable copyright license to reproduce, prepare Derivative Works of,
+publicly display, publicly perform, sublicense, and distribute the Work and such
+Derivative Works in Source or Object form.
+
+#### 3. Grant of Patent License
+
+Subject to the terms and conditions of this License, each Contributor hereby
+grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free,
+irrevocable (except as stated in this section) patent license to make, have
+made, use, offer to sell, sell, import, and otherwise transfer the Work, where
+such license applies only to those patent claims licensable by such Contributor
+that are necessarily infringed by their Contribution(s) alone or by combination
+of their Contribution(s) with the Work to which such Contribution(s) was
+submitted. If You institute patent litigation against any entity (including a
+cross-claim or counterclaim in a lawsuit) alleging that the Work or a
+Contribution incorporated within the Work constitutes direct or contributory
+patent infringement, then any patent licenses granted to You under this License
+for that Work shall terminate as of the date such litigation is filed.
+
+#### 4. Redistribution
+
+You may reproduce and distribute copies of the Work or Derivative Works thereof
+in any medium, with or without modifications, and in Source or Object form,
+provided that You meet the following conditions:
+
+* **(a)** You must give any other recipients of the Work or Derivative Works a copy of
+this License; and
+* **(b)** You must cause any modified files to carry prominent notices stating that You
+changed the files; and
+* **(c)** You must retain, in the Source form of any Derivative Works that You distribute,
+all copyright, patent, trademark, and attribution notices from the Source form
+of the Work, excluding those notices that do not pertain to any part of the
+Derivative Works; and
+* **(d)** If the Work includes a “NOTICE” text file as part of its distribution, then any
+Derivative Works that You distribute must include a readable copy of the
+attribution notices contained within such NOTICE file, excluding those notices
+that do not pertain to any part of the Derivative Works, in at least one of the
+following places: within a NOTICE text file distributed as part of the
+Derivative Works; within the Source form or documentation, if provided along
+with the Derivative Works; or, within a display generated by the Derivative
+Works, if and wherever such third-party notices normally appear. The contents of
+the NOTICE file are for informational purposes only and do not modify the
+License. You may add Your own attribution notices within Derivative Works that
+You distribute, alongside or as an addendum to the NOTICE text from the Work,
+provided that such additional attribution notices cannot be construed as
+modifying the License.
+
+You may add Your own copyright statement to Your modifications and may provide
+additional or different license terms and conditions for use, reproduction, or
+distribution of Your modifications, or for any such Derivative Works as a whole,
+provided Your use, reproduction, and distribution of the Work otherwise complies
+with the conditions stated in this License.
+
+#### 5. Submission of Contributions
+
+Unless You explicitly state otherwise, any Contribution intentionally submitted
+for inclusion in the Work by You to the Licensor shall be under the terms and
+conditions of this License, without any additional terms or conditions.
+Notwithstanding the above, nothing herein shall supersede or modify the terms of
+any separate license agreement you may have executed with Licensor regarding
+such Contributions.
+
+#### 6. Trademarks
+
+This License does not grant permission to use the trade names, trademarks,
+service marks, or product names of the Licensor, except as required for
+reasonable and customary use in describing the origin of the Work and
+reproducing the content of the NOTICE file.
+
+#### 7. Disclaimer of Warranty
+
+Unless required by applicable law or agreed to in writing, Licensor provides the
+Work (and each Contributor provides its Contributions) on an “AS IS” BASIS,
+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied,
+including, without limitation, any warranties or conditions of TITLE,
+NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are
+solely responsible for determining the appropriateness of using or
+redistributing the Work and assume any risks associated with Your exercise of
+permissions under this License.
+
+#### 8. Limitation of Liability
+
+In no event and under no legal theory, whether in tort (including negligence),
+contract, or otherwise, unless required by applicable law (such as deliberate
+and grossly negligent acts) or agreed to in writing, shall any Contributor be
+liable to You for damages, including any direct, indirect, special, incidental,
+or consequential damages of any character arising as a result of this License or
+out of the use or inability to use the Work (including but not limited to
+damages for loss of goodwill, work stoppage, computer failure or malfunction, or
+any and all other commercial damages or losses), even if such Contributor has
+been advised of the possibility of such damages.
+
+#### 9. Accepting Warranty or Additional Liability
+
+While redistributing the Work or Derivative Works thereof, You may choose to
+offer, and charge a fee for, acceptance of support, warranty, indemnity, or
+other liability obligations and/or rights consistent with this License. However,
+in accepting such obligations, You may act only on Your own behalf and on Your
+sole responsibility, not on behalf of any other Contributor, and only if You
+agree to indemnify, defend, and hold each Contributor harmless for any liability
+incurred by, or claims asserted against, such Contributor by reason of your
+accepting any such warranty or additional liability.
+
+_END OF TERMS AND CONDITIONS_
+
+### APPENDIX: How to apply the Apache License to your work
+
+To apply the Apache License to your work, attach the following boilerplate
+notice, with the fields enclosed by brackets `[]` replaced with your own
+identifying information. (Don't include the brackets!) The text should be
+enclosed in the appropriate comment syntax for the file format. We also
+recommend that a file or class name and description of purpose be included on
+the same “printed page” as the copyright notice for easier identification within
+third-party archives.
+
+ Copyright [yyyy] [name of copyright owner]
+
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,16 @@
+bidi-icu
+=============
+
+[](https://hackage.haskell.org/package/bidi-icu)
+
+This package provides an implementation of the Unicode bidirectional algorithm by leaning on the ICU library.
+
+Contact Information
+-------------------
+
+Contributions and bug reports are welcome!
+
+Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net.
+
+-Edward Kmett
+
diff --git a/bidi-icu.cabal b/bidi-icu.cabal
new file mode 100644
--- /dev/null
+++ b/bidi-icu.cabal
@@ -0,0 +1,51 @@
+cabal-version: 2.2
+name: bidi-icu
+version: 0
+synopsis: The unicode bidirectional algorithm via ICU
+description: The unicode bidirectional algorithm via ICU.
+homepage: https://github.com/ekmett/codex/tree/master/bidi-icu#readme
+license: BSD-2-Clause OR Apache-2.0
+license-file: LICENSE.md
+author: Edward Kmett
+maintainer: Edward Kmett
+copyright: Copyright (c) 2019-2021 Edward Kmett
+stability: experimental
+category: Graphics
+build-type: Simple
+extra-doc-files:
+ README.md,
+ CHANGELOG.md
+
+source-repository head
+ type: git
+ location: https://github.com/ekmett/codex
+ subdir: bidi-icu
+
+common base
+ default-language: Haskell2010
+ ghc-options:
+ -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates
+ -Wredundant-constraints -Widentities -Wmissing-export-lists
+ build-depends: base >= 4.11 && < 5, data-default, primitive, text, vector
+
+library
+ import: base
+ hs-source-dirs: src
+ build-tool-depends: hsc2hs:hsc2hs
+ if os(darwin)
+ -- brew does not add icu-uc to pkg-config, because Apple
+ -- ships a subset of ICU itself.
+ extra-lib-dirs: /usr/local/opt/icu4c/lib
+ include-dirs: /usr/local/opt/icu4c/include
+ extra-libraries: icuuc
+ else
+ pkgconfig-depends: icu-uc
+ build-depends: containers >= 0.6, ghc-prim, inline-c, template-haskell, transformers
+ exposed-modules: Data.Text.ICU.Bidi
+
+test-suite spec
+ import: base
+ type: exitcode-stdio-1.0
+ hs-source-dirs: test
+ build-depends: bidi-icu, ghc-prim, hspec, tasty, tasty-hspec
+ main-is: Spec.hs
diff --git a/src/Data/Text/ICU/Bidi.hsc b/src/Data/Text/ICU/Bidi.hsc
new file mode 100644
--- /dev/null
+++ b/src/Data/Text/ICU/Bidi.hsc
@@ -0,0 +1,794 @@
+{-# 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 pa k = allocaBytes (n * I## (sizeOf## @a undefined)) \p -> copyPrimArrayToPtr p pa 0 n *> k n p where
+ n = sizeofPrimArray pa
+
+peekPrimArray :: Prim a => Int -> Ptr a -> IO (PrimArray a)
+peekPrimArray len ptr = do
+ mpa <- newPrimArray len
+ copyPtrToMutablePrimArray mpa 0 ptr len
+ unsafeFreezePrimArray mpa
+
+#ifndef HLINT
+#include "unicode/utypes.h"
+#include "unicode/uchar.h"
+#include "unicode/localpointer.h"
+#include "unicode/ubidi.h"
+#endif
+
+newtype Level = Level Word8
+ deriving (Eq,Ord,Show,Storable,Prim)
+
+isRTL :: Level -> Bool
+isRTL = coerce (odd @Word8)
+
+isLTR :: Level -> Bool
+isLTR = coerce (even @Word8)
+
+pattern LEVEL_OVERRIDE = (#const UBIDI_LEVEL_OVERRIDE) :: Word8
+
+isOverride :: Level -> Bool
+isOverride (Level l) = l .&. LEVEL_OVERRIDE /= 0
+
+override :: Level -> Level
+override (Level l) = Level (l .|. LEVEL_OVERRIDE)
+
+#ifndef HLINT
+pattern DEFAULT_LTR = Level (#const UBIDI_DEFAULT_LTR)
+pattern DEFAULT_RTL = Level (#const UBIDI_DEFAULT_RTL)
+pattern MAX_EXPLICIT_LEVEL = Level (#const UBIDI_MAX_EXPLICIT_LEVEL)
+#endif
+
+#ifndef HLINT
+-- | 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 MAP_NOWHERE = (#const UBIDI_MAP_NOWHERE) :: Int
+#endif
+
+newtype WriteOptions = WriteOptions Int16
+ deriving (Eq,Ord,Show,Storable,Prim,Bits)
+
+#ifndef HLINT
+pattern KEEP_BASE_COMBINING = WriteOptions (#const UBIDI_KEEP_BASE_COMBINING)
+pattern DO_MIRRORING = WriteOptions (#const UBIDI_DO_MIRRORING)
+pattern INSERT_LRM_FOR_NUMERIC = WriteOptions (#const UBIDI_INSERT_LRM_FOR_NUMERIC)
+pattern REMOVE_BIDI_CONTROLS = WriteOptions (#const UBIDI_REMOVE_BIDI_CONTROLS )
+pattern OUTPUT_REVERSE = WriteOptions (#const UBIDI_OUTPUT_REVERSE)
+#endif
+
+instance Default WriteOptions where
+ def = WriteOptions 0
+
+newtype UErrorCode = UErrorCode Int32
+ deriving (Eq,Ord,Show,Num,Enum,Real,Integral,Storable)
+
+instance Default UErrorCode where
+ def = UErrorCode 0
+
+-- |
+-- 'ReorderingOption' values indicate which options are
+-- specified to affect the Bidi algorithm.
+newtype ReorderingOption = ReorderingOption Int32
+ deriving (Eq,Ord,Show,Bits)
+
+#ifndef HLINT
+-- |
+-- option for 'setReorderingOptions' that disables all the options which can be
+-- set with this function
+--
+-- @since ICU 3.6
+pattern OPTION_DEFAULT = ReorderingOption (#const UBIDI_OPTION_DEFAULT)
+-- | @since ICU 3.6
+pattern OPTION_INSERT_MARKS = ReorderingOption (#const UBIDI_OPTION_INSERT_MARKS)
+-- | @since ICU 3.6
+pattern OPTION_REMOVE_CONTROLS = ReorderingOption (#const UBIDI_OPTION_REMOVE_CONTROLS)
+-- |
+pattern OPTION_STREAMING = ReorderingOption (#const UBIDI_OPTION_STREAMING)
+#endif
+
+instance Default ReorderingOption where
+ def = 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 is resolved, this will
+-- be able to be text.icu's @Data.Text.ICU.Char.Direction@.
+
+newtype CharDirection = CharDirection Int32 deriving
+ (Eq,Ord,Show,Storable,Prim)
+
+#ifndef HLINT
+-- | L @\@stable@ ICU 2.0
+pattern LEFT_TO_RIGHT = CharDirection (#const U_LEFT_TO_RIGHT)
+-- | R @\@stable@ ICU 2.0
+pattern RIGHT_TO_LEFT = CharDirection (#const U_RIGHT_TO_LEFT)
+-- | EN @\@stable@ ICU 2.0
+pattern EUROPEAN_NUMBER = CharDirection (#const U_EUROPEAN_NUMBER)
+-- | ES @\@stable@ ICU 2.0
+pattern EUROPEAN_NUMBER_SEPARATOR = CharDirection (#const U_EUROPEAN_NUMBER_SEPARATOR)
+-- | ET @\@stable@ ICU 2.0
+pattern EUROPEAN_NUMBER_TERMINATOR = CharDirection (#const U_EUROPEAN_NUMBER_TERMINATOR)
+-- | AN @\@stable@ ICU 2.0
+pattern ARABIC_NUMBER = CharDirection (#const U_ARABIC_NUMBER)
+-- | CS @\@stable@ ICU 2.0
+pattern COMMON_NUMBER_SEPARATOR = CharDirection (#const U_COMMON_NUMBER_SEPARATOR)
+-- | B @\@stable@ ICU 2.0
+pattern BLOCK_SEPARATOR = CharDirection (#const U_BLOCK_SEPARATOR)
+-- | SS@\@stable@ ICU 2.0
+pattern SEGMENT_SEPARATOR = CharDirection (#const U_SEGMENT_SEPARATOR)
+-- | WS @\@stable@ ICU 2.0
+pattern WHITE_SPACE_NEUTRAL = CharDirection (#const U_WHITE_SPACE_NEUTRAL)
+-- | ON @\@stable@ ICU 2.0
+pattern OTHER_NEUTRAL = CharDirection (#const U_OTHER_NEUTRAL)
+-- | LRE @\@stable@ ICU 2.0
+pattern LEFT_TO_RIGHT_EMBEDDING = CharDirection (#const U_LEFT_TO_RIGHT_EMBEDDING)
+-- | LRO @\@stable@ ICU 2.0
+pattern LEFT_TO_RIGHT_OVERRIDE = CharDirection (#const U_LEFT_TO_RIGHT_OVERRIDE)
+-- | AL @\@stable@ ICU 2.0
+pattern RIGHT_TO_LEFT_ARABIC = CharDirection (#const U_RIGHT_TO_LEFT_ARABIC)
+-- | RLE @\@stable@ ICU 2.0
+pattern RIGHT_TO_LEFT_EMBEDDING = CharDirection (#const U_RIGHT_TO_LEFT_EMBEDDING)
+-- | RLO @\@stable@ ICU 2.0
+pattern RIGHT_TO_LEFT_OVERRIDE = CharDirection (#const U_RIGHT_TO_LEFT_OVERRIDE)
+-- | PDF @\@stable@ ICU 2.0
+pattern POP_DIRECTIONAL_FORMAT = CharDirection (#const U_POP_DIRECTIONAL_FORMAT)
+-- | NSM @\@stable@ ICU 2.0
+pattern DIR_NON_SPACING_MARK = CharDirection (#const U_DIR_NON_SPACING_MARK)
+
+-- after text-icu scanned the headers
+
+-- | BN @\@stable@ ICU 52
+pattern BOUNDARY_NEUTRAL = CharDirection (#const U_BOUNDARY_NEUTRAL)
+-- | FSI @\@stable@ ICU 52
+pattern FIRST_STRONG_ISOLATE = CharDirection (#const U_FIRST_STRONG_ISOLATE)
+-- | LRI @\@stable@ ICU 52
+pattern LEFT_TO_RIGHT_ISOLATE = CharDirection (#const U_LEFT_TO_RIGHT_ISOLATE)
+-- | RLI @\@stable@ ICU 52
+pattern RIGHT_TO_LEFT_ISOLATE = CharDirection (#const U_RIGHT_TO_LEFT_ISOLATE)
+-- | PDI @\@stable@ ICU 52
+pattern POP_DIRECTIONAL_ISOLATE = CharDirection (#const U_POP_DIRECTIONAL_ISOLATE)
+
+-- | ICU 58 The numeric value may change over time, see ICU ticket #12420.
+pattern BIDI_CLASS_DEFAULT = CharDirection (#const U_BIDI_CLASS_DEFAULT) -- a damn lie
+#endif
+
+type ClassCallback = Ptr () -> Int32 -> IO CharDirection
+
+foreign import ccall "wrapper" mkClassCallback :: ClassCallback -> IO (FunPtr ClassCallback)
+
+ubool :: Int8 -> Bool
+ubool = (0/=)
+
+boolu :: Bool -> Int8
+boolu = fromIntegral . fromEnum
+
+data Direction
+ = LTR
+ | RTL
+ | Mixed
+ | Neutral
+ deriving (Eq,Ord,Show,Ix,Enum,Bounded,Data,Generic)
+
+data ReorderingMode
+ = ReorderDefault
+ | ReorderNumbersSpecial
+ | ReorderGroupNumbersWithR
+ | ReorderRunsOnly
+ | ReorderInverseNumbersAsL
+ | ReorderInverseLikeDirect
+ | ReorderInverseForNumbersSpecial
+ | ReorderCount
+ deriving (Eq,Ord,Show,Ix,Enum,Bounded,Data,Generic)
+
+data UBiDi
+
+data Bidi s = Bidi
+ { embeddingLevels :: IORef (Ptr Level) -- used to deal with ubidi_setPara shared content issues
+ , parentLink :: IORef (Maybe (Bidi s)) -- used to deal with ubidi_setLine shared content issues
+ , getBidi :: ForeignPtr UBiDi
+ }
+
+withBidi :: Bidi s -> (Ptr UBiDi -> IO r) -> IO r
+withBidi = withForeignPtr . 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 e = unsafeLocalState $ peekCString
+ [C.pure|const char * { u_errorName($(UErrorCode e)) }|]
+
+foreignBidi :: Ptr UBiDi -> IO (Bidi s)
+foreignBidi self_ptr = do
+ embeddings_ref <- newIORef nullPtr -- embeddingLevels
+ parent_ref <- newIORef Nothing -- parentLink
+ self_fptr <- Concurrent.newForeignPtr self_ptr do
+ [C.block|void { ubidi_close($(UBiDi * self_ptr)); }|] -- delete self
+ embeddings <- readIORef embeddings_ref -- clean up embeddings
+ when (embeddings /= nullPtr) do free embeddings
+ -- garbage collecting the parent link will allow parent to now possibly be freed if it has no references
+ pure $ Bidi embeddings_ref parent_ref self_fptr
+
+bad :: UErrorCode -> Bool
+bad e = [C.pure|int { U_FAILURE($(UErrorCode e)) }|] /= 0
+
+ok :: UErrorCode -> IO ()
+ok e = when (bad e) do throwIO e
+
+open :: PrimMonad m => m (Bidi (PrimState m))
+open = unsafeIOToPrim do [C.exp|UBiDi * { ubidi_open() }|] >>= foreignBidi
+
+openSized :: PrimMonad m => Int32 -> Int32 -> m (Bidi (PrimState m))
+openSized maxLength maxRunCount = unsafeIOToPrim do
+ with def \pErrorCode -> do
+ bidi <- [C.exp|UBiDi * { ubidi_openSized($(int32_t maxLength),$(int32_t maxRunCount),$(UErrorCode * pErrorCode)) }|]
+ peek pErrorCode >>= ok
+ foreignBidi bidi
+
+getText :: PrimMonad m => Bidi (PrimState m) -> m Text
+getText bidi = unsafeIOToPrim do
+ withBidi bidi \p -> do
+ cwstr <- [C.exp|const UChar * { ubidi_getText($(const UBiDi * p))}|]
+ len <- [C.exp|int32_t { ubidi_getLength($(const UBiDi * p))}|]
+ fromPtr cwstr (fromIntegral len)
+
+getLength :: PrimMonad m => Bidi (PrimState m) -> m Int32
+getLength bidi = unsafeIOToPrim [C.exp|int32_t { ubidi_getLength($bidi:bidi) }|]
+
+setInverse :: PrimMonad m => Bidi (PrimState m) -> Bool -> m ()
+setInverse bidi (boolu -> b) = unsafeIOToPrim [C.block|void { ubidi_setInverse($bidi:bidi,$(UBool b)); }|]
+
+isInverse :: PrimMonad m => Bidi (PrimState m) -> m Bool
+isInverse bidi = unsafeIOToPrim do [C.exp|UBool { ubidi_isInverse($bidi:bidi) }|] <&> ubool
+
+orderParagraphsLTR :: PrimMonad m => Bidi (PrimState m) -> Bool -> m ()
+orderParagraphsLTR bidi (boolu -> b) = unsafeIOToPrim [C.block|void { ubidi_orderParagraphsLTR($bidi:bidi,$(UBool b)); }|]
+
+isOrderParagraphsLTR :: PrimMonad m => Bidi (PrimState m) -> m Bool
+isOrderParagraphsLTR bidi = unsafeIOToPrim do [C.exp|UBool { ubidi_isOrderParagraphsLTR($bidi:bidi) }|] <&> ubool
+
+setReorderingMode :: PrimMonad m => Bidi (PrimState m) -> ReorderingMode -> m ()
+setReorderingMode bidi (fromIntegral . fromEnum -> mode) = unsafeIOToPrim [C.block|void { ubidi_setReorderingMode($bidi:bidi,$(UBiDiReorderingMode mode)); }|]
+
+getReorderingMode :: PrimMonad m => Bidi (PrimState m) -> m ReorderingMode
+getReorderingMode bidi = unsafeIOToPrim do [C.exp|UBiDiReorderingMode{ ubidi_getReorderingMode($bidi:bidi)}|] <&> toEnum . fromIntegral
+
+setReorderingOptions :: PrimMonad m => Bidi (PrimState m) -> ReorderingOption -> m ()
+setReorderingOptions bidi options = unsafeIOToPrim [C.block|void { ubidi_setReorderingOptions($bidi:bidi,$(UBiDiReorderingOption options)); }|]
+
+getReorderingOptions :: PrimMonad m => Bidi (PrimState m) -> m ReorderingOption
+getReorderingOptions bidi = unsafeIOToPrim do [C.exp|UBiDiReorderingOption { ubidi_getReorderingOptions($bidi:bidi) }|]
+
+setContext :: PrimMonad m => Bidi (PrimState m) -> Text -> Text -> m ()
+setContext bidi prologue_text epilogue_text = unsafeIOToPrim do
+ useAsPtr prologue_text \prologue (fromIntegral -> prologue_len) ->
+ useAsPtr epilogue_text \epilogue (fromIntegral -> 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;
+ }|] >>= ok
+
+setPara :: PrimMonad m => Bidi (PrimState m) -> Text -> Level -> Maybe (Prim.Vector Level) -> m ()
+setPara bidi text paraLevel els = unsafeIOToPrim do
+ useAsPtr text \t i16@(fromIntegral -> len) -> do
+ (fromMaybe nullPtr -> u) <- for els \(Prim.Vector vofs vlen (ByteArray vba)) -> do
+ u <- if vlen < len
+ then callocBytes (fromIntegral i16)
+ else mallocBytes (fromIntegral i16)
+ u <$ copyPrimArrayToPtr u (PrimArray vba) vofs vlen -- missing from Data.Vector
+ let n = fromIntegral 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;
+ }|] >>= ok
+ v <- atomicModifyIORef (embeddingLevels bidi) (u,)
+ when (v /= nullPtr) do free v
+
+setLine :: PrimMonad m => Bidi (PrimState m) -> Int32 -> Int32 -> Bidi (PrimState m) -> m ()
+setLine para start limit line = 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;
+ }|] >>= ok
+ writeIORef (parentLink line) $ Just para -- prevents deallocation of the paragraph bidi before we at least repurpose the line
+
+getDirection :: PrimMonad m => Bidi (PrimState m) -> m Direction
+getDirection bidi = unsafeIOToPrim do
+ [C.exp|UBiDiDirection { ubidi_getDirection($bidi:bidi) }|] <&> toEnum . fromIntegral
+
+getBaseDirection :: Text -> Direction
+getBaseDirection text = unsafeLocalState do
+ useAsPtr text \t (fromIntegral -> len) ->
+ [C.exp|UBiDiDirection { ubidi_getBaseDirection($(const UChar * t),$(int32_t len)) }|] <&> toEnum . fromIntegral
+
+getParaLevel :: PrimMonad m => Bidi (PrimState m) -> m Level
+getParaLevel bidi = unsafeIOToPrim [C.exp|UBiDiLevel { ubidi_getParaLevel($bidi:bidi) }|]
+
+countParagraphs :: PrimMonad m => Bidi (PrimState m) -> m Int32
+countParagraphs bidi = 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 bidi charIndex = unsafeIOToPrim do
+ allocaArray 2 \pParaStart ->
+ alloca \pParaLevel ->
+ with def \pErrorCode -> do
+ 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)
+ );
+ }|]
+ peek pErrorCode >>= ok
+ (,,,) result
+ <$> peek pParaStart
+ <*> peek (Prim.advancePtr pParaStart 1) -- pParaLimit
+ <*> peek pParaLevel
+
+getParagraphByIndex :: PrimMonad m => Bidi (PrimState m) -> Int32 -> m (Int32, Int32, Level)
+getParagraphByIndex bidi paragraphIndex = unsafeIOToPrim do
+ allocaArray 2 \pParaStart ->
+ alloca \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;
+ }|] >>= ok
+ (,,) <$> peek pParaStart
+ <*> peek (Prim.advancePtr pParaStart 1) -- pParaLimit
+ <*> peek pParaLevel
+
+
+getLevelAt :: PrimMonad m => Bidi (PrimState m) -> Int32 -> m Level
+getLevelAt bidi charIndex = unsafeIOToPrim [C.exp|UBiDiLevel { ubidi_getLevelAt($bidi:bidi,$(int32_t charIndex)) }|]
+
+getLogicalRun :: PrimMonad m => Bidi (PrimState m) -> Int32 -> m (Int32, Level)
+getLogicalRun bidi logicalPosition = unsafeIOToPrim do
+ alloca \pLevel ->
+ (,) <$> [C.block|int32_t {
+ int32_t logicalLimit;
+ ubidi_getLogicalRun(
+ $bidi:bidi,
+ $(int32_t logicalPosition),
+ &logicalLimit,
+ $(UBiDiLevel * pLevel)
+ );
+ return logicalLimit;
+ }|]
+ <*> peek pLevel
+
+countRuns :: PrimMonad m => Bidi (PrimState m) -> m Int32
+countRuns bidi = unsafeIOToPrim do
+ with def \pErrorCode -> do
+ [C.exp|int32_t {
+ ubidi_countRuns($bidi:bidi, $(UErrorCode * pErrorCode))
+ }|] <* (peek pErrorCode >>= 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 bidi runIndex = unsafeIOToPrim do
+ allocaArray 2 \pLogicalStart -> do
+ dir <- [C.block|UBiDiDirection {
+ int32_t * pLogicalStart = $(int32_t * pLogicalStart);
+ return ubidi_getVisualRun(
+ $bidi:bidi,
+ $(int32_t runIndex),
+ pLogicalStart,
+ pLogicalStart+1 /* pLength */
+ );
+ }|] <&> toEnum . fromIntegral
+ logical_start <- peek pLogicalStart
+ len <- peek (Prim.advancePtr pLogicalStart 1) -- pLength
+ pure (logical_start, len, dir)
+
+invertMap :: PrimArray Int32 -> PrimArray Int32
+invertMap pa = unsafePerformIO do -- use a full heavy weight dup check as this can be slow for large maps
+ let !n = sizeofPrimArray pa
+ let !m = fromIntegral (foldlPrimArray' max (-1) pa + 1)
+ allocaArray (n+m) \srcMap -> do
+ copyPrimArrayToPtr srcMap pa 0 n
+ let len = fromIntegral n
+ [C.block|void {
+ int32_t * srcMap = $(int32_t * srcMap);
+ int32_t len = $(int32_t len);
+ ubidi_invertMap(srcMap,srcMap+len,len);
+ }|]
+ peekPrimArray m (Prim.advancePtr srcMap n) -- dstMap
+
+getVisualIndex :: PrimMonad m => Bidi (PrimState m) -> Int32 -> m Int32
+getVisualIndex bidi logicalIndex = unsafeIOToPrim do
+ with def \pErrorCode ->
+ [C.exp|int32_t {
+ ubidi_getVisualIndex($bidi:bidi,$(int32_t logicalIndex),$(UErrorCode * pErrorCode))
+ }|] <* (peek pErrorCode >>= ok)
+
+getLogicalIndex :: PrimMonad m => Bidi (PrimState m) -> Int32 -> m Int32
+getLogicalIndex bidi visualIndex = unsafeIOToPrim do
+ with def \pErrorCode ->
+ [C.exp|int32_t {
+ ubidi_getLogicalIndex($bidi:bidi,$(int32_t visualIndex),$(UErrorCode * pErrorCode))
+ }|] <* (peek pErrorCode >>= ok)
+
+getLogicalMap :: PrimMonad m => Bidi (PrimState m) -> m (PrimArray Int32)
+getLogicalMap bidi = stToPrim do
+ len <- fromIntegral <$> do
+ opts <- getReorderingOptions bidi
+ processed_len <- getProcessedLength bidi
+ if opts .&. OPTION_INSERT_MARKS /= OPTION_DEFAULT
+ then max processed_len <$> getResultLength bidi
+ else pure processed_len
+ unsafeIOToPrim do
+ allocaArray len \ indexMap -> do
+ [C.block|UErrorCode {
+ UErrorCode error_code = 0;
+ ubidi_getLogicalMap($bidi:bidi,$(int32_t * indexMap),&error_code);
+ return error_code;
+ }|] >>= ok
+ peekPrimArray len indexMap
+
+getVisualMap :: PrimMonad m => Bidi (PrimState m) -> m (PrimArray Int32)
+getVisualMap bidi = stToPrim do
+ len <- fromIntegral <$> do
+ opts <- getReorderingOptions bidi
+ result_len <- getResultLength bidi
+ if opts .&. OPTION_INSERT_MARKS /= OPTION_DEFAULT
+ then max result_len <$> getProcessedLength bidi
+ else pure result_len
+ unsafeIOToPrim do
+ allocaArray len \indexMap -> do
+ [C.block|UErrorCode {
+ UErrorCode error_code = 0;
+ ubidi_getVisualMap($bidi:bidi,$(int32_t * indexMap),&error_code);
+ return error_code;
+ }|] >>= ok
+ peekPrimArray len indexMap
+
+getResultLength :: PrimMonad m => Bidi (PrimState m) -> m Int32
+getResultLength bidi = unsafeIOToPrim [C.exp|int32_t { ubidi_getProcessedLength($bidi:bidi) }|]
+
+getProcessedLength :: PrimMonad m => Bidi (PrimState m) -> m Int32
+getProcessedLength bidi = unsafeIOToPrim [C.exp|int32_t { ubidi_getProcessedLength($bidi:bidi) }|]
+
+getLevels :: PrimMonad m => Bidi (PrimState m) -> m (PrimArray Level)
+getLevels bidi = stToPrim do
+ len <- fromIntegral <$> getProcessedLength bidi
+ unsafeIOToPrim $
+ with def \pErrorCode -> do
+ levels <- [C.exp|const UBiDiLevel * { ubidi_getLevels($bidi:bidi, $(UErrorCode * pErrorCode)) }|]
+ peek pErrorCode >>= ok
+ peekPrimArray len levels
+
+reorderLogical :: PrimArray Level -> PrimArray Int32
+reorderLogical pa = unsafePerformIO do
+ withPrimArrayLen pa \n@(fromIntegral -> len) levels ->
+ allocaArray n \indexMap ->
+ [C.block|void {
+ ubidi_reorderLogical($(const UBiDiLevel * levels),$(int32_t len),$(int32_t * indexMap));
+ }|] *> peekPrimArray n indexMap
+
+reorderVisual :: PrimArray Level -> PrimArray Int32
+reorderVisual pa = unsafePerformIO do
+ withPrimArrayLen pa \n@(fromIntegral -> len) levels ->
+ allocaArray n \indexMap ->
+ [C.block|void {
+ ubidi_reorderVisual($(const UBiDiLevel * levels),$(int32_t len),$(int32_t * indexMap));
+ }|] *> peekPrimArray n indexMap
+
+getCustomizedClass :: PrimMonad m => Bidi (PrimState m) -> Char -> m CharDirection
+getCustomizedClass bidi (fromIntegral . fromEnum -> c) = unsafeIOToPrim
+ [C.exp|UCharDirection { ubidi_getCustomizedClass($bidi:bidi, $(UChar32 c)) }|]
+
+setClassCallback :: PrimMonad m => Bidi (PrimState m) -> FunPtr ClassCallback -> Ptr () -> m (FunPtr ClassCallback, Ptr ())
+setClassCallback bidi newFn newCtx = unsafeIOToPrim do
+ alloca \oldFn ->
+ alloca \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;
+ }|] >>= ok
+ (,) <$> peek oldFn <*> peek oldCtx
+
+getClassCallback :: PrimMonad m => Bidi (PrimState m) -> m (FunPtr ClassCallback, Ptr ())
+getClassCallback bidi = unsafeIOToPrim do
+ alloca \fn ->
+ alloca \ctx ->
+ (,) <$ [C.block|void { ubidi_getClassCallback($bidi:bidi,$(UBiDiClassCallbackPtr * fn),$(const void ** ctx)); }|]
+ <*> peek fn
+ <*> peek ctx
+
+writeReordered :: PrimMonad m => Bidi (PrimState m) -> WriteOptions -> m Text
+writeReordered bidi options = stToPrim do
+ destSize@(fromIntegral -> len) <- if options .&. INSERT_LRM_FOR_NUMERIC /= def
+ then do
+ len <- getLength bidi
+ runs <- countRuns bidi
+ pure $ len + 2 * runs
+ else getProcessedLength bidi
+ unsafeIOToPrim do
+ allocaArray len \dest ->
+ with def \pErrorCode -> do
+ actual_len <- [C.exp|int32_t {
+ ubidi_writeReordered($bidi:bidi,$(UChar * dest),$(int32_t destSize),$(WriteOptions options),$(UErrorCode * pErrorCode))
+ }|]
+ peek pErrorCode >>= ok
+ fromPtr dest $ fromIntegral actual_len
+
+writeReverse :: Text -> WriteOptions -> Text
+writeReverse t options = unsafePerformIO do
+ useAsPtr t \src i16@(fromIntegral -> n) ->
+ allocaArray (fromIntegral i16) \ dest ->
+ with def \pErrorCode -> do
+ 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));
+ }|]
+ peek pErrorCode >>= ok
+ fromPtr dest $ fromIntegral actual_len
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,39 @@
+{-# language OverloadedStrings #-}
+{-# language OverloadedLists #-}
+module Main
+( main
+) where
+
+import GHC.Exts
+import Data.Text.ICU.Bidi
+import System.Mem
+import Test.Hspec as Hspec
+import Test.Tasty
+import Test.Tasty.Hspec
+
+spec :: Spec
+spec = Hspec.after_ performMajorGC $ do
+ describe "bidi" $ do
+ it "can handle English" $ do
+ x <- open
+ getBaseDirection "hello" `shouldBe` LTR
+ setPara x "hello" DEFAULT_LTR Nothing
+ getLength x `shouldReturn` 5
+ getText x `shouldReturn` "hello"
+ writeReordered x DO_MIRRORING `shouldReturn` "hello"
+ getLogicalMap x `shouldReturn` [0..4]
+ getVisualMap x `shouldReturn` [0..4]
+ getLevels x `shouldReturn` [Level 0,Level 0,Level 0,Level 0,Level 0]
+ it "can handle Arabic" $ do
+ x <- open
+ getBaseDirection "أنا قادر على أكل الزجاج و هذا لا يؤلمني." `shouldBe` RTL
+ setPara x "This is an Arabic sentence: أنا قادر على أكل الزجاج و هذا لا يؤلمني. It is surrounded by English" DEFAULT_LTR Nothing
+ getLength x `shouldReturn` 96
+ getLogicalMap x `shouldReturn` fromList ([0..27] ++ [66,65..28] ++ [67..95])
+ getVisualMap x `shouldReturn` fromList ([0..27] ++ [66,65..28] ++ [67..95])
+ getLevels x `shouldReturn` fromList (replicate 28 (Level 0) ++ replicate 39 (Level 1) ++ replicate 29 (Level 0))
+
+main :: IO ()
+main = do
+ spec' <- testSpec "spec" spec
+ defaultMain spec'