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 +2/−0
- LICENSE.md +230/−0
- README.md +16/−0
- bidi-icu.cabal +51/−0
- src/Data/Text/ICU/Bidi.hsc +794/−0
- test/Spec.hs +39/−0
+ 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_ +_<<http://www.apache.org/licenses/>>_++### 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+=============++[](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'