packages feed

bidi-icu (empty) → 0

raw patch · 6 files changed

+1132/−0 lines, 6 filesdep +basedep +bidi-icudep +containers

Dependencies added: base, bidi-icu, containers, data-default, ghc-prim, hspec, inline-c, primitive, tasty, tasty-hspec, template-haskell, text, transformers, vector

Files

+ CHANGELOG.md view
@@ -0,0 +1,2 @@+# 0+* Library created
+ LICENSE.md view
@@ -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_  +_&lt;<http://www.apache.org/licenses/>&gt;_++### 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.+
+ README.md view
@@ -0,0 +1,16 @@+bidi-icu+=============++[![Hackage](https://img.shields.io/hackage/v/bidi-icu.svg)](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+
+ bidi-icu.cabal view
@@ -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 <ekmett@gmail.com>+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
+ src/Data/Text/ICU/Bidi.hsc view
@@ -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 <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+  (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
+ test/Spec.hs view
@@ -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'