{-# LINE 1 "Data/Text/ICU/Char.hsc" #-}
{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances,
    ForeignFunctionInterface, FunctionalDependencies, MultiParamTypeClasses #-}

-- |
-- Module      : Data.Text.ICU.Char
-- Copyright   : (c) 2010 Bryan O'Sullivan
--
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- Access to the Unicode Character Database, implemented as bindings
-- to the International Components for Unicode (ICU) libraries.
--
-- Unicode assigns each code point (not just assigned character) values for
-- many properties.  Most are simple boolean flags, or constants from a
-- small enumerated list.  For some, values are relatively more complex
-- types.
--
-- For more information see \"About the Unicode Character Database\"
-- <http://www.unicode.org/ucd/> and the ICU User Guide chapter on
-- Properties <http://icu-project.org/userguide/properties.html>.
module Data.Text.ICU.Char
    (
    -- * Working with character properties
    -- $properties
      Property
    -- * Property identifier types
    , BidiClass_(..)
    , Block_(..)
    , Bool_(..)
    , Decomposition_(..)
    , EastAsianWidth_(..)
    , GeneralCategory_(..)
    , HangulSyllableType_(..)
    , JoiningGroup_(..)
    , JoiningType_(..)
    , NumericType_(..)
    -- ** Combining class
    , CanonicalCombiningClass_(..)
    , LeadCanonicalCombiningClass_(..)
    , TrailingCanonicalCombiningClass_(..)
    -- ** Normalization checking
    , NFCQuickCheck_(..)
    , NFDQuickCheck_(..)
    , NFKCQuickCheck_(..)
    , NFKDQuickCheck_(..)
    -- ** Text boundaries
    , GraphemeClusterBreak_(..)
    , LineBreak_(..)
    , SentenceBreak_(..)
    , WordBreak_(..)
    , BidiPairedBracketType_(..)
    -- * Property value types
    , BlockCode(..)
    , Direction(..)
    , Decomposition(..)
    , EastAsianWidth(..)
    , GeneralCategory(..)
    , HangulSyllableType(..)
    , JoiningGroup(..)
    , JoiningType(..)
    , NumericType(..)
    -- ** Text boundaries
    , GraphemeClusterBreak(..)
    , LineBreak(..)
    , SentenceBreak(..)
    , WordBreak(..)
    , BidiPairedBracketType(..)
    -- * Functions
    , blockCode
    , charFullName
    , charName
    , charFromFullName
    , charFromName
    , combiningClass
    , direction
    , property
    , isMirrored
    , mirror
    -- ** Conversion to numbers
    , digitToInt
    , numericValue
    ) where



import Control.DeepSeq (NFData(..))
import Data.Char (chr, ord)
import Data.Int (Int32)
import Data.Text.ICU.Error (u_INVALID_CHAR_FOUND)
import Data.Text.ICU.Error.Internal (UErrorCode, handleOverflowError, withError)
import Data.Text.ICU.Internal (UBool, UChar32, asBool)
import Data.Text.ICU.Normalize.Internal (toNCR)
import Data.Typeable (Typeable)
import Data.Word (Word8)
import Foreign.C.String (CString, peekCStringLen, withCString)
import Foreign.C.Types (CInt(..))
import Foreign.Ptr (Ptr)
import System.IO.Unsafe (unsafePerformIO)

-- $properties
--
-- The 'property' function provides the main view onto the Unicode Character
-- Database.  Because Unicode character properties have a variety of types,
-- the 'property' function is polymorphic.  The type of its first argument
-- dictates the type of its result, by use of the 'Property' typeclass.
--
-- For instance, @'property' 'Alphabetic'@ returns a 'Bool', while @'property'
-- 'NFCQuickCheck'@ returns a @'Maybe' 'Bool'@.

-- | The language directional property of a character set.
data Direction =
    LeftToRight
  | RightToLeft
  | EuropeanNumber
  | EuropeanNumberSeparator
  | EuropeanNumberTerminator
  | ArabicNumber
  | CommonNumberSeparator
  | BlockSeparator
  | SegmentSeparator
  | WhiteSpaceNeutral
  | OtherNeutral
  | LeftToRightEmbedding
  | LeftToRightOverride
  | RightToLeftArabic
  | RightToLeftEmbedding
  | RightToLeftOverride
  | PopDirectionalFormat
  | DirNonSpacingMark
  | BoundaryNeutral
  | FirstStrongIsolate
  | LeftToRightIsolate
  | RightToLeftIsolate
  | PopDirectionalIsolate
  deriving (Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq, Int -> Direction
Direction -> Int
Direction -> [Direction]
Direction -> Direction
Direction -> Direction -> [Direction]
Direction -> Direction -> Direction -> [Direction]
(Direction -> Direction)
-> (Direction -> Direction)
-> (Int -> Direction)
-> (Direction -> Int)
-> (Direction -> [Direction])
-> (Direction -> Direction -> [Direction])
-> (Direction -> Direction -> [Direction])
-> (Direction -> Direction -> Direction -> [Direction])
-> Enum Direction
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Direction -> Direction -> Direction -> [Direction]
$cenumFromThenTo :: Direction -> Direction -> Direction -> [Direction]
enumFromTo :: Direction -> Direction -> [Direction]
$cenumFromTo :: Direction -> Direction -> [Direction]
enumFromThen :: Direction -> Direction -> [Direction]
$cenumFromThen :: Direction -> Direction -> [Direction]
enumFrom :: Direction -> [Direction]
$cenumFrom :: Direction -> [Direction]
fromEnum :: Direction -> Int
$cfromEnum :: Direction -> Int
toEnum :: Int -> Direction
$ctoEnum :: Int -> Direction
pred :: Direction -> Direction
$cpred :: Direction -> Direction
succ :: Direction -> Direction
$csucc :: Direction -> Direction
Enum, Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Direction] -> ShowS
$cshowList :: [Direction] -> ShowS
show :: Direction -> String
$cshow :: Direction -> String
showsPrec :: Int -> Direction -> ShowS
$cshowsPrec :: Int -> Direction -> ShowS
Show, Typeable)

instance NFData Direction where
    rnf :: Direction -> ()
rnf !Direction
_ = ()

-- | Descriptions of Unicode blocks.
data BlockCode =
    NoBlock
  | BasicLatin
  | Latin1Supplement
  | LatinExtendedA
  | LatinExtendedB
  | IPAExtensions
  | SpacingModifierLetters
  | CombiningDiacriticalMarks
  | GreekAndCoptic
  | Cyrillic
  | Armenian
  | Hebrew
  | Arabic
  | Syriac
  | Thaana
  | Devanagari
  | Bengali
  | Gurmukhi
  | Gujarati
  | Oriya
  | Tamil
  | Telugu
  | Kannada
  | Malayalam
  | Sinhala
  | Thai
  | Lao
  | Tibetan
  | Myanmar
  | Georgian
  | HangulJamo
  | Ethiopic
  | Cherokee
  | UnifiedCanadianAboriginalSyllabics
  | Ogham
  | Runic
  | Khmer
  | Mongolian
  | LatinExtendedAdditional
  | GreekExtended
  | GeneralPunctuation
  | SuperscriptsAndSubscripts
  | CurrencySymbols
  | CombiningDiacriticalMarksForSymbols
  | LetterlikeSymbols
  | NumberForms
  | Arrows
  | MathematicalOperators
  | MiscellaneousTechnical
  | ControlPictures
  | OpticalCharacterRecognition
  | EnclosedAlphanumerics
  | BoxDrawing
  | BlockElements
  | GeometricShapes
  | MiscellaneousSymbols
  | Dingbats
  | BraillePatterns
  | CJKRadicalsSupplement
  | KangxiRadicals
  | IdeographicDescriptionCharacters
  | CJKSymbolsAndPunctuation
  | Hiragana
  | Katakana
  | Bopomofo
  | HangulCompatibilityJamo
  | Kanbun
  | BopomofoExtended
  | EnclosedCJKLettersAndMonths
  | CJKCompatibility
  | CJKUnifiedIdeographsExtensionA
  | CJKUnifiedIdeographs
  | YiSyllables
  | YiRadicals
  | HangulSyllables
  | HighSurrogates
  | HighPrivateUseSurrogates
  | LowSurrogates
  | PrivateUseArea
  | CJKCompatibilityIdeographs
  | AlphabeticPresentationForms
  | ArabicPresentationFormsA
  | CombiningHalfMarks
  | CJKCompatibilityForms
  | SmallFormVariants
  | ArabicPresentationFormsB
  | Specials
  | HalfwidthAndFullwidthForms
  | OldItalic
  | Gothic
  | Deseret
  | ByzantineMusicalSymbols
  | MusicalSymbols
  | MathematicalAlphanumericSymbols
  | CJKUnifiedIdeographsExtensionB
  | CJKCompatibilityIdeographsSupplement
  | Tags
  | CyrillicSupplement
  | Tagalog
  | Hanunoo
  | Buhid
  | Tagbanwa
  | MiscellaneousMathematicalSymbolsA
  | SupplementalArrowsA
  | SupplementalArrowsB
  | MiscellaneousMathematicalSymbolsB
  | SupplementalMathematicalOperators
  | KatakanaPhoneticExtensions
  | VariationSelectors
  | SupplementaryPrivateUseAreaA
  | SupplementaryPrivateUseAreaB
  | Limbu
  | TaiLe
  | KhmerSymbols
  | PhoneticExtensions
  | MiscellaneousSymbolsAndArrows
  | YijingHexagramSymbols
  | LinearBSyllabary
  | LinearBIdeograms
  | AegeanNumbers
  | Ugaritic
  | Shavian
  | Osmanya
  | CypriotSyllabary
  | TaiXuanJingSymbols
  | VariationSelectorsSupplement
  | AncientGreekMusicalNotation
  | AncientGreekNumbers
  | ArabicSupplement
  | Buginese
  | CJKStrokes
  | CombiningDiacriticalMarksSupplement
  | Coptic
  | EthiopicExtended
  | EthiopicSupplement
  | GeorgianSupplement
  | Glagolitic
  | Kharoshthi
  | ModifierToneLetters
  | NewTaiLue
  | OldPersian
  | PhoneticExtensionsSupplement
  | SupplementalPunctuation
  | SylotiNagri
  | Tifinagh
  | VerticalForms
  | N'Ko
  | Balinese
  | LatinExtendedC
  | LatinExtendedD
  | PhagsPa
  | Phoenician
  | Cuneiform
  | CuneiformNumbersAndPunctuation
  | CountingRodNumerals
  | Sundanese
  | Lepcha
  | OlChiki
  | CyrillicExtendedA
  | Vai
  | CyrillicExtendedB
  | Saurashtra
  | KayahLi
  | Rejang
  | Cham
  | AncientSymbols
  | PhaistosDisc
  | Lycian
  | Carian
  | Lydian
  | MahjongTiles
  | DominoTiles
  | Samaritan
  | UnifiedCanadianAboriginalSyllabicsExtended
  | TaiTham
  | VedicExtensions
  | Lisu
  | Bamum
  | CommonIndicNumberForms
  | DevanagariExtended
  | HangulJamoExtendedA
  | Javanese
  | MyanmarExtendedA
  | TaiViet
  | MeeteiMayek
  | HangulJamoExtendedB
  | ImperialAramaic
  | OldSouthArabian
  | Avestan
  | InscriptionalParthian
  | InscriptionalPahlavi
  | OldTurkic
  | RumiNumeralSymbols
  | Kaithi
  | EgyptianHieroglyphs
  | EnclosedAlphanumericSupplement
  | EnclosedIdeographicSupplement
  | CJKUnifiedIdeographsExtensionC
  | Mandaic
  | Batak
  | EthiopicExtendedA
  | Brahmi
  | BamumSupplement
  | KanaSupplement
  | PlayingCards
  | MiscellaneousSymbolsAndPictographs
  | Emoticons
  | TransportAndMapSymbols
  | AlchemicalSymbols
  | CJKUnifiedIdeographsExtensionD
  | ArabicExtendedA
  | ArabicMathematicalAlphabeticSymbols
  | Chakma
  | MeeteiMayekExtensions
  | MeroiticCursive
  | MeroiticHieroglyphs
  | Miao
  | Sharada
  | SoraSompeng
  | SundaneseSupplement
  | Takri
  | BassaVah
  | CaucasianAlbanian
  | CopticEpactNumbers
  | CombiningDiacriticalMarksExtended
  | Duployan
  | Elbasan
  | GeometricShapesExtended
  | Grantha
  | Khojki
  | Khudawadi
  | LatinExtendedE
  | LinearA
  | Mahajani
  | Manichaean
  | MendeKikakui
  | Modi
  | Mro
  | MyanmarExtendedB
  | Nabataean
  | OldNorthArabian
  | OldPermic
  | OrnamentalDingbats
  | PahawhHmong
  | Palmyrene
  | PauCinHau
  | PsalterPahlavi
  | ShorthandFormatControls
  | Siddham
  | SinhalaArchaicNumbers
  | SupplementalArrowsC
  | Tirhuta
  | WarangCiti
  | Ahom
  | AnatolianHieroglyphs
  | CherokeeSupplement
  | CJKUnifiedIdeographsExtensionE
  | EarlyDynasticCuneiform
  | Hatran
  | Multani
  | OldHungarian
  | SupplementalSymbolsAndPictographs
  | SuttonSignwriting

    -- New blocks in Unicode 9.0 (ICU 58)

  | Adlam
  | Bhaiksuki
  | CyrillicExtendedC
  | GlagoliticSupplement
  | IdeographicSymbolsAndPunctuation
  | Marchen
  | MongolianSupplement
  | Newa
  | Osage
  | Tangut
  | TangutComponents

    -- New blocks in Unicode 10.0 (ICU 60)

  | CjkUnifiedIdeographsExtensionF
  | KanaExtendedA
  | MasaramGondi
  | Nushu
  | Soyombo
  | SyriacSupplement
  | ZanabazarSquare

    -- New blocks in Unicode 11.0 (ICU 62)

  | ChessSymbols
  | Dogra
  | GeorgianExtended
  | GunjalaGondi
  | HanifiRohingya
  | IndicSiyaqNumbers
  | Makasar
  | MayanNumerals
  | Medefaidrin
  | OldSogdian
  | Sogdian

    -- New blocks in Unicode 12.0 (ICU 64)

  | EgyptianHieroglyphFormatControls
  | Elymaic
  | Nandinagari
  | NyiakengPuachueHmong
  | OttomanSiyaqNumbers
  | SmallKanaExtension
  | SymbolsAndPictographsExtendedA
  | TamilSupplement
  | Wancho

    -- New blocks in Unicode 13.0 (ICU 66)

  | Chorasmian
  | CjkUnifiedIdeographsExtensionG
  | DivesAkuru
  | KhitanSmallScript
  | LisuSupplement
  | SymbolsForLegacyComputing
  | TangutSupplement
  | Yezidi

    -- New blocks in Unicode 14.0 (ICU 70)

  | ArabicExtendedB
  | CyproMinoan
  | EthiopicExtendedB
  | KanaExtendedB
  | LatinExtendedF
  | LatinExtendedG
  | OldUyghur
  | Tangsa
  | Toto
  | UnifiedCanadianAboriginalSyllabicsExtendedA
  | Vithkuqi
  | ZnamennyMusicalNotation

  deriving (BlockCode -> BlockCode -> Bool
(BlockCode -> BlockCode -> Bool)
-> (BlockCode -> BlockCode -> Bool) -> Eq BlockCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockCode -> BlockCode -> Bool
$c/= :: BlockCode -> BlockCode -> Bool
== :: BlockCode -> BlockCode -> Bool
$c== :: BlockCode -> BlockCode -> Bool
Eq, Int -> BlockCode
BlockCode -> Int
BlockCode -> [BlockCode]
BlockCode -> BlockCode
BlockCode -> BlockCode -> [BlockCode]
BlockCode -> BlockCode -> BlockCode -> [BlockCode]
(BlockCode -> BlockCode)
-> (BlockCode -> BlockCode)
-> (Int -> BlockCode)
-> (BlockCode -> Int)
-> (BlockCode -> [BlockCode])
-> (BlockCode -> BlockCode -> [BlockCode])
-> (BlockCode -> BlockCode -> [BlockCode])
-> (BlockCode -> BlockCode -> BlockCode -> [BlockCode])
-> Enum BlockCode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BlockCode -> BlockCode -> BlockCode -> [BlockCode]
$cenumFromThenTo :: BlockCode -> BlockCode -> BlockCode -> [BlockCode]
enumFromTo :: BlockCode -> BlockCode -> [BlockCode]
$cenumFromTo :: BlockCode -> BlockCode -> [BlockCode]
enumFromThen :: BlockCode -> BlockCode -> [BlockCode]
$cenumFromThen :: BlockCode -> BlockCode -> [BlockCode]
enumFrom :: BlockCode -> [BlockCode]
$cenumFrom :: BlockCode -> [BlockCode]
fromEnum :: BlockCode -> Int
$cfromEnum :: BlockCode -> Int
toEnum :: Int -> BlockCode
$ctoEnum :: Int -> BlockCode
pred :: BlockCode -> BlockCode
$cpred :: BlockCode -> BlockCode
succ :: BlockCode -> BlockCode
$csucc :: BlockCode -> BlockCode
Enum, BlockCode
BlockCode -> BlockCode -> Bounded BlockCode
forall a. a -> a -> Bounded a
maxBound :: BlockCode
$cmaxBound :: BlockCode
minBound :: BlockCode
$cminBound :: BlockCode
Bounded, Int -> BlockCode -> ShowS
[BlockCode] -> ShowS
BlockCode -> String
(Int -> BlockCode -> ShowS)
-> (BlockCode -> String)
-> ([BlockCode] -> ShowS)
-> Show BlockCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockCode] -> ShowS
$cshowList :: [BlockCode] -> ShowS
show :: BlockCode -> String
$cshow :: BlockCode -> String
showsPrec :: Int -> BlockCode -> ShowS
$cshowsPrec :: Int -> BlockCode -> ShowS
Show, Typeable)

instance NFData BlockCode where
    rnf :: BlockCode -> ()
rnf !BlockCode
_ = ()

data Bool_ =
    Alphabetic
  | ASCIIHexDigit
  -- ^ 0-9, A-F, a-f
  | BidiControl
  -- ^ Format controls which have specific functions in the Bidi Algorithm.
  | BidiMirrored
  -- ^ Characters that may change display in RTL text.
  | Dash
  -- ^ Variations of dashes.
  | DefaultIgnorable
  -- ^ Ignorable in most processing.
  | Deprecated
  -- ^ The usage of deprecated characters is strongly discouraged.
  | Diacritic
  -- ^ Characters that linguistically modify the meaning of another
  -- character to which they apply.
  | Extender
  -- ^ Extend the value or shape of a preceding alphabetic character,
  -- e.g. length and iteration marks.
  | FullCompositionExclusion
  | GraphemeBase
  -- ^ For programmatic determination of grapheme cluster boundaries.
  | GraphemeExtend
  -- ^ For programmatic determination of grapheme cluster boundaries.
  | GraphemeLink
  -- ^ For programmatic determination of grapheme cluster boundaries.
  | HexDigit
  -- ^ Characters commonly used for hexadecimal numbers.
  | Hyphen
  -- ^ Dashes used to mark connections between pieces of words, plus the
  -- Katakana middle dot.
  | IDContinue
  -- ^ Characters that can continue an identifier.
  | IDStart
  -- ^ Characters that can start an identifier.
  | Ideographic
  -- ^ CJKV ideographs.
  | IDSBinaryOperator
  -- ^ For programmatic determination of Ideographic Description Sequences.
  | IDSTrinaryOperator
  | JoinControl
  -- ^ Format controls for cursive joining and ligation.
  | LogicalOrderException
  -- ^ Characters that do not use logical order and require special handling
  -- in most processing.
  | Lowercase
  | Math
  | NonCharacter
  -- ^ Code points that are explicitly defined as illegal for the encoding
  -- of characters.
  | QuotationMark
  | Radical
  -- ^ For programmatic determination of Ideographic Description Sequences.
  | SoftDotted
  -- ^ Characters with a "soft dot", like i or j. An accent placed on these
  -- characters causes the dot to disappear.
  | TerminalPunctuation
  -- ^ Punctuation characters that generally mark the end of textual units.
  | UnifiedIdeograph
  -- ^ For programmatic determination of Ideographic Description Sequences.
  | Uppercase
  | WhiteSpace
  | XidContinue
  -- ^ 'IDContinue' modified to allow closure under normalization forms
  -- NFKC and NFKD.
  | XidStart
  -- ^ 'IDStart' modified to allow closure under normalization forms NFKC
  -- and NFKD.
  | CaseSensitive
  -- ^ Either the source of a case mapping or /in/ the target of a case
  -- mapping. Not the same as the general category @Cased_Letter@.
  | STerm
  -- ^ Sentence Terminal. Used in UAX #29: Text Boundaries
  -- <http://www.unicode.org/reports/tr29/>.
  | VariationSelector
  -- ^ Indicates all those characters that qualify as Variation
  -- Selectors. For details on the behavior of these characters, see
  -- <http://unicode.org/Public/UNIDATA/StandardizedVariants.html> and 15.6
  -- Variation Selectors.
  | NFDInert
  -- ^ ICU-specific property for characters that are inert under NFD, i.e.
  -- they do not interact with adjacent characters.  Used for example in
  -- normalizing transforms in incremental mode to find the boundary of
  -- safely normalizable text despite possible text additions.
  | NFKDInert
  -- ^ ICU-specific property for characters that are inert under NFKD, i.e.
  -- they do not interact with adjacent characters.
  | NFCInert
  -- ^ ICU-specific property for characters that are inert under NFC,
  -- i.e. they do not interact with adjacent characters.
  | NFKCInert
  -- ^ ICU-specific property for characters that are inert under NFKC,
  -- i.e. they do not interact with adjacent characters.
  | SegmentStarter
  -- ^ ICU-specific property for characters that are starters in terms of
  -- Unicode normalization and combining character sequences.
  | PatternSyntax
  -- ^ See UAX #31 Identifier and Pattern Syntax
  -- <http://www.unicode.org/reports/tr31/>.
  | PatternWhiteSpace
  -- ^ See UAX #31 Identifier and Pattern Syntax
  -- <http://www.unicode.org/reports/tr31/>.
  | POSIXAlNum
  -- ^ Alphanumeric character class.
  | POSIXBlank
  -- ^ Blank character class.
  | POSIXGraph
  -- ^ Graph character class.
  | POSIXPrint
  -- ^ Printable character class.
  | POSIXXDigit
  -- ^ Hex digit character class.
  | Cased
  -- ^ Cased character class. For lowercase, uppercase and titlecase characters.
  | CaseIgnorable
  -- ^ Used in context-sensitive case mappings.
  | ChangesWhenLowercased
  | ChangesWhenUppercased
  | ChangesWhenTitlecased
  | ChangesWhenCasefolded
  | ChangesWhenCasemapped
  | ChangesWhenNFKCCasefolded
  | Emoji -- ^ See http://www.unicode.org/reports/tr51/#Emoji_Properties
  | EmojiPresentation -- ^ See http://www.unicode.org/reports/tr51/#Emoji_Properties
  | EmojiModifier -- ^ See http://www.unicode.org/reports/tr51/#Emoji_Properties
  | EmojiModifierBase -- ^ See http://www.unicode.org/reports/tr51/#Emoji_Properties
  | EmojiComponent -- ^ See http://www.unicode.org/reports/tr51/#Emoji_Properties
  | RegionalIndicator
  | PrependedConcatenationMark
  | ExtendedPictographic
  deriving (Bool_ -> Bool_ -> Bool
(Bool_ -> Bool_ -> Bool) -> (Bool_ -> Bool_ -> Bool) -> Eq Bool_
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bool_ -> Bool_ -> Bool
$c/= :: Bool_ -> Bool_ -> Bool
== :: Bool_ -> Bool_ -> Bool
$c== :: Bool_ -> Bool_ -> Bool
Eq, Int -> Bool_
Bool_ -> Int
Bool_ -> [Bool_]
Bool_ -> Bool_
Bool_ -> Bool_ -> [Bool_]
Bool_ -> Bool_ -> Bool_ -> [Bool_]
(Bool_ -> Bool_)
-> (Bool_ -> Bool_)
-> (Int -> Bool_)
-> (Bool_ -> Int)
-> (Bool_ -> [Bool_])
-> (Bool_ -> Bool_ -> [Bool_])
-> (Bool_ -> Bool_ -> [Bool_])
-> (Bool_ -> Bool_ -> Bool_ -> [Bool_])
-> Enum Bool_
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Bool_ -> Bool_ -> Bool_ -> [Bool_]
$cenumFromThenTo :: Bool_ -> Bool_ -> Bool_ -> [Bool_]
enumFromTo :: Bool_ -> Bool_ -> [Bool_]
$cenumFromTo :: Bool_ -> Bool_ -> [Bool_]
enumFromThen :: Bool_ -> Bool_ -> [Bool_]
$cenumFromThen :: Bool_ -> Bool_ -> [Bool_]
enumFrom :: Bool_ -> [Bool_]
$cenumFrom :: Bool_ -> [Bool_]
fromEnum :: Bool_ -> Int
$cfromEnum :: Bool_ -> Int
toEnum :: Int -> Bool_
$ctoEnum :: Int -> Bool_
pred :: Bool_ -> Bool_
$cpred :: Bool_ -> Bool_
succ :: Bool_ -> Bool_
$csucc :: Bool_ -> Bool_
Enum, Int -> Bool_ -> ShowS
[Bool_] -> ShowS
Bool_ -> String
(Int -> Bool_ -> ShowS)
-> (Bool_ -> String) -> ([Bool_] -> ShowS) -> Show Bool_
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bool_] -> ShowS
$cshowList :: [Bool_] -> ShowS
show :: Bool_ -> String
$cshow :: Bool_ -> String
showsPrec :: Int -> Bool_ -> ShowS
$cshowsPrec :: Int -> Bool_ -> ShowS
Show, Typeable)

instance NFData Bool_ where
    rnf :: Bool_ -> ()
rnf !Bool_
_ = ()

class Property p v | p -> v where
    fromNative :: p -> Int32 -> v
    toUProperty :: p -> UProperty

data BidiClass_ = BidiClass deriving (Int -> BidiClass_ -> ShowS
[BidiClass_] -> ShowS
BidiClass_ -> String
(Int -> BidiClass_ -> ShowS)
-> (BidiClass_ -> String)
-> ([BidiClass_] -> ShowS)
-> Show BidiClass_
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BidiClass_] -> ShowS
$cshowList :: [BidiClass_] -> ShowS
show :: BidiClass_ -> String
$cshow :: BidiClass_ -> String
showsPrec :: Int -> BidiClass_ -> ShowS
$cshowsPrec :: Int -> BidiClass_ -> ShowS
Show, Typeable)

instance NFData BidiClass_ where
    rnf :: BidiClass_ -> ()
rnf !BidiClass_
_ = ()

instance Property BidiClass_ Direction where
    fromNative :: BidiClass_ -> Int32 -> Direction
fromNative BidiClass_
_  = Int -> Direction
forall a. Enum a => Int -> a
toEnum (Int -> Direction) -> (Int32 -> Int) -> Int32 -> Direction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toUProperty :: BidiClass_ -> UCharNameChoice
toUProperty BidiClass_
_ = (UCharNameChoice
4096)
{-# LINE 638 "Data/Text/ICU/Char.hsc" #-}

data Block_ = Block

instance NFData Block_ where
    rnf :: Block_ -> ()
rnf !Block_
_ = ()

instance Property Block_ BlockCode where
    fromNative :: Block_ -> Int32 -> BlockCode
fromNative Block_
_  = Int -> BlockCode
forall a. Enum a => Int -> a
toEnum (Int -> BlockCode) -> (Int32 -> Int) -> Int32 -> BlockCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toUProperty :: Block_ -> UCharNameChoice
toUProperty Block_
_ = (UCharNameChoice
4097)
{-# LINE 647 "Data/Text/ICU/Char.hsc" #-}

data CanonicalCombiningClass_ = CanonicalCombiningClass deriving (Int -> CanonicalCombiningClass_ -> ShowS
[CanonicalCombiningClass_] -> ShowS
CanonicalCombiningClass_ -> String
(Int -> CanonicalCombiningClass_ -> ShowS)
-> (CanonicalCombiningClass_ -> String)
-> ([CanonicalCombiningClass_] -> ShowS)
-> Show CanonicalCombiningClass_
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CanonicalCombiningClass_] -> ShowS
$cshowList :: [CanonicalCombiningClass_] -> ShowS
show :: CanonicalCombiningClass_ -> String
$cshow :: CanonicalCombiningClass_ -> String
showsPrec :: Int -> CanonicalCombiningClass_ -> ShowS
$cshowsPrec :: Int -> CanonicalCombiningClass_ -> ShowS
Show,Typeable)

instance NFData CanonicalCombiningClass_ where
    rnf :: CanonicalCombiningClass_ -> ()
rnf !CanonicalCombiningClass_
_ = ()

instance Property CanonicalCombiningClass_ Int where
    fromNative :: CanonicalCombiningClass_ -> Int32 -> Int
fromNative CanonicalCombiningClass_
_  = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toUProperty :: CanonicalCombiningClass_ -> UCharNameChoice
toUProperty CanonicalCombiningClass_
_ = (UCharNameChoice
4098)
{-# LINE 656 "Data/Text/ICU/Char.hsc" #-}

data Decomposition_ = Decomposition deriving (Int -> Decomposition_ -> ShowS
[Decomposition_] -> ShowS
Decomposition_ -> String
(Int -> Decomposition_ -> ShowS)
-> (Decomposition_ -> String)
-> ([Decomposition_] -> ShowS)
-> Show Decomposition_
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Decomposition_] -> ShowS
$cshowList :: [Decomposition_] -> ShowS
show :: Decomposition_ -> String
$cshow :: Decomposition_ -> String
showsPrec :: Int -> Decomposition_ -> ShowS
$cshowsPrec :: Int -> Decomposition_ -> ShowS
Show, Typeable)

instance NFData Decomposition_ where
    rnf :: Decomposition_ -> ()
rnf !Decomposition_
_ = ()

data Decomposition =
    Canonical
  | Compat
  | Circle
  | Final
  | Font
  | Fraction
  | Initial
  | Isolated
  | Medial
  | Narrow
  | NoBreak
  | Small
  | Square
  | Sub
  | Super
  | Vertical
  | Wide
  | Count
    deriving (Decomposition -> Decomposition -> Bool
(Decomposition -> Decomposition -> Bool)
-> (Decomposition -> Decomposition -> Bool) -> Eq Decomposition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Decomposition -> Decomposition -> Bool
$c/= :: Decomposition -> Decomposition -> Bool
== :: Decomposition -> Decomposition -> Bool
$c== :: Decomposition -> Decomposition -> Bool
Eq, Int -> Decomposition
Decomposition -> Int
Decomposition -> [Decomposition]
Decomposition -> Decomposition
Decomposition -> Decomposition -> [Decomposition]
Decomposition -> Decomposition -> Decomposition -> [Decomposition]
(Decomposition -> Decomposition)
-> (Decomposition -> Decomposition)
-> (Int -> Decomposition)
-> (Decomposition -> Int)
-> (Decomposition -> [Decomposition])
-> (Decomposition -> Decomposition -> [Decomposition])
-> (Decomposition -> Decomposition -> [Decomposition])
-> (Decomposition
    -> Decomposition -> Decomposition -> [Decomposition])
-> Enum Decomposition
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Decomposition -> Decomposition -> Decomposition -> [Decomposition]
$cenumFromThenTo :: Decomposition -> Decomposition -> Decomposition -> [Decomposition]
enumFromTo :: Decomposition -> Decomposition -> [Decomposition]
$cenumFromTo :: Decomposition -> Decomposition -> [Decomposition]
enumFromThen :: Decomposition -> Decomposition -> [Decomposition]
$cenumFromThen :: Decomposition -> Decomposition -> [Decomposition]
enumFrom :: Decomposition -> [Decomposition]
$cenumFrom :: Decomposition -> [Decomposition]
fromEnum :: Decomposition -> Int
$cfromEnum :: Decomposition -> Int
toEnum :: Int -> Decomposition
$ctoEnum :: Int -> Decomposition
pred :: Decomposition -> Decomposition
$cpred :: Decomposition -> Decomposition
succ :: Decomposition -> Decomposition
$csucc :: Decomposition -> Decomposition
Enum, Int -> Decomposition -> ShowS
[Decomposition] -> ShowS
Decomposition -> String
(Int -> Decomposition -> ShowS)
-> (Decomposition -> String)
-> ([Decomposition] -> ShowS)
-> Show Decomposition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Decomposition] -> ShowS
$cshowList :: [Decomposition] -> ShowS
show :: Decomposition -> String
$cshow :: Decomposition -> String
showsPrec :: Int -> Decomposition -> ShowS
$cshowsPrec :: Int -> Decomposition -> ShowS
Show, Typeable)

instance NFData Decomposition where
    rnf :: Decomposition -> ()
rnf !Decomposition
_ = ()

instance Property Decomposition_ (Maybe Decomposition) where
    fromNative :: Decomposition_ -> Int32 -> Maybe Decomposition
fromNative Decomposition_
_  = Int32 -> Maybe Decomposition
forall a. Enum a => Int32 -> Maybe a
maybeEnum
    toUProperty :: Decomposition_ -> UCharNameChoice
toUProperty Decomposition_
_ = (UCharNameChoice
4099)
{-# LINE 689 "Data/Text/ICU/Char.hsc" #-}

data EastAsianWidth_ = EastAsianWidth deriving (Int -> EastAsianWidth_ -> ShowS
[EastAsianWidth_] -> ShowS
EastAsianWidth_ -> String
(Int -> EastAsianWidth_ -> ShowS)
-> (EastAsianWidth_ -> String)
-> ([EastAsianWidth_] -> ShowS)
-> Show EastAsianWidth_
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EastAsianWidth_] -> ShowS
$cshowList :: [EastAsianWidth_] -> ShowS
show :: EastAsianWidth_ -> String
$cshow :: EastAsianWidth_ -> String
showsPrec :: Int -> EastAsianWidth_ -> ShowS
$cshowsPrec :: Int -> EastAsianWidth_ -> ShowS
Show, Typeable)

instance NFData EastAsianWidth_ where
    rnf :: EastAsianWidth_ -> ()
rnf !EastAsianWidth_
_ = ()

data EastAsianWidth = EANeutral
                    | EAAmbiguous
                    | EAHalf
                    | EAFull
                    | EANarrow
                    | EAWide
                    | EACount
                    deriving (EastAsianWidth -> EastAsianWidth -> Bool
(EastAsianWidth -> EastAsianWidth -> Bool)
-> (EastAsianWidth -> EastAsianWidth -> Bool) -> Eq EastAsianWidth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EastAsianWidth -> EastAsianWidth -> Bool
$c/= :: EastAsianWidth -> EastAsianWidth -> Bool
== :: EastAsianWidth -> EastAsianWidth -> Bool
$c== :: EastAsianWidth -> EastAsianWidth -> Bool
Eq, Int -> EastAsianWidth
EastAsianWidth -> Int
EastAsianWidth -> [EastAsianWidth]
EastAsianWidth -> EastAsianWidth
EastAsianWidth -> EastAsianWidth -> [EastAsianWidth]
EastAsianWidth
-> EastAsianWidth -> EastAsianWidth -> [EastAsianWidth]
(EastAsianWidth -> EastAsianWidth)
-> (EastAsianWidth -> EastAsianWidth)
-> (Int -> EastAsianWidth)
-> (EastAsianWidth -> Int)
-> (EastAsianWidth -> [EastAsianWidth])
-> (EastAsianWidth -> EastAsianWidth -> [EastAsianWidth])
-> (EastAsianWidth -> EastAsianWidth -> [EastAsianWidth])
-> (EastAsianWidth
    -> EastAsianWidth -> EastAsianWidth -> [EastAsianWidth])
-> Enum EastAsianWidth
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: EastAsianWidth
-> EastAsianWidth -> EastAsianWidth -> [EastAsianWidth]
$cenumFromThenTo :: EastAsianWidth
-> EastAsianWidth -> EastAsianWidth -> [EastAsianWidth]
enumFromTo :: EastAsianWidth -> EastAsianWidth -> [EastAsianWidth]
$cenumFromTo :: EastAsianWidth -> EastAsianWidth -> [EastAsianWidth]
enumFromThen :: EastAsianWidth -> EastAsianWidth -> [EastAsianWidth]
$cenumFromThen :: EastAsianWidth -> EastAsianWidth -> [EastAsianWidth]
enumFrom :: EastAsianWidth -> [EastAsianWidth]
$cenumFrom :: EastAsianWidth -> [EastAsianWidth]
fromEnum :: EastAsianWidth -> Int
$cfromEnum :: EastAsianWidth -> Int
toEnum :: Int -> EastAsianWidth
$ctoEnum :: Int -> EastAsianWidth
pred :: EastAsianWidth -> EastAsianWidth
$cpred :: EastAsianWidth -> EastAsianWidth
succ :: EastAsianWidth -> EastAsianWidth
$csucc :: EastAsianWidth -> EastAsianWidth
Enum, Int -> EastAsianWidth -> ShowS
[EastAsianWidth] -> ShowS
EastAsianWidth -> String
(Int -> EastAsianWidth -> ShowS)
-> (EastAsianWidth -> String)
-> ([EastAsianWidth] -> ShowS)
-> Show EastAsianWidth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EastAsianWidth] -> ShowS
$cshowList :: [EastAsianWidth] -> ShowS
show :: EastAsianWidth -> String
$cshow :: EastAsianWidth -> String
showsPrec :: Int -> EastAsianWidth -> ShowS
$cshowsPrec :: Int -> EastAsianWidth -> ShowS
Show, Typeable)

instance NFData EastAsianWidth where
    rnf :: EastAsianWidth -> ()
rnf !EastAsianWidth
_ = ()

instance Property EastAsianWidth_ EastAsianWidth where
    fromNative :: EastAsianWidth_ -> Int32 -> EastAsianWidth
fromNative EastAsianWidth_
_  = Int -> EastAsianWidth
forall a. Enum a => Int -> a
toEnum (Int -> EastAsianWidth)
-> (Int32 -> Int) -> Int32 -> EastAsianWidth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toUProperty :: EastAsianWidth_ -> UCharNameChoice
toUProperty EastAsianWidth_
_ = (UCharNameChoice
4100)
{-# LINE 710 "Data/Text/ICU/Char.hsc" #-}

instance Property Bool_ Bool where
    fromNative :: Bool_ -> Int32 -> Bool
fromNative Bool_
_ = (Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
/=Int32
0)
    toUProperty :: Bool_ -> UCharNameChoice
toUProperty  = Int -> UCharNameChoice
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UCharNameChoice)
-> (Bool_ -> Int) -> Bool_ -> UCharNameChoice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool_ -> Int
forall a. Enum a => a -> Int
fromEnum

data GeneralCategory_ = GeneralCategory deriving (Int -> GeneralCategory_ -> ShowS
[GeneralCategory_] -> ShowS
GeneralCategory_ -> String
(Int -> GeneralCategory_ -> ShowS)
-> (GeneralCategory_ -> String)
-> ([GeneralCategory_] -> ShowS)
-> Show GeneralCategory_
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GeneralCategory_] -> ShowS
$cshowList :: [GeneralCategory_] -> ShowS
show :: GeneralCategory_ -> String
$cshow :: GeneralCategory_ -> String
showsPrec :: Int -> GeneralCategory_ -> ShowS
$cshowsPrec :: Int -> GeneralCategory_ -> ShowS
Show, Typeable)

instance NFData GeneralCategory_ where
    rnf :: GeneralCategory_ -> ()
rnf !GeneralCategory_
_ = ()

data GeneralCategory =
    GeneralOtherType -- ^ U_GENERAL_OTHER_TYPES is the same as U_UNASSIGNED
  | UppercaseLetter
  | LowercaseLetter
  | TitlecaseLetter
  | ModifierLetter
  | OtherLetter
  | NonSpacingMark
  | EnclosingMark
  | CombiningSpacingMark
  | DecimalDigitNumber
  | LetterNumber
  | OtherNumber
  | SpaceSeparator
  | LineSeparator
  | ParagraphSeparator
  | ControlChar
  | FormatChar
  | PrivateUseChar
  | Surrogate
  | DashPunctuation
  | StartPunctuation
  | EndPunctuation
  | ConnectorPunctuation
  | OtherPunctuation
  | MathSymbol
  | CurrencySymbol
  | ModifierSymbol
  | OtherSymbol
  | InitialPunctuation
  | FinalPunctuation
    deriving (GeneralCategory -> GeneralCategory -> Bool
(GeneralCategory -> GeneralCategory -> Bool)
-> (GeneralCategory -> GeneralCategory -> Bool)
-> Eq GeneralCategory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GeneralCategory -> GeneralCategory -> Bool
$c/= :: GeneralCategory -> GeneralCategory -> Bool
== :: GeneralCategory -> GeneralCategory -> Bool
$c== :: GeneralCategory -> GeneralCategory -> Bool
Eq, Int -> GeneralCategory
GeneralCategory -> Int
GeneralCategory -> [GeneralCategory]
GeneralCategory -> GeneralCategory
GeneralCategory -> GeneralCategory -> [GeneralCategory]
GeneralCategory
-> GeneralCategory -> GeneralCategory -> [GeneralCategory]
(GeneralCategory -> GeneralCategory)
-> (GeneralCategory -> GeneralCategory)
-> (Int -> GeneralCategory)
-> (GeneralCategory -> Int)
-> (GeneralCategory -> [GeneralCategory])
-> (GeneralCategory -> GeneralCategory -> [GeneralCategory])
-> (GeneralCategory -> GeneralCategory -> [GeneralCategory])
-> (GeneralCategory
    -> GeneralCategory -> GeneralCategory -> [GeneralCategory])
-> Enum GeneralCategory
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GeneralCategory
-> GeneralCategory -> GeneralCategory -> [GeneralCategory]
$cenumFromThenTo :: GeneralCategory
-> GeneralCategory -> GeneralCategory -> [GeneralCategory]
enumFromTo :: GeneralCategory -> GeneralCategory -> [GeneralCategory]
$cenumFromTo :: GeneralCategory -> GeneralCategory -> [GeneralCategory]
enumFromThen :: GeneralCategory -> GeneralCategory -> [GeneralCategory]
$cenumFromThen :: GeneralCategory -> GeneralCategory -> [GeneralCategory]
enumFrom :: GeneralCategory -> [GeneralCategory]
$cenumFrom :: GeneralCategory -> [GeneralCategory]
fromEnum :: GeneralCategory -> Int
$cfromEnum :: GeneralCategory -> Int
toEnum :: Int -> GeneralCategory
$ctoEnum :: Int -> GeneralCategory
pred :: GeneralCategory -> GeneralCategory
$cpred :: GeneralCategory -> GeneralCategory
succ :: GeneralCategory -> GeneralCategory
$csucc :: GeneralCategory -> GeneralCategory
Enum, Int -> GeneralCategory -> ShowS
[GeneralCategory] -> ShowS
GeneralCategory -> String
(Int -> GeneralCategory -> ShowS)
-> (GeneralCategory -> String)
-> ([GeneralCategory] -> ShowS)
-> Show GeneralCategory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GeneralCategory] -> ShowS
$cshowList :: [GeneralCategory] -> ShowS
show :: GeneralCategory -> String
$cshow :: GeneralCategory -> String
showsPrec :: Int -> GeneralCategory -> ShowS
$cshowsPrec :: Int -> GeneralCategory -> ShowS
Show, Typeable)

instance NFData GeneralCategory where
    rnf :: GeneralCategory -> ()
rnf !GeneralCategory
_ = ()

instance Property GeneralCategory_ GeneralCategory where
    fromNative :: GeneralCategory_ -> Int32 -> GeneralCategory
fromNative GeneralCategory_
_  = Int -> GeneralCategory
forall a. Enum a => Int -> a
toEnum (Int -> GeneralCategory)
-> (Int32 -> Int) -> Int32 -> GeneralCategory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toUProperty :: GeneralCategory_ -> UCharNameChoice
toUProperty GeneralCategory_
_ = (UCharNameChoice
4101)
{-# LINE 759 "Data/Text/ICU/Char.hsc" #-}

data JoiningGroup_ = JoiningGroup deriving (Int -> JoiningGroup_ -> ShowS
[JoiningGroup_] -> ShowS
JoiningGroup_ -> String
(Int -> JoiningGroup_ -> ShowS)
-> (JoiningGroup_ -> String)
-> ([JoiningGroup_] -> ShowS)
-> Show JoiningGroup_
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JoiningGroup_] -> ShowS
$cshowList :: [JoiningGroup_] -> ShowS
show :: JoiningGroup_ -> String
$cshow :: JoiningGroup_ -> String
showsPrec :: Int -> JoiningGroup_ -> ShowS
$cshowsPrec :: Int -> JoiningGroup_ -> ShowS
Show, Typeable)

instance NFData JoiningGroup_ where
    rnf :: JoiningGroup_ -> ()
rnf !JoiningGroup_
_ = ()

maybeEnum :: Enum a => Int32 -> Maybe a
maybeEnum :: forall a. Enum a => Int32 -> Maybe a
maybeEnum Int32
0 = Maybe a
forall a. Maybe a
Nothing
maybeEnum Int32
n = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$! Int -> a
forall a. Enum a => Int -> a
toEnum (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

data JoiningGroup =
    Ain
  | Alaph
  | Alef
  | Beh
  | Beth
  | Dal
  | DalathRish
  | E
  | Feh
  | FinalSemkath
  | Gaf
  | Gamal
  | Hah
  | HamzaOnHehGoal
  | He
  | Heh
  | HehGoal
  | Heth
  | Kaf
  | Kaph
  | KnottedHeh
  | Lam
  | Lamadh
  | Meem
  | Mim
  | Noon
  | Nun
  | Pe
  | Qaf
  | Qaph
  | Reh
  | ReversedPe
  | Sad
  | Sadhe
  | Seen
  | Semkath
  | Shin
  | SwashKaf
  | SyriacWaw
  | Tah
  | Taw
  | TehMarbuta
  | Teth
  | Waw
  | Yeh
  | YehBarree
  | YehWithTail
  | Yudh
  | YudhHe
  | Zain
  | Fe
  | Khaph
  | Zhain
  | BurushaskiYehBarree
  | FarsiYeh
  | Nya
  | RohingyaYeh
  | ManichaeanAleph
  | ManichaeanAyin
  | ManichaeanBeth
  | ManichaeanDaleth
  | ManichaeanDhamedh
  | ManichaeanFive
  | ManichaeanGimel
  | ManichaeanHeth
  | ManichaeanHundred
  | ManichaeanKaph
  | ManichaeanLamedh
  | ManichaeanMem
  | ManichaeanNun
  | ManichaeanOne
  | ManichaeanPe
  | ManichaeanQoph
  | ManichaeanResh
  | ManichaeanSadhe
  | ManichaeanSamekh
  | ManichaeanTaw
  | ManichaeanTen
  | ManichaeanTeth
  | ManichaeanThamedh
  | ManichaeanTwenty
  | ManichaeanWaw
  | ManichaeanYodh
  | ManichaeanZayin
  | StraightWaw
    deriving (JoiningGroup -> JoiningGroup -> Bool
(JoiningGroup -> JoiningGroup -> Bool)
-> (JoiningGroup -> JoiningGroup -> Bool) -> Eq JoiningGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JoiningGroup -> JoiningGroup -> Bool
$c/= :: JoiningGroup -> JoiningGroup -> Bool
== :: JoiningGroup -> JoiningGroup -> Bool
$c== :: JoiningGroup -> JoiningGroup -> Bool
Eq, Int -> JoiningGroup
JoiningGroup -> Int
JoiningGroup -> [JoiningGroup]
JoiningGroup -> JoiningGroup
JoiningGroup -> JoiningGroup -> [JoiningGroup]
JoiningGroup -> JoiningGroup -> JoiningGroup -> [JoiningGroup]
(JoiningGroup -> JoiningGroup)
-> (JoiningGroup -> JoiningGroup)
-> (Int -> JoiningGroup)
-> (JoiningGroup -> Int)
-> (JoiningGroup -> [JoiningGroup])
-> (JoiningGroup -> JoiningGroup -> [JoiningGroup])
-> (JoiningGroup -> JoiningGroup -> [JoiningGroup])
-> (JoiningGroup -> JoiningGroup -> JoiningGroup -> [JoiningGroup])
-> Enum JoiningGroup
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: JoiningGroup -> JoiningGroup -> JoiningGroup -> [JoiningGroup]
$cenumFromThenTo :: JoiningGroup -> JoiningGroup -> JoiningGroup -> [JoiningGroup]
enumFromTo :: JoiningGroup -> JoiningGroup -> [JoiningGroup]
$cenumFromTo :: JoiningGroup -> JoiningGroup -> [JoiningGroup]
enumFromThen :: JoiningGroup -> JoiningGroup -> [JoiningGroup]
$cenumFromThen :: JoiningGroup -> JoiningGroup -> [JoiningGroup]
enumFrom :: JoiningGroup -> [JoiningGroup]
$cenumFrom :: JoiningGroup -> [JoiningGroup]
fromEnum :: JoiningGroup -> Int
$cfromEnum :: JoiningGroup -> Int
toEnum :: Int -> JoiningGroup
$ctoEnum :: Int -> JoiningGroup
pred :: JoiningGroup -> JoiningGroup
$cpred :: JoiningGroup -> JoiningGroup
succ :: JoiningGroup -> JoiningGroup
$csucc :: JoiningGroup -> JoiningGroup
Enum, Int -> JoiningGroup -> ShowS
[JoiningGroup] -> ShowS
JoiningGroup -> String
(Int -> JoiningGroup -> ShowS)
-> (JoiningGroup -> String)
-> ([JoiningGroup] -> ShowS)
-> Show JoiningGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JoiningGroup] -> ShowS
$cshowList :: [JoiningGroup] -> ShowS
show :: JoiningGroup -> String
$cshow :: JoiningGroup -> String
showsPrec :: Int -> JoiningGroup -> ShowS
$cshowsPrec :: Int -> JoiningGroup -> ShowS
Show, Typeable)

instance NFData JoiningGroup where
    rnf :: JoiningGroup -> ()
rnf !JoiningGroup
_ = ()

instance Property JoiningGroup_ (Maybe JoiningGroup) where
    fromNative :: JoiningGroup_ -> Int32 -> Maybe JoiningGroup
fromNative JoiningGroup_
_  = Int32 -> Maybe JoiningGroup
forall a. Enum a => Int32 -> Maybe a
maybeEnum
    toUProperty :: JoiningGroup_ -> UCharNameChoice
toUProperty JoiningGroup_
_ = (UCharNameChoice
4102)
{-# LINE 863 "Data/Text/ICU/Char.hsc" #-}

data JoiningType_ = JoiningType deriving (Int -> JoiningType_ -> ShowS
[JoiningType_] -> ShowS
JoiningType_ -> String
(Int -> JoiningType_ -> ShowS)
-> (JoiningType_ -> String)
-> ([JoiningType_] -> ShowS)
-> Show JoiningType_
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JoiningType_] -> ShowS
$cshowList :: [JoiningType_] -> ShowS
show :: JoiningType_ -> String
$cshow :: JoiningType_ -> String
showsPrec :: Int -> JoiningType_ -> ShowS
$cshowsPrec :: Int -> JoiningType_ -> ShowS
Show, Typeable)

instance NFData JoiningType_ where
    rnf :: JoiningType_ -> ()
rnf !JoiningType_
_ = ()

data JoiningType =
    JoinCausing
  | DualJoining
  | LeftJoining
  | RightJoining
  | Transparent
    deriving (JoiningType -> JoiningType -> Bool
(JoiningType -> JoiningType -> Bool)
-> (JoiningType -> JoiningType -> Bool) -> Eq JoiningType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JoiningType -> JoiningType -> Bool
$c/= :: JoiningType -> JoiningType -> Bool
== :: JoiningType -> JoiningType -> Bool
$c== :: JoiningType -> JoiningType -> Bool
Eq, Int -> JoiningType
JoiningType -> Int
JoiningType -> [JoiningType]
JoiningType -> JoiningType
JoiningType -> JoiningType -> [JoiningType]
JoiningType -> JoiningType -> JoiningType -> [JoiningType]
(JoiningType -> JoiningType)
-> (JoiningType -> JoiningType)
-> (Int -> JoiningType)
-> (JoiningType -> Int)
-> (JoiningType -> [JoiningType])
-> (JoiningType -> JoiningType -> [JoiningType])
-> (JoiningType -> JoiningType -> [JoiningType])
-> (JoiningType -> JoiningType -> JoiningType -> [JoiningType])
-> Enum JoiningType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: JoiningType -> JoiningType -> JoiningType -> [JoiningType]
$cenumFromThenTo :: JoiningType -> JoiningType -> JoiningType -> [JoiningType]
enumFromTo :: JoiningType -> JoiningType -> [JoiningType]
$cenumFromTo :: JoiningType -> JoiningType -> [JoiningType]
enumFromThen :: JoiningType -> JoiningType -> [JoiningType]
$cenumFromThen :: JoiningType -> JoiningType -> [JoiningType]
enumFrom :: JoiningType -> [JoiningType]
$cenumFrom :: JoiningType -> [JoiningType]
fromEnum :: JoiningType -> Int
$cfromEnum :: JoiningType -> Int
toEnum :: Int -> JoiningType
$ctoEnum :: Int -> JoiningType
pred :: JoiningType -> JoiningType
$cpred :: JoiningType -> JoiningType
succ :: JoiningType -> JoiningType
$csucc :: JoiningType -> JoiningType
Enum, Int -> JoiningType -> ShowS
[JoiningType] -> ShowS
JoiningType -> String
(Int -> JoiningType -> ShowS)
-> (JoiningType -> String)
-> ([JoiningType] -> ShowS)
-> Show JoiningType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JoiningType] -> ShowS
$cshowList :: [JoiningType] -> ShowS
show :: JoiningType -> String
$cshow :: JoiningType -> String
showsPrec :: Int -> JoiningType -> ShowS
$cshowsPrec :: Int -> JoiningType -> ShowS
Show, Typeable)

instance NFData JoiningType where
    rnf :: JoiningType -> ()
rnf !JoiningType
_ = ()

instance Property JoiningType_ (Maybe JoiningType) where
    fromNative :: JoiningType_ -> Int32 -> Maybe JoiningType
fromNative JoiningType_
_  = Int32 -> Maybe JoiningType
forall a. Enum a => Int32 -> Maybe a
maybeEnum
    toUProperty :: JoiningType_ -> UCharNameChoice
toUProperty JoiningType_
_ = (UCharNameChoice
4103)
{-# LINE 883 "Data/Text/ICU/Char.hsc" #-}

data LineBreak_ = LineBreak deriving (Int -> LineBreak_ -> ShowS
[LineBreak_] -> ShowS
LineBreak_ -> String
(Int -> LineBreak_ -> ShowS)
-> (LineBreak_ -> String)
-> ([LineBreak_] -> ShowS)
-> Show LineBreak_
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineBreak_] -> ShowS
$cshowList :: [LineBreak_] -> ShowS
show :: LineBreak_ -> String
$cshow :: LineBreak_ -> String
showsPrec :: Int -> LineBreak_ -> ShowS
$cshowsPrec :: Int -> LineBreak_ -> ShowS
Show, Typeable)

instance NFData LineBreak_ where
    rnf :: LineBreak_ -> ()
rnf !LineBreak_
_ = ()

data LineBreak =
    Ambiguous
  | LBAlphabetic
  | BreakBoth
  | BreakAfter
  | BreakBefore
  | MandatoryBreak
  | ContingentBreak
  | ClosePunctuation
  | CombiningMark
  | CarriageReturn
  | Exclamation
  | Glue
  | LBHyphen
  | LBIdeographic
  | Inseparable
  | InfixNumeric
  | LineFeed
  | Nonstarter
  | Numeric
  | OpenPunctuation
  | PostfixNumeric
  | PrefixNumeric
  | Quotation
  | ComplexContext
  | LBSurrogate
  | Space
  | BreakSymbols
  | Zwspace
  | NextLine
  | WordJoiner
  | H2
  | H3
  | JL
  | JT
  | JV
  | CloseParenthesis
  | ConditionalJapaneseStarter
  | LBHebrewLetter
  | LBRegionalIndicator
  | EBase
  | EModifier
  | ZWJ
    deriving (LineBreak -> LineBreak -> Bool
(LineBreak -> LineBreak -> Bool)
-> (LineBreak -> LineBreak -> Bool) -> Eq LineBreak
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineBreak -> LineBreak -> Bool
$c/= :: LineBreak -> LineBreak -> Bool
== :: LineBreak -> LineBreak -> Bool
$c== :: LineBreak -> LineBreak -> Bool
Eq, Int -> LineBreak
LineBreak -> Int
LineBreak -> [LineBreak]
LineBreak -> LineBreak
LineBreak -> LineBreak -> [LineBreak]
LineBreak -> LineBreak -> LineBreak -> [LineBreak]
(LineBreak -> LineBreak)
-> (LineBreak -> LineBreak)
-> (Int -> LineBreak)
-> (LineBreak -> Int)
-> (LineBreak -> [LineBreak])
-> (LineBreak -> LineBreak -> [LineBreak])
-> (LineBreak -> LineBreak -> [LineBreak])
-> (LineBreak -> LineBreak -> LineBreak -> [LineBreak])
-> Enum LineBreak
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LineBreak -> LineBreak -> LineBreak -> [LineBreak]
$cenumFromThenTo :: LineBreak -> LineBreak -> LineBreak -> [LineBreak]
enumFromTo :: LineBreak -> LineBreak -> [LineBreak]
$cenumFromTo :: LineBreak -> LineBreak -> [LineBreak]
enumFromThen :: LineBreak -> LineBreak -> [LineBreak]
$cenumFromThen :: LineBreak -> LineBreak -> [LineBreak]
enumFrom :: LineBreak -> [LineBreak]
$cenumFrom :: LineBreak -> [LineBreak]
fromEnum :: LineBreak -> Int
$cfromEnum :: LineBreak -> Int
toEnum :: Int -> LineBreak
$ctoEnum :: Int -> LineBreak
pred :: LineBreak -> LineBreak
$cpred :: LineBreak -> LineBreak
succ :: LineBreak -> LineBreak
$csucc :: LineBreak -> LineBreak
Enum, Int -> LineBreak -> ShowS
[LineBreak] -> ShowS
LineBreak -> String
(Int -> LineBreak -> ShowS)
-> (LineBreak -> String)
-> ([LineBreak] -> ShowS)
-> Show LineBreak
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineBreak] -> ShowS
$cshowList :: [LineBreak] -> ShowS
show :: LineBreak -> String
$cshow :: LineBreak -> String
showsPrec :: Int -> LineBreak -> ShowS
$cshowsPrec :: Int -> LineBreak -> ShowS
Show, Typeable)

instance NFData LineBreak where
    rnf :: LineBreak -> ()
rnf !LineBreak
_ = ()

instance Property LineBreak_ (Maybe LineBreak) where
    fromNative :: LineBreak_ -> Int32 -> Maybe LineBreak
fromNative LineBreak_
_  = Int32 -> Maybe LineBreak
forall a. Enum a => Int32 -> Maybe a
maybeEnum
    toUProperty :: LineBreak_ -> UCharNameChoice
toUProperty LineBreak_
_ = (UCharNameChoice
4104)
{-# LINE 940 "Data/Text/ICU/Char.hsc" #-}

data NumericType_ = NumericType deriving (Int -> NumericType_ -> ShowS
[NumericType_] -> ShowS
NumericType_ -> String
(Int -> NumericType_ -> ShowS)
-> (NumericType_ -> String)
-> ([NumericType_] -> ShowS)
-> Show NumericType_
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NumericType_] -> ShowS
$cshowList :: [NumericType_] -> ShowS
show :: NumericType_ -> String
$cshow :: NumericType_ -> String
showsPrec :: Int -> NumericType_ -> ShowS
$cshowsPrec :: Int -> NumericType_ -> ShowS
Show, Typeable)

instance NFData NumericType_ where
    rnf :: NumericType_ -> ()
rnf !NumericType_
_ = ()

data NumericType = NTDecimal | NTDigit | NTNumeric
                   deriving (NumericType -> NumericType -> Bool
(NumericType -> NumericType -> Bool)
-> (NumericType -> NumericType -> Bool) -> Eq NumericType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumericType -> NumericType -> Bool
$c/= :: NumericType -> NumericType -> Bool
== :: NumericType -> NumericType -> Bool
$c== :: NumericType -> NumericType -> Bool
Eq, Int -> NumericType
NumericType -> Int
NumericType -> [NumericType]
NumericType -> NumericType
NumericType -> NumericType -> [NumericType]
NumericType -> NumericType -> NumericType -> [NumericType]
(NumericType -> NumericType)
-> (NumericType -> NumericType)
-> (Int -> NumericType)
-> (NumericType -> Int)
-> (NumericType -> [NumericType])
-> (NumericType -> NumericType -> [NumericType])
-> (NumericType -> NumericType -> [NumericType])
-> (NumericType -> NumericType -> NumericType -> [NumericType])
-> Enum NumericType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NumericType -> NumericType -> NumericType -> [NumericType]
$cenumFromThenTo :: NumericType -> NumericType -> NumericType -> [NumericType]
enumFromTo :: NumericType -> NumericType -> [NumericType]
$cenumFromTo :: NumericType -> NumericType -> [NumericType]
enumFromThen :: NumericType -> NumericType -> [NumericType]
$cenumFromThen :: NumericType -> NumericType -> [NumericType]
enumFrom :: NumericType -> [NumericType]
$cenumFrom :: NumericType -> [NumericType]
fromEnum :: NumericType -> Int
$cfromEnum :: NumericType -> Int
toEnum :: Int -> NumericType
$ctoEnum :: Int -> NumericType
pred :: NumericType -> NumericType
$cpred :: NumericType -> NumericType
succ :: NumericType -> NumericType
$csucc :: NumericType -> NumericType
Enum, Int -> NumericType -> ShowS
[NumericType] -> ShowS
NumericType -> String
(Int -> NumericType -> ShowS)
-> (NumericType -> String)
-> ([NumericType] -> ShowS)
-> Show NumericType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NumericType] -> ShowS
$cshowList :: [NumericType] -> ShowS
show :: NumericType -> String
$cshow :: NumericType -> String
showsPrec :: Int -> NumericType -> ShowS
$cshowsPrec :: Int -> NumericType -> ShowS
Show, Typeable)

instance NFData NumericType where
    rnf :: NumericType -> ()
rnf !NumericType
_ = ()

instance Property NumericType_ (Maybe NumericType) where
    fromNative :: NumericType_ -> Int32 -> Maybe NumericType
fromNative NumericType_
_  = Int32 -> Maybe NumericType
forall a. Enum a => Int32 -> Maybe a
maybeEnum
    toUProperty :: NumericType_ -> UCharNameChoice
toUProperty NumericType_
_ = (UCharNameChoice
4105)
{-# LINE 955 "Data/Text/ICU/Char.hsc" #-}

data HangulSyllableType_ = HangulSyllableType deriving (Int -> HangulSyllableType_ -> ShowS
[HangulSyllableType_] -> ShowS
HangulSyllableType_ -> String
(Int -> HangulSyllableType_ -> ShowS)
-> (HangulSyllableType_ -> String)
-> ([HangulSyllableType_] -> ShowS)
-> Show HangulSyllableType_
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HangulSyllableType_] -> ShowS
$cshowList :: [HangulSyllableType_] -> ShowS
show :: HangulSyllableType_ -> String
$cshow :: HangulSyllableType_ -> String
showsPrec :: Int -> HangulSyllableType_ -> ShowS
$cshowsPrec :: Int -> HangulSyllableType_ -> ShowS
Show, Typeable)

instance NFData HangulSyllableType_ where
    rnf :: HangulSyllableType_ -> ()
rnf !HangulSyllableType_
_ = ()

data HangulSyllableType =
    LeadingJamo
  | VowelJamo
  | TrailingJamo
  | LVSyllable
  | LVTSyllable
    deriving (HangulSyllableType -> HangulSyllableType -> Bool
(HangulSyllableType -> HangulSyllableType -> Bool)
-> (HangulSyllableType -> HangulSyllableType -> Bool)
-> Eq HangulSyllableType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HangulSyllableType -> HangulSyllableType -> Bool
$c/= :: HangulSyllableType -> HangulSyllableType -> Bool
== :: HangulSyllableType -> HangulSyllableType -> Bool
$c== :: HangulSyllableType -> HangulSyllableType -> Bool
Eq, Int -> HangulSyllableType
HangulSyllableType -> Int
HangulSyllableType -> [HangulSyllableType]
HangulSyllableType -> HangulSyllableType
HangulSyllableType -> HangulSyllableType -> [HangulSyllableType]
HangulSyllableType
-> HangulSyllableType -> HangulSyllableType -> [HangulSyllableType]
(HangulSyllableType -> HangulSyllableType)
-> (HangulSyllableType -> HangulSyllableType)
-> (Int -> HangulSyllableType)
-> (HangulSyllableType -> Int)
-> (HangulSyllableType -> [HangulSyllableType])
-> (HangulSyllableType
    -> HangulSyllableType -> [HangulSyllableType])
-> (HangulSyllableType
    -> HangulSyllableType -> [HangulSyllableType])
-> (HangulSyllableType
    -> HangulSyllableType
    -> HangulSyllableType
    -> [HangulSyllableType])
-> Enum HangulSyllableType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: HangulSyllableType
-> HangulSyllableType -> HangulSyllableType -> [HangulSyllableType]
$cenumFromThenTo :: HangulSyllableType
-> HangulSyllableType -> HangulSyllableType -> [HangulSyllableType]
enumFromTo :: HangulSyllableType -> HangulSyllableType -> [HangulSyllableType]
$cenumFromTo :: HangulSyllableType -> HangulSyllableType -> [HangulSyllableType]
enumFromThen :: HangulSyllableType -> HangulSyllableType -> [HangulSyllableType]
$cenumFromThen :: HangulSyllableType -> HangulSyllableType -> [HangulSyllableType]
enumFrom :: HangulSyllableType -> [HangulSyllableType]
$cenumFrom :: HangulSyllableType -> [HangulSyllableType]
fromEnum :: HangulSyllableType -> Int
$cfromEnum :: HangulSyllableType -> Int
toEnum :: Int -> HangulSyllableType
$ctoEnum :: Int -> HangulSyllableType
pred :: HangulSyllableType -> HangulSyllableType
$cpred :: HangulSyllableType -> HangulSyllableType
succ :: HangulSyllableType -> HangulSyllableType
$csucc :: HangulSyllableType -> HangulSyllableType
Enum, Int -> HangulSyllableType -> ShowS
[HangulSyllableType] -> ShowS
HangulSyllableType -> String
(Int -> HangulSyllableType -> ShowS)
-> (HangulSyllableType -> String)
-> ([HangulSyllableType] -> ShowS)
-> Show HangulSyllableType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HangulSyllableType] -> ShowS
$cshowList :: [HangulSyllableType] -> ShowS
show :: HangulSyllableType -> String
$cshow :: HangulSyllableType -> String
showsPrec :: Int -> HangulSyllableType -> ShowS
$cshowsPrec :: Int -> HangulSyllableType -> ShowS
Show, Typeable)

instance NFData HangulSyllableType where
    rnf :: HangulSyllableType -> ()
rnf !HangulSyllableType
_ = ()

instance Property HangulSyllableType_ (Maybe HangulSyllableType) where
    fromNative :: HangulSyllableType_ -> Int32 -> Maybe HangulSyllableType
fromNative HangulSyllableType_
_  = Int32 -> Maybe HangulSyllableType
forall a. Enum a => Int32 -> Maybe a
maybeEnum
    toUProperty :: HangulSyllableType_ -> UCharNameChoice
toUProperty HangulSyllableType_
_ = (UCharNameChoice
4107)
{-# LINE 975 "Data/Text/ICU/Char.hsc" #-}

data NFCQuickCheck_ = NFCQuickCheck deriving (Int -> NFCQuickCheck_ -> ShowS
[NFCQuickCheck_] -> ShowS
NFCQuickCheck_ -> String
(Int -> NFCQuickCheck_ -> ShowS)
-> (NFCQuickCheck_ -> String)
-> ([NFCQuickCheck_] -> ShowS)
-> Show NFCQuickCheck_
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NFCQuickCheck_] -> ShowS
$cshowList :: [NFCQuickCheck_] -> ShowS
show :: NFCQuickCheck_ -> String
$cshow :: NFCQuickCheck_ -> String
showsPrec :: Int -> NFCQuickCheck_ -> ShowS
$cshowsPrec :: Int -> NFCQuickCheck_ -> ShowS
Show, Typeable)
data NFDQuickCheck_ = NFDQuickCheck deriving (Int -> NFDQuickCheck_ -> ShowS
[NFDQuickCheck_] -> ShowS
NFDQuickCheck_ -> String
(Int -> NFDQuickCheck_ -> ShowS)
-> (NFDQuickCheck_ -> String)
-> ([NFDQuickCheck_] -> ShowS)
-> Show NFDQuickCheck_
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NFDQuickCheck_] -> ShowS
$cshowList :: [NFDQuickCheck_] -> ShowS
show :: NFDQuickCheck_ -> String
$cshow :: NFDQuickCheck_ -> String
showsPrec :: Int -> NFDQuickCheck_ -> ShowS
$cshowsPrec :: Int -> NFDQuickCheck_ -> ShowS
Show, Typeable)
data NFKCQuickCheck_ = NFKCQuickCheck deriving (Int -> NFKCQuickCheck_ -> ShowS
[NFKCQuickCheck_] -> ShowS
NFKCQuickCheck_ -> String
(Int -> NFKCQuickCheck_ -> ShowS)
-> (NFKCQuickCheck_ -> String)
-> ([NFKCQuickCheck_] -> ShowS)
-> Show NFKCQuickCheck_
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NFKCQuickCheck_] -> ShowS
$cshowList :: [NFKCQuickCheck_] -> ShowS
show :: NFKCQuickCheck_ -> String
$cshow :: NFKCQuickCheck_ -> String
showsPrec :: Int -> NFKCQuickCheck_ -> ShowS
$cshowsPrec :: Int -> NFKCQuickCheck_ -> ShowS
Show, Typeable)
data NFKDQuickCheck_ = NFKDQuickCheck deriving (Int -> NFKDQuickCheck_ -> ShowS
[NFKDQuickCheck_] -> ShowS
NFKDQuickCheck_ -> String
(Int -> NFKDQuickCheck_ -> ShowS)
-> (NFKDQuickCheck_ -> String)
-> ([NFKDQuickCheck_] -> ShowS)
-> Show NFKDQuickCheck_
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NFKDQuickCheck_] -> ShowS
$cshowList :: [NFKDQuickCheck_] -> ShowS
show :: NFKDQuickCheck_ -> String
$cshow :: NFKDQuickCheck_ -> String
showsPrec :: Int -> NFKDQuickCheck_ -> ShowS
$cshowsPrec :: Int -> NFKDQuickCheck_ -> ShowS
Show, Typeable)

instance NFData NFCQuickCheck_ where
    rnf :: NFCQuickCheck_ -> ()
rnf !NFCQuickCheck_
_ = ()

instance NFData NFDQuickCheck_ where
    rnf :: NFDQuickCheck_ -> ()
rnf !NFDQuickCheck_
_ = ()

instance NFData NFKCQuickCheck_ where
    rnf :: NFKCQuickCheck_ -> ()
rnf !NFKCQuickCheck_
_ = ()

instance NFData NFKDQuickCheck_ where
    rnf :: NFKDQuickCheck_ -> ()
rnf !NFKDQuickCheck_
_ = ()

instance Property NFCQuickCheck_ (Maybe Bool) where
    fromNative :: NFCQuickCheck_ -> Int32 -> Maybe Bool
fromNative  NFCQuickCheck_
_ = UCharNameChoice -> Maybe Bool
toNCR (UCharNameChoice -> Maybe Bool)
-> (Int32 -> UCharNameChoice) -> Int32 -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> UCharNameChoice
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toUProperty :: NFCQuickCheck_ -> UCharNameChoice
toUProperty NFCQuickCheck_
_ = (UCharNameChoice
4110)
{-# LINE 996 "Data/Text/ICU/Char.hsc" #-}

instance Property NFDQuickCheck_ (Maybe Bool) where
    fromNative :: NFDQuickCheck_ -> Int32 -> Maybe Bool
fromNative  NFDQuickCheck_
_ = UCharNameChoice -> Maybe Bool
toNCR (UCharNameChoice -> Maybe Bool)
-> (Int32 -> UCharNameChoice) -> Int32 -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> UCharNameChoice
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toUProperty :: NFDQuickCheck_ -> UCharNameChoice
toUProperty NFDQuickCheck_
_ = (UCharNameChoice
4108)
{-# LINE 1000 "Data/Text/ICU/Char.hsc" #-}

instance Property NFKCQuickCheck_ (Maybe Bool) where
    fromNative :: NFKCQuickCheck_ -> Int32 -> Maybe Bool
fromNative  NFKCQuickCheck_
_ = UCharNameChoice -> Maybe Bool
toNCR (UCharNameChoice -> Maybe Bool)
-> (Int32 -> UCharNameChoice) -> Int32 -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> UCharNameChoice
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toUProperty :: NFKCQuickCheck_ -> UCharNameChoice
toUProperty NFKCQuickCheck_
_ = (UCharNameChoice
4111)
{-# LINE 1004 "Data/Text/ICU/Char.hsc" #-}

instance Property NFKDQuickCheck_ (Maybe Bool) where
    fromNative :: NFKDQuickCheck_ -> Int32 -> Maybe Bool
fromNative  NFKDQuickCheck_
_ = UCharNameChoice -> Maybe Bool
toNCR (UCharNameChoice -> Maybe Bool)
-> (Int32 -> UCharNameChoice) -> Int32 -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> UCharNameChoice
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toUProperty :: NFKDQuickCheck_ -> UCharNameChoice
toUProperty NFKDQuickCheck_
_ = (UCharNameChoice
4109)
{-# LINE 1008 "Data/Text/ICU/Char.hsc" #-}

data LeadCanonicalCombiningClass_ = LeadCanonicalCombiningClass
                                    deriving (Int -> LeadCanonicalCombiningClass_ -> ShowS
[LeadCanonicalCombiningClass_] -> ShowS
LeadCanonicalCombiningClass_ -> String
(Int -> LeadCanonicalCombiningClass_ -> ShowS)
-> (LeadCanonicalCombiningClass_ -> String)
-> ([LeadCanonicalCombiningClass_] -> ShowS)
-> Show LeadCanonicalCombiningClass_
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LeadCanonicalCombiningClass_] -> ShowS
$cshowList :: [LeadCanonicalCombiningClass_] -> ShowS
show :: LeadCanonicalCombiningClass_ -> String
$cshow :: LeadCanonicalCombiningClass_ -> String
showsPrec :: Int -> LeadCanonicalCombiningClass_ -> ShowS
$cshowsPrec :: Int -> LeadCanonicalCombiningClass_ -> ShowS
Show, Typeable)

instance NFData LeadCanonicalCombiningClass_ where
    rnf :: LeadCanonicalCombiningClass_ -> ()
rnf !LeadCanonicalCombiningClass_
_ = ()

instance Property LeadCanonicalCombiningClass_ Int where
    fromNative :: LeadCanonicalCombiningClass_ -> Int32 -> Int
fromNative  LeadCanonicalCombiningClass_
_ = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toUProperty :: LeadCanonicalCombiningClass_ -> UCharNameChoice
toUProperty LeadCanonicalCombiningClass_
_ = (UCharNameChoice
4112)
{-# LINE 1018 "Data/Text/ICU/Char.hsc" #-}

data TrailingCanonicalCombiningClass_ = TrailingCanonicalCombiningClass
                                   deriving (Int -> TrailingCanonicalCombiningClass_ -> ShowS
[TrailingCanonicalCombiningClass_] -> ShowS
TrailingCanonicalCombiningClass_ -> String
(Int -> TrailingCanonicalCombiningClass_ -> ShowS)
-> (TrailingCanonicalCombiningClass_ -> String)
-> ([TrailingCanonicalCombiningClass_] -> ShowS)
-> Show TrailingCanonicalCombiningClass_
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TrailingCanonicalCombiningClass_] -> ShowS
$cshowList :: [TrailingCanonicalCombiningClass_] -> ShowS
show :: TrailingCanonicalCombiningClass_ -> String
$cshow :: TrailingCanonicalCombiningClass_ -> String
showsPrec :: Int -> TrailingCanonicalCombiningClass_ -> ShowS
$cshowsPrec :: Int -> TrailingCanonicalCombiningClass_ -> ShowS
Show, Typeable)

instance NFData TrailingCanonicalCombiningClass_ where
    rnf :: TrailingCanonicalCombiningClass_ -> ()
rnf !TrailingCanonicalCombiningClass_
_ = ()

instance Property TrailingCanonicalCombiningClass_ Int where
    fromNative :: TrailingCanonicalCombiningClass_ -> Int32 -> Int
fromNative  TrailingCanonicalCombiningClass_
_ = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toUProperty :: TrailingCanonicalCombiningClass_ -> UCharNameChoice
toUProperty TrailingCanonicalCombiningClass_
_ = (UCharNameChoice
4113)
{-# LINE 1028 "Data/Text/ICU/Char.hsc" #-}

data GraphemeClusterBreak_ = GraphemeClusterBreak deriving (Int -> GraphemeClusterBreak_ -> ShowS
[GraphemeClusterBreak_] -> ShowS
GraphemeClusterBreak_ -> String
(Int -> GraphemeClusterBreak_ -> ShowS)
-> (GraphemeClusterBreak_ -> String)
-> ([GraphemeClusterBreak_] -> ShowS)
-> Show GraphemeClusterBreak_
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GraphemeClusterBreak_] -> ShowS
$cshowList :: [GraphemeClusterBreak_] -> ShowS
show :: GraphemeClusterBreak_ -> String
$cshow :: GraphemeClusterBreak_ -> String
showsPrec :: Int -> GraphemeClusterBreak_ -> ShowS
$cshowsPrec :: Int -> GraphemeClusterBreak_ -> ShowS
Show, Typeable)

instance NFData GraphemeClusterBreak_ where
    rnf :: GraphemeClusterBreak_ -> ()
rnf !GraphemeClusterBreak_
_ = ()

data GraphemeClusterBreak =
    GCBControl
  | GCBCR
  | GCBExtend
  | GCBL
  | GCBLF
  | GCBLV
  | GCBLVT
  | GCBT
  | GCBV
  | GCBSpacingMark
  | GCBPrepend
  | GCBRegionalIndicator
  | GCBEBase
  | GCBEBaseGAZ
  | GCBEModifier
  | GCBGlueAfterZWJ
  | GCBZWJ
    deriving (GraphemeClusterBreak -> GraphemeClusterBreak -> Bool
(GraphemeClusterBreak -> GraphemeClusterBreak -> Bool)
-> (GraphemeClusterBreak -> GraphemeClusterBreak -> Bool)
-> Eq GraphemeClusterBreak
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GraphemeClusterBreak -> GraphemeClusterBreak -> Bool
$c/= :: GraphemeClusterBreak -> GraphemeClusterBreak -> Bool
== :: GraphemeClusterBreak -> GraphemeClusterBreak -> Bool
$c== :: GraphemeClusterBreak -> GraphemeClusterBreak -> Bool
Eq, Int -> GraphemeClusterBreak
GraphemeClusterBreak -> Int
GraphemeClusterBreak -> [GraphemeClusterBreak]
GraphemeClusterBreak -> GraphemeClusterBreak
GraphemeClusterBreak
-> GraphemeClusterBreak -> [GraphemeClusterBreak]
GraphemeClusterBreak
-> GraphemeClusterBreak
-> GraphemeClusterBreak
-> [GraphemeClusterBreak]
(GraphemeClusterBreak -> GraphemeClusterBreak)
-> (GraphemeClusterBreak -> GraphemeClusterBreak)
-> (Int -> GraphemeClusterBreak)
-> (GraphemeClusterBreak -> Int)
-> (GraphemeClusterBreak -> [GraphemeClusterBreak])
-> (GraphemeClusterBreak
    -> GraphemeClusterBreak -> [GraphemeClusterBreak])
-> (GraphemeClusterBreak
    -> GraphemeClusterBreak -> [GraphemeClusterBreak])
-> (GraphemeClusterBreak
    -> GraphemeClusterBreak
    -> GraphemeClusterBreak
    -> [GraphemeClusterBreak])
-> Enum GraphemeClusterBreak
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GraphemeClusterBreak
-> GraphemeClusterBreak
-> GraphemeClusterBreak
-> [GraphemeClusterBreak]
$cenumFromThenTo :: GraphemeClusterBreak
-> GraphemeClusterBreak
-> GraphemeClusterBreak
-> [GraphemeClusterBreak]
enumFromTo :: GraphemeClusterBreak
-> GraphemeClusterBreak -> [GraphemeClusterBreak]
$cenumFromTo :: GraphemeClusterBreak
-> GraphemeClusterBreak -> [GraphemeClusterBreak]
enumFromThen :: GraphemeClusterBreak
-> GraphemeClusterBreak -> [GraphemeClusterBreak]
$cenumFromThen :: GraphemeClusterBreak
-> GraphemeClusterBreak -> [GraphemeClusterBreak]
enumFrom :: GraphemeClusterBreak -> [GraphemeClusterBreak]
$cenumFrom :: GraphemeClusterBreak -> [GraphemeClusterBreak]
fromEnum :: GraphemeClusterBreak -> Int
$cfromEnum :: GraphemeClusterBreak -> Int
toEnum :: Int -> GraphemeClusterBreak
$ctoEnum :: Int -> GraphemeClusterBreak
pred :: GraphemeClusterBreak -> GraphemeClusterBreak
$cpred :: GraphemeClusterBreak -> GraphemeClusterBreak
succ :: GraphemeClusterBreak -> GraphemeClusterBreak
$csucc :: GraphemeClusterBreak -> GraphemeClusterBreak
Enum, Int -> GraphemeClusterBreak -> ShowS
[GraphemeClusterBreak] -> ShowS
GraphemeClusterBreak -> String
(Int -> GraphemeClusterBreak -> ShowS)
-> (GraphemeClusterBreak -> String)
-> ([GraphemeClusterBreak] -> ShowS)
-> Show GraphemeClusterBreak
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GraphemeClusterBreak] -> ShowS
$cshowList :: [GraphemeClusterBreak] -> ShowS
show :: GraphemeClusterBreak -> String
$cshow :: GraphemeClusterBreak -> String
showsPrec :: Int -> GraphemeClusterBreak -> ShowS
$cshowsPrec :: Int -> GraphemeClusterBreak -> ShowS
Show, Typeable)

instance NFData GraphemeClusterBreak where
    rnf :: GraphemeClusterBreak -> ()
rnf !GraphemeClusterBreak
_ = ()

instance Property GraphemeClusterBreak_ (Maybe GraphemeClusterBreak) where
    fromNative :: GraphemeClusterBreak_ -> Int32 -> Maybe GraphemeClusterBreak
fromNative  GraphemeClusterBreak_
_ = Int32 -> Maybe GraphemeClusterBreak
forall a. Enum a => Int32 -> Maybe a
maybeEnum
    toUProperty :: GraphemeClusterBreak_ -> UCharNameChoice
toUProperty GraphemeClusterBreak_
_ = (UCharNameChoice
4114)
{-# LINE 1060 "Data/Text/ICU/Char.hsc" #-}

data SentenceBreak_ = SentenceBreak deriving (Int -> SentenceBreak_ -> ShowS
[SentenceBreak_] -> ShowS
SentenceBreak_ -> String
(Int -> SentenceBreak_ -> ShowS)
-> (SentenceBreak_ -> String)
-> ([SentenceBreak_] -> ShowS)
-> Show SentenceBreak_
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SentenceBreak_] -> ShowS
$cshowList :: [SentenceBreak_] -> ShowS
show :: SentenceBreak_ -> String
$cshow :: SentenceBreak_ -> String
showsPrec :: Int -> SentenceBreak_ -> ShowS
$cshowsPrec :: Int -> SentenceBreak_ -> ShowS
Show, Typeable)

instance NFData SentenceBreak_ where
    rnf :: SentenceBreak_ -> ()
rnf !SentenceBreak_
_ = ()

data SentenceBreak =
    SBATerm
  | SBClose
  | SBFormat
  | SBLower
  | SBNumeric
  | SBOLetter
  | SBSep
  | SBSP
  | SBSTerm
  | SBUpper
  | SBCR
  | SBExtend
  | SBLF
  | SBSContinue
    deriving (SentenceBreak -> SentenceBreak -> Bool
(SentenceBreak -> SentenceBreak -> Bool)
-> (SentenceBreak -> SentenceBreak -> Bool) -> Eq SentenceBreak
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SentenceBreak -> SentenceBreak -> Bool
$c/= :: SentenceBreak -> SentenceBreak -> Bool
== :: SentenceBreak -> SentenceBreak -> Bool
$c== :: SentenceBreak -> SentenceBreak -> Bool
Eq, Int -> SentenceBreak
SentenceBreak -> Int
SentenceBreak -> [SentenceBreak]
SentenceBreak -> SentenceBreak
SentenceBreak -> SentenceBreak -> [SentenceBreak]
SentenceBreak -> SentenceBreak -> SentenceBreak -> [SentenceBreak]
(SentenceBreak -> SentenceBreak)
-> (SentenceBreak -> SentenceBreak)
-> (Int -> SentenceBreak)
-> (SentenceBreak -> Int)
-> (SentenceBreak -> [SentenceBreak])
-> (SentenceBreak -> SentenceBreak -> [SentenceBreak])
-> (SentenceBreak -> SentenceBreak -> [SentenceBreak])
-> (SentenceBreak
    -> SentenceBreak -> SentenceBreak -> [SentenceBreak])
-> Enum SentenceBreak
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SentenceBreak -> SentenceBreak -> SentenceBreak -> [SentenceBreak]
$cenumFromThenTo :: SentenceBreak -> SentenceBreak -> SentenceBreak -> [SentenceBreak]
enumFromTo :: SentenceBreak -> SentenceBreak -> [SentenceBreak]
$cenumFromTo :: SentenceBreak -> SentenceBreak -> [SentenceBreak]
enumFromThen :: SentenceBreak -> SentenceBreak -> [SentenceBreak]
$cenumFromThen :: SentenceBreak -> SentenceBreak -> [SentenceBreak]
enumFrom :: SentenceBreak -> [SentenceBreak]
$cenumFrom :: SentenceBreak -> [SentenceBreak]
fromEnum :: SentenceBreak -> Int
$cfromEnum :: SentenceBreak -> Int
toEnum :: Int -> SentenceBreak
$ctoEnum :: Int -> SentenceBreak
pred :: SentenceBreak -> SentenceBreak
$cpred :: SentenceBreak -> SentenceBreak
succ :: SentenceBreak -> SentenceBreak
$csucc :: SentenceBreak -> SentenceBreak
Enum, Int -> SentenceBreak -> ShowS
[SentenceBreak] -> ShowS
SentenceBreak -> String
(Int -> SentenceBreak -> ShowS)
-> (SentenceBreak -> String)
-> ([SentenceBreak] -> ShowS)
-> Show SentenceBreak
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SentenceBreak] -> ShowS
$cshowList :: [SentenceBreak] -> ShowS
show :: SentenceBreak -> String
$cshow :: SentenceBreak -> String
showsPrec :: Int -> SentenceBreak -> ShowS
$cshowsPrec :: Int -> SentenceBreak -> ShowS
Show, Typeable)

instance NFData SentenceBreak where
    rnf :: SentenceBreak -> ()
rnf !SentenceBreak
_ = ()

instance Property SentenceBreak_ (Maybe SentenceBreak) where
    fromNative :: SentenceBreak_ -> Int32 -> Maybe SentenceBreak
fromNative  SentenceBreak_
_ = Int32 -> Maybe SentenceBreak
forall a. Enum a => Int32 -> Maybe a
maybeEnum
    toUProperty :: SentenceBreak_ -> UCharNameChoice
toUProperty SentenceBreak_
_ = (UCharNameChoice
4115)
{-# LINE 1089 "Data/Text/ICU/Char.hsc" #-}

data WordBreak_ = WordBreak deriving (Int -> WordBreak_ -> ShowS
[WordBreak_] -> ShowS
WordBreak_ -> String
(Int -> WordBreak_ -> ShowS)
-> (WordBreak_ -> String)
-> ([WordBreak_] -> ShowS)
-> Show WordBreak_
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WordBreak_] -> ShowS
$cshowList :: [WordBreak_] -> ShowS
show :: WordBreak_ -> String
$cshow :: WordBreak_ -> String
showsPrec :: Int -> WordBreak_ -> ShowS
$cshowsPrec :: Int -> WordBreak_ -> ShowS
Show, Typeable)

instance NFData WordBreak_ where
    rnf :: WordBreak_ -> ()
rnf !WordBreak_
_ = ()

data WordBreak =
    WBALetter
  | WBFormat
  | WBKatakana
  | WBMidLetter
  | WBMidNum
  | WBNumeric
  | WBExtendNumLet
  | WBCR
  | WBExtend
  | WBLF
  | WBMidNumLet
  | WBNewline
  | WBRegionalIndicator
  | WBHebrewLetter
  | WBSingleQuote
  | WBDoubleQuote
    deriving (WordBreak -> WordBreak -> Bool
(WordBreak -> WordBreak -> Bool)
-> (WordBreak -> WordBreak -> Bool) -> Eq WordBreak
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WordBreak -> WordBreak -> Bool
$c/= :: WordBreak -> WordBreak -> Bool
== :: WordBreak -> WordBreak -> Bool
$c== :: WordBreak -> WordBreak -> Bool
Eq, Int -> WordBreak
WordBreak -> Int
WordBreak -> [WordBreak]
WordBreak -> WordBreak
WordBreak -> WordBreak -> [WordBreak]
WordBreak -> WordBreak -> WordBreak -> [WordBreak]
(WordBreak -> WordBreak)
-> (WordBreak -> WordBreak)
-> (Int -> WordBreak)
-> (WordBreak -> Int)
-> (WordBreak -> [WordBreak])
-> (WordBreak -> WordBreak -> [WordBreak])
-> (WordBreak -> WordBreak -> [WordBreak])
-> (WordBreak -> WordBreak -> WordBreak -> [WordBreak])
-> Enum WordBreak
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: WordBreak -> WordBreak -> WordBreak -> [WordBreak]
$cenumFromThenTo :: WordBreak -> WordBreak -> WordBreak -> [WordBreak]
enumFromTo :: WordBreak -> WordBreak -> [WordBreak]
$cenumFromTo :: WordBreak -> WordBreak -> [WordBreak]
enumFromThen :: WordBreak -> WordBreak -> [WordBreak]
$cenumFromThen :: WordBreak -> WordBreak -> [WordBreak]
enumFrom :: WordBreak -> [WordBreak]
$cenumFrom :: WordBreak -> [WordBreak]
fromEnum :: WordBreak -> Int
$cfromEnum :: WordBreak -> Int
toEnum :: Int -> WordBreak
$ctoEnum :: Int -> WordBreak
pred :: WordBreak -> WordBreak
$cpred :: WordBreak -> WordBreak
succ :: WordBreak -> WordBreak
$csucc :: WordBreak -> WordBreak
Enum, Int -> WordBreak -> ShowS
[WordBreak] -> ShowS
WordBreak -> String
(Int -> WordBreak -> ShowS)
-> (WordBreak -> String)
-> ([WordBreak] -> ShowS)
-> Show WordBreak
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WordBreak] -> ShowS
$cshowList :: [WordBreak] -> ShowS
show :: WordBreak -> String
$cshow :: WordBreak -> String
showsPrec :: Int -> WordBreak -> ShowS
$cshowsPrec :: Int -> WordBreak -> ShowS
Show, Typeable)

instance NFData WordBreak where
    rnf :: WordBreak -> ()
rnf !WordBreak
_ = ()

instance Property WordBreak_ (Maybe WordBreak) where
    fromNative :: WordBreak_ -> Int32 -> Maybe WordBreak
fromNative  WordBreak_
_ = Int32 -> Maybe WordBreak
forall a. Enum a => Int32 -> Maybe a
maybeEnum
    toUProperty :: WordBreak_ -> UCharNameChoice
toUProperty WordBreak_
_ = (UCharNameChoice
4116)
{-# LINE 1120 "Data/Text/ICU/Char.hsc" #-}

data BidiPairedBracketType_ = BidiPairedBracketType deriving (Int -> BidiPairedBracketType_ -> ShowS
[BidiPairedBracketType_] -> ShowS
BidiPairedBracketType_ -> String
(Int -> BidiPairedBracketType_ -> ShowS)
-> (BidiPairedBracketType_ -> String)
-> ([BidiPairedBracketType_] -> ShowS)
-> Show BidiPairedBracketType_
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BidiPairedBracketType_] -> ShowS
$cshowList :: [BidiPairedBracketType_] -> ShowS
show :: BidiPairedBracketType_ -> String
$cshow :: BidiPairedBracketType_ -> String
showsPrec :: Int -> BidiPairedBracketType_ -> ShowS
$cshowsPrec :: Int -> BidiPairedBracketType_ -> ShowS
Show, Typeable)

instance NFData BidiPairedBracketType_ where
    rnf :: BidiPairedBracketType_ -> ()
rnf !BidiPairedBracketType_
_ = ()

data BidiPairedBracketType =
    BPTNone
  | BPTOpen
  | BPTClose
    deriving (BidiPairedBracketType -> BidiPairedBracketType -> Bool
(BidiPairedBracketType -> BidiPairedBracketType -> Bool)
-> (BidiPairedBracketType -> BidiPairedBracketType -> Bool)
-> Eq BidiPairedBracketType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BidiPairedBracketType -> BidiPairedBracketType -> Bool
$c/= :: BidiPairedBracketType -> BidiPairedBracketType -> Bool
== :: BidiPairedBracketType -> BidiPairedBracketType -> Bool
$c== :: BidiPairedBracketType -> BidiPairedBracketType -> Bool
Eq, Int -> BidiPairedBracketType
BidiPairedBracketType -> Int
BidiPairedBracketType -> [BidiPairedBracketType]
BidiPairedBracketType -> BidiPairedBracketType
BidiPairedBracketType
-> BidiPairedBracketType -> [BidiPairedBracketType]
BidiPairedBracketType
-> BidiPairedBracketType
-> BidiPairedBracketType
-> [BidiPairedBracketType]
(BidiPairedBracketType -> BidiPairedBracketType)
-> (BidiPairedBracketType -> BidiPairedBracketType)
-> (Int -> BidiPairedBracketType)
-> (BidiPairedBracketType -> Int)
-> (BidiPairedBracketType -> [BidiPairedBracketType])
-> (BidiPairedBracketType
    -> BidiPairedBracketType -> [BidiPairedBracketType])
-> (BidiPairedBracketType
    -> BidiPairedBracketType -> [BidiPairedBracketType])
-> (BidiPairedBracketType
    -> BidiPairedBracketType
    -> BidiPairedBracketType
    -> [BidiPairedBracketType])
-> Enum BidiPairedBracketType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BidiPairedBracketType
-> BidiPairedBracketType
-> BidiPairedBracketType
-> [BidiPairedBracketType]
$cenumFromThenTo :: BidiPairedBracketType
-> BidiPairedBracketType
-> BidiPairedBracketType
-> [BidiPairedBracketType]
enumFromTo :: BidiPairedBracketType
-> BidiPairedBracketType -> [BidiPairedBracketType]
$cenumFromTo :: BidiPairedBracketType
-> BidiPairedBracketType -> [BidiPairedBracketType]
enumFromThen :: BidiPairedBracketType
-> BidiPairedBracketType -> [BidiPairedBracketType]
$cenumFromThen :: BidiPairedBracketType
-> BidiPairedBracketType -> [BidiPairedBracketType]
enumFrom :: BidiPairedBracketType -> [BidiPairedBracketType]
$cenumFrom :: BidiPairedBracketType -> [BidiPairedBracketType]
fromEnum :: BidiPairedBracketType -> Int
$cfromEnum :: BidiPairedBracketType -> Int
toEnum :: Int -> BidiPairedBracketType
$ctoEnum :: Int -> BidiPairedBracketType
pred :: BidiPairedBracketType -> BidiPairedBracketType
$cpred :: BidiPairedBracketType -> BidiPairedBracketType
succ :: BidiPairedBracketType -> BidiPairedBracketType
$csucc :: BidiPairedBracketType -> BidiPairedBracketType
Enum, Int -> BidiPairedBracketType -> ShowS
[BidiPairedBracketType] -> ShowS
BidiPairedBracketType -> String
(Int -> BidiPairedBracketType -> ShowS)
-> (BidiPairedBracketType -> String)
-> ([BidiPairedBracketType] -> ShowS)
-> Show BidiPairedBracketType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BidiPairedBracketType] -> ShowS
$cshowList :: [BidiPairedBracketType] -> ShowS
show :: BidiPairedBracketType -> String
$cshow :: BidiPairedBracketType -> String
showsPrec :: Int -> BidiPairedBracketType -> ShowS
$cshowsPrec :: Int -> BidiPairedBracketType -> ShowS
Show, Typeable)

instance NFData BidiPairedBracketType where
    rnf :: BidiPairedBracketType -> ()
rnf !BidiPairedBracketType
_ = ()

instance Property BidiPairedBracketType_ (Maybe BidiPairedBracketType) where
    fromNative :: BidiPairedBracketType_ -> Int32 -> Maybe BidiPairedBracketType
fromNative  BidiPairedBracketType_
_ = Int32 -> Maybe BidiPairedBracketType
forall a. Enum a => Int32 -> Maybe a
maybeEnum
    toUProperty :: BidiPairedBracketType_ -> UCharNameChoice
toUProperty BidiPairedBracketType_
_ = (UCharNameChoice
4117)
{-# LINE 1138 "Data/Text/ICU/Char.hsc" #-}

property :: Property p v => p -> Char -> v
property :: forall p v. Property p v => p -> Char -> v
property p
p Char
c = p -> Int32 -> v
forall p v. Property p v => p -> Int32 -> v
fromNative p
p (Int32 -> v) -> (p -> Int32) -> p -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UChar32 -> UCharNameChoice -> Int32
u_getIntPropertyValue (Int -> UChar32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c)) (UCharNameChoice -> Int32) -> (p -> UCharNameChoice) -> p -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               p -> UCharNameChoice
forall p v. Property p v => p -> UCharNameChoice
toUProperty (p -> v) -> p -> v
forall a b. (a -> b) -> a -> b
$ p
p
{-# INLINE property #-}

-- | Return the Unicode allocation block that contains the given
-- character.
blockCode :: Char -> BlockCode
blockCode :: Char -> BlockCode
blockCode = Int -> BlockCode
forall a. Enum a => Int -> a
toEnum (Int -> BlockCode) -> (Char -> Int) -> Char -> BlockCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UCharNameChoice -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UCharNameChoice -> Int)
-> (Char -> UCharNameChoice) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UChar32 -> UCharNameChoice
ublock_getCode (UChar32 -> UCharNameChoice)
-> (Char -> UChar32) -> Char -> UCharNameChoice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> UChar32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UChar32) -> (Char -> Int) -> Char -> UChar32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
{-# INLINE blockCode #-}

-- | Return the bidirectional category value for the code point,
-- which is used in the Unicode bidirectional algorithm (UAX #9
-- <http://www.unicode.org/reports/tr9/>).
direction :: Char -> Direction
direction :: Char -> Direction
direction = Int -> Direction
forall a. Enum a => Int -> a
toEnum (Int -> Direction) -> (Char -> Int) -> Char -> Direction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UCharNameChoice -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UCharNameChoice -> Int)
-> (Char -> UCharNameChoice) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UChar32 -> UCharNameChoice
u_charDirection (UChar32 -> UCharNameChoice)
-> (Char -> UChar32) -> Char -> UCharNameChoice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> UChar32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UChar32) -> (Char -> Int) -> Char -> UChar32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
{-# INLINE direction #-}

-- | Determine whether the code point has the 'BidiMirrored' property.  This
-- property is set for characters that are commonly used in Right-To-Left
-- contexts and need to be displayed with a "mirrored" glyph.
isMirrored :: Char -> Bool
isMirrored :: Char -> Bool
isMirrored = UBool -> Bool
forall a. Integral a => a -> Bool
asBool (UBool -> Bool) -> (Char -> UBool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UChar32 -> UBool
u_isMirrored (UChar32 -> UBool) -> (Char -> UChar32) -> Char -> UBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> UChar32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UChar32) -> (Char -> Int) -> Char -> UChar32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
{-# INLINE isMirrored #-}

-- Map the specified character to a "mirror-image" character.
--
-- For characters with the 'BidiMirrored' property, implementations
-- sometimes need a "poor man's" mapping to another Unicode (code point)
-- such that the default glyph may serve as the mirror image of the default
-- glyph of the specified character. This is useful for text conversion to
-- and from codepages with visual order, and for displays without glyph
-- selection capabilities.
--
-- The return value is another Unicode code point that may serve as a
-- mirror-image substitute, or the original character itself if there
-- is no such mapping or the character lacks the 'BidiMirrored'
-- property.
mirror :: Char -> Char
mirror :: Char -> Char
mirror = Int -> Char
chr (Int -> Char) -> (Char -> Int) -> Char -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UChar32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UChar32 -> Int) -> (Char -> UChar32) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UChar32 -> UChar32
u_charMirror (UChar32 -> UChar32) -> (Char -> UChar32) -> Char -> UChar32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> UChar32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UChar32) -> (Char -> Int) -> Char -> UChar32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
{-# INLINE mirror #-}

combiningClass :: Char -> Int
combiningClass :: Char -> Int
combiningClass = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> (Char -> Word8) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UChar32 -> Word8
u_getCombiningClass (UChar32 -> Word8) -> (Char -> UChar32) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> UChar32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UChar32) -> (Char -> Int) -> Char -> UChar32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
{-# INLINE combiningClass #-}

-- | Return the decimal digit value of a decimal digit character.
-- Such characters have the general category @Nd@ (decimal digit
-- numbers) and a 'NumericType' of 'NTDecimal'.
--
-- No digit values are returned for any Han characters, because Han
-- number characters are often used with a special Chinese-style
-- number format (with characters for powers of 10 in between) instead
-- of in decimal-positional notation.  Unicode 4 explicitly assigns
-- Han number characters a 'NumericType' of 'NTNumeric' instead of
-- 'NTDecimal'.
digitToInt :: Char -> Maybe Int
digitToInt :: Char -> Maybe Int
digitToInt Char
c
    | Int32
i Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== -Int32
1   = Maybe Int
forall a. Maybe a
Nothing
    | Bool
otherwise = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$! Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i
  where i :: Int32
i = UChar32 -> Int32
u_charDigitValue (UChar32 -> Int32) -> (Char -> UChar32) -> Char -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> UChar32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UChar32) -> (Char -> Int) -> Char -> UChar32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord (Char -> Int32) -> Char -> Int32
forall a b. (a -> b) -> a -> b
$ Char
c

-- | Return the numeric value for a Unicode code point as defined in the
-- Unicode Character Database.
--
-- A 'Double' return type is necessary because some numeric values are
-- fractions, negative, or too large to fit in a fixed-width integral type.
numericValue :: Char -> Maybe Double
numericValue :: Char -> Maybe Double
numericValue Char
c
    | Double
v Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== (-Double
123456789) = Maybe Double
forall a. Maybe a
Nothing
{-# LINE 1209 "Data/Text/ICU/Char.hsc" #-}
    | otherwise                        = Just v
    where v :: Double
v = UChar32 -> Double
u_getNumericValue (UChar32 -> Double) -> (Char -> UChar32) -> Char -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> UChar32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UChar32) -> (Char -> Int) -> Char -> UChar32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord (Char -> Double) -> Char -> Double
forall a b. (a -> b) -> a -> b
$ Char
c

-- | Return the name of a Unicode character.
--
-- The names of all unassigned characters are empty.
--
-- The name contains only "invariant" characters like A-Z, 0-9, space,
-- and \'-\'.
charName :: Char -> String
charName :: Char -> String
charName = UCharNameChoice -> Char -> String
charName' (UCharNameChoice
0)
{-# LINE 1220 "Data/Text/ICU/Char.hsc" #-}

-- | Return the full name of a Unicode character.
--
-- Compared to 'charName', this function gives each Unicode code point
-- a unique extended name. Extended names are lowercase followed by an
-- uppercase hexadecimal number, within angle brackets.
charFullName :: Char -> String
charFullName :: Char -> String
charFullName = UCharNameChoice -> Char -> String
charName' (UCharNameChoice
2)
{-# LINE 1228 "Data/Text/ICU/Char.hsc" #-}

-- | Find a Unicode character by its full name, and return its code
-- point value.
--
-- The name is matched exactly and completely.
--
-- A Unicode 1.0 name is matched only if it differs from the modern
-- name.  Unicode names are all uppercase.
charFromName :: String -> Maybe Char
charFromName :: String -> Maybe Char
charFromName = UCharNameChoice -> String -> Maybe Char
charFromName' (UCharNameChoice
0)
{-# LINE 1238 "Data/Text/ICU/Char.hsc" #-}

-- | Find a Unicode character by its full or extended name, and return
-- its code point value.
--
-- The name is matched exactly and completely.
--
-- A Unicode 1.0 name is matched only if it differs from the modern
-- name.
--
-- Compared to 'charFromName', this function gives each Unicode code
-- point a unique extended name. Extended names are lowercase followed
-- by an uppercase hexadecimal number, within angle brackets.
charFromFullName :: String -> Maybe Char
charFromFullName :: String -> Maybe Char
charFromFullName = UCharNameChoice -> String -> Maybe Char
charFromName' (UCharNameChoice
2)
{-# LINE 1252 "Data/Text/ICU/Char.hsc" #-}

charFromName' :: UCharNameChoice -> String -> Maybe Char
charFromName' :: UCharNameChoice -> String -> Maybe Char
charFromName' UCharNameChoice
choice String
name = IO (Maybe Char) -> Maybe Char
forall a. IO a -> a
unsafePerformIO (IO (Maybe Char) -> Maybe Char)
-> ((CString -> IO (Maybe Char)) -> IO (Maybe Char))
-> (CString -> IO (Maybe Char))
-> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (CString -> IO (Maybe Char)) -> IO (Maybe Char)
forall a. String -> (CString -> IO a) -> IO a
withCString String
name ((CString -> IO (Maybe Char)) -> Maybe Char)
-> (CString -> IO (Maybe Char)) -> Maybe Char
forall a b. (a -> b) -> a -> b
$ \CString
ptr -> do
  (ICUError
err,UChar32
r) <- (Ptr UCharNameChoice -> IO UChar32) -> IO (ICUError, UChar32)
forall a. (Ptr UCharNameChoice -> IO a) -> IO (ICUError, a)
withError ((Ptr UCharNameChoice -> IO UChar32) -> IO (ICUError, UChar32))
-> (Ptr UCharNameChoice -> IO UChar32) -> IO (ICUError, UChar32)
forall a b. (a -> b) -> a -> b
$ UCharNameChoice -> CString -> Ptr UCharNameChoice -> IO UChar32
u_charFromName UCharNameChoice
choice CString
ptr
  Maybe Char -> IO (Maybe Char)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Char -> IO (Maybe Char)) -> Maybe Char -> IO (Maybe Char)
forall a b. (a -> b) -> a -> b
$! if ICUError
err ICUError -> ICUError -> Bool
forall a. Eq a => a -> a -> Bool
== ICUError
u_INVALID_CHAR_FOUND Bool -> Bool -> Bool
|| UChar32
r UChar32 -> UChar32 -> Bool
forall a. Eq a => a -> a -> Bool
== UChar32
0xffff
            then Maybe Char
forall a. Maybe a
Nothing
            else Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Maybe Char) -> Char -> Maybe Char
forall a b. (a -> b) -> a -> b
$! Int -> Char
chr (UChar32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UChar32
r)

charName' :: UCharNameChoice -> Char -> String
charName' :: UCharNameChoice -> Char -> String
charName' UCharNameChoice
choice Char
c = (CString -> Int32 -> Ptr UCharNameChoice -> IO Int32) -> String
fillString ((CString -> Int32 -> Ptr UCharNameChoice -> IO Int32) -> String)
-> (CString -> Int32 -> Ptr UCharNameChoice -> IO Int32) -> String
forall a b. (a -> b) -> a -> b
$ UChar32
-> UCharNameChoice
-> CString
-> Int32
-> Ptr UCharNameChoice
-> IO Int32
u_charName (Int -> UChar32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c)) UCharNameChoice
choice

fillString :: (CString -> Int32 -> Ptr UErrorCode -> IO Int32) -> String
fillString :: (CString -> Int32 -> Ptr UCharNameChoice -> IO Int32) -> String
fillString CString -> Int32 -> Ptr UCharNameChoice -> IO Int32
act = IO String -> String
forall a. IO a -> a
unsafePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$
                 Int
-> (CString -> Int32 -> Ptr UCharNameChoice -> IO Int32)
-> (CString -> Int -> IO String)
-> IO String
forall a b.
Storable a =>
Int
-> (Ptr a -> Int32 -> Ptr UCharNameChoice -> IO Int32)
-> (Ptr a -> Int -> IO b)
-> IO b
handleOverflowError Int
83 CString -> Int32 -> Ptr UCharNameChoice -> IO Int32
act (((CString, Int) -> IO String) -> CString -> Int -> IO String
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (CString, Int) -> IO String
peekCStringLen)

type UBlockCode = CInt
type UCharDirection = CInt
type UCharNameChoice = CInt
type UProperty = CInt

foreign import ccall unsafe "hs_text_icu.h __hs_ublock_getCode" ublock_getCode
    :: UChar32 -> UBlockCode

foreign import ccall unsafe "hs_text_icu.h __hs_u_charDirection" u_charDirection
    :: UChar32 -> UCharDirection

foreign import ccall unsafe "hs_text_icu.h __hs_u_isMirrored" u_isMirrored
    :: UChar32 -> UBool

foreign import ccall unsafe "hs_text_icu.h __hs_u_charMirror" u_charMirror
    :: UChar32 -> UChar32

foreign import ccall unsafe "hs_text_icu.h __hs_u_getCombiningClass" u_getCombiningClass
    :: UChar32 -> Word8

foreign import ccall unsafe "hs_text_icu.h __hs_u_charDigitValue" u_charDigitValue
    :: UChar32 -> Int32

foreign import ccall unsafe "hs_text_icu.h __hs_u_charName" u_charName
    :: UChar32 -> UCharNameChoice -> CString -> Int32 -> Ptr UErrorCode
    -> IO Int32

foreign import ccall unsafe "hs_text_icu.h __hs_u_charFromName" u_charFromName
    :: UCharNameChoice -> CString -> Ptr UErrorCode
    -> IO UChar32

foreign import ccall unsafe "hs_text_icu.h __hs_u_getIntPropertyValue" u_getIntPropertyValue
    :: UChar32 -> UProperty -> Int32

foreign import ccall unsafe "hs_text_icu.h __hs_u_getNumericValue" u_getNumericValue
    :: UChar32 -> Double