{-# LINE 1 "Data/Text/ICU/Normalize2.hsc" #-}
{-# LANGUAGE EmptyDataDecls, CPP, DeriveDataTypeable, ForeignFunctionInterface #-}
-- |
-- Module      : Data.Text.ICU.Normalize
-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan
--
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- Character set normalization functions for Unicode, implemented as
-- bindings to the International Components for Unicode (ICU)
-- libraries. See http://www.unicode.org/reports/tr15/ for a description
-- of Unicode normalization modes and why these are needed.

module Data.Text.ICU.Normalize2
    (
    -- * Unicode normalization API
    -- $api
    -- * Create normalizers
    NormalizationMode(..), normalizer, nfcNormalizer, nfdNormalizer, nfkcNormalizer, nfkdNormalizer, nfkcCasefoldNormalizer,
    -- * Normalize unicode strings
    nfc, nfd, nfkc, nfkd, nfkcCasefold, normalize, normalizeWith,
    -- * Checks for normalization
    quickCheck, isNormalized, isNormalizedWith,
    -- * Comparison of unicode strings
    compareUnicode, compareUnicode', CompareOption(..),
    ) where


{-# LINE 33 "Data/Text/ICU/Normalize2.hsc" #-}




import Data.Text (Text)
import Data.Text.ICU.Error.Internal (UErrorCode, handleError, handleOverflowError)
import Data.Text.ICU.Internal (UBool, UChar, asBool, asOrdering, fromUCharPtr, useAsUCharPtr)
import Data.Text.ICU.Normalize.Internal (UNormalizationCheckResult, toNCR)
import Data.Typeable (Typeable)
import Data.Int (Int32)
import Data.Word (Word32)
import Foreign.C.Types (CInt(..))
import Foreign.Ptr (Ptr)
import System.IO.Unsafe (unsafePerformIO)
import Prelude hiding (compare)
import Data.List (foldl')
import Data.Bits ((.|.))

-- $api
--
-- The 'normalize' function transforms Unicode text into an equivalent
-- composed or decomposed form, allowing for easier sorting and
-- searching of text.  'normalize' supports the standard normalization
-- forms described in <http://www.unicode.org/unicode/reports/tr15/>,
-- Unicode Standard Annex #15: Unicode Normalization Forms.
--
-- Characters with accents or other adornments can be encoded in
-- several different ways in Unicode.  For example, take the character A-acute.
-- In Unicode, this can be encoded as a single character (the
-- \"composed\" form):
--
-- @
--      00C1    LATIN CAPITAL LETTER A WITH ACUTE
-- @
--
-- or as two separate characters (the \"decomposed\" form):
--
-- @
--      0041    LATIN CAPITAL LETTER A
--      0301    COMBINING ACUTE ACCENT
-- @
--
-- To a user of your program, however, both of these sequences should
-- be treated as the same \"user-level\" character \"A with acute
-- accent\".  When you are searching or comparing text, you must
-- ensure that these two sequences are treated equivalently.  In
-- addition, you must handle characters with more than one accent.
-- Sometimes the order of a character's combining accents is
-- significant, while in other cases accent sequences in different
-- orders are really equivalent.
--
-- Similarly, the string \"ffi\" can be encoded as three separate letters:
--
-- @
--      0066    LATIN SMALL LETTER F
--      0066    LATIN SMALL LETTER F
--      0069    LATIN SMALL LETTER I
-- @
--
-- or as the single character
--
-- @
--      FB03    LATIN SMALL LIGATURE FFI
-- @
--
-- The \"ffi\" ligature is not a distinct semantic character, and
-- strictly speaking it shouldn't be in Unicode at all, but it was
-- included for compatibility with existing character sets that
-- already provided it.  The Unicode standard identifies such
-- characters by giving them \"compatibility\" decompositions into the
-- corresponding semantic characters.  When sorting and searching, you
-- will often want to use these mappings.
--
-- 'normalize' helps solve these problems by transforming text into
-- the canonical composed and decomposed forms as shown in the first
-- example above.  In addition, you can have it perform compatibility
-- decompositions so that you can treat compatibility characters the
-- same as their equivalents.  Finally, 'normalize' rearranges accents
-- into the proper canonical order, so that you do not have to worry
-- about accent rearrangement on your own.
--
-- Form 'FCD', \"Fast C or D\", is also designed for collation.  It
-- allows to work on strings that are not necessarily normalized with
-- an algorithm (like in collation) that works under \"canonical
-- closure\", i.e., it treats precomposed characters and their
-- decomposed equivalents the same.
--
-- It is not a normalization form because it does not provide for
-- uniqueness of representation. Multiple strings may be canonically
-- equivalent (their NFDs are identical) and may all conform to 'FCD'
-- without being identical themselves.
--
-- The form is defined such that the \"raw decomposition\", the
-- recursive canonical decomposition of each character, results in a
-- string that is canonically ordered. This means that precomposed
-- characters are allowed for as long as their decompositions do not
-- need canonical reordering.
--
-- Its advantage for a process like collation is that all 'NFD' and
-- most 'NFC' texts - and many unnormalized texts - already conform to
-- 'FCD' and do not need to be normalized ('NFD') for such a
-- process. The 'FCD' 'quickCheck' will return 'Yes' for most strings
-- in practice.
--
-- @'normalize' 'FCD'@ may be implemented with 'NFD'.
--
-- For more details on 'FCD' see the collation design document:
-- <http://source.icu-project.org/repos/icu/icuhtml/trunk/design/collation/ICU_collation_design.htm>
--
-- ICU collation performs either 'NFD' or 'FCD' normalization
-- automatically if normalization is turned on for the collator
-- object.  Beyond collation and string search, normalized strings may
-- be useful for string equivalence comparisons,
-- transliteration/transcription, unique representations, etc.
--
-- The W3C generally recommends to exchange texts in 'NFC'.  Note also
-- that most legacy character encodings use only precomposed forms and
-- often do not encode any combining marks by themselves. For
-- conversion to such character encodings the Unicode text needs to be
-- normalized to 'NFC'.  For more usage examples, see the Unicode
-- Standard Annex.

-- | This is an abstract data type holding a reference to the ICU `UNormalizer2` object.
newtype Normalizer = Normalizer (Ptr UNormalizer2)

data UNormalizer2

-- | Normalization modes analog (but not identical) to the ones in the
-- 'Data.Text.ICU.Normalize' module.
data NormalizationMode
    = NFD            -- ^ Canonical decomposition.
    | NFKD           -- ^ Compatibility decomposition.
    | NFC            -- ^ Canonical decomposition followed by canonical composition.
    | NFKC           -- ^ Compatibility decomposition followed by canonical composition.
    | NFKCCasefold   -- ^ NFKC with Casefold.
      deriving (NormalizationMode -> NormalizationMode -> Bool
(NormalizationMode -> NormalizationMode -> Bool)
-> (NormalizationMode -> NormalizationMode -> Bool)
-> Eq NormalizationMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NormalizationMode -> NormalizationMode -> Bool
$c/= :: NormalizationMode -> NormalizationMode -> Bool
== :: NormalizationMode -> NormalizationMode -> Bool
$c== :: NormalizationMode -> NormalizationMode -> Bool
Eq, Int -> NormalizationMode -> ShowS
[NormalizationMode] -> ShowS
NormalizationMode -> String
(Int -> NormalizationMode -> ShowS)
-> (NormalizationMode -> String)
-> ([NormalizationMode] -> ShowS)
-> Show NormalizationMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NormalizationMode] -> ShowS
$cshowList :: [NormalizationMode] -> ShowS
show :: NormalizationMode -> String
$cshow :: NormalizationMode -> String
showsPrec :: Int -> NormalizationMode -> ShowS
$cshowsPrec :: Int -> NormalizationMode -> ShowS
Show, Int -> NormalizationMode
NormalizationMode -> Int
NormalizationMode -> [NormalizationMode]
NormalizationMode -> NormalizationMode
NormalizationMode -> NormalizationMode -> [NormalizationMode]
NormalizationMode
-> NormalizationMode -> NormalizationMode -> [NormalizationMode]
(NormalizationMode -> NormalizationMode)
-> (NormalizationMode -> NormalizationMode)
-> (Int -> NormalizationMode)
-> (NormalizationMode -> Int)
-> (NormalizationMode -> [NormalizationMode])
-> (NormalizationMode -> NormalizationMode -> [NormalizationMode])
-> (NormalizationMode -> NormalizationMode -> [NormalizationMode])
-> (NormalizationMode
    -> NormalizationMode -> NormalizationMode -> [NormalizationMode])
-> Enum NormalizationMode
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 :: NormalizationMode
-> NormalizationMode -> NormalizationMode -> [NormalizationMode]
$cenumFromThenTo :: NormalizationMode
-> NormalizationMode -> NormalizationMode -> [NormalizationMode]
enumFromTo :: NormalizationMode -> NormalizationMode -> [NormalizationMode]
$cenumFromTo :: NormalizationMode -> NormalizationMode -> [NormalizationMode]
enumFromThen :: NormalizationMode -> NormalizationMode -> [NormalizationMode]
$cenumFromThen :: NormalizationMode -> NormalizationMode -> [NormalizationMode]
enumFrom :: NormalizationMode -> [NormalizationMode]
$cenumFrom :: NormalizationMode -> [NormalizationMode]
fromEnum :: NormalizationMode -> Int
$cfromEnum :: NormalizationMode -> Int
toEnum :: Int -> NormalizationMode
$ctoEnum :: Int -> NormalizationMode
pred :: NormalizationMode -> NormalizationMode
$cpred :: NormalizationMode -> NormalizationMode
succ :: NormalizationMode -> NormalizationMode
$csucc :: NormalizationMode -> NormalizationMode
Enum, Typeable)

createNormalizerWith :: (Ptr UErrorCode -> IO (Ptr UNormalizer2)) -> IO Normalizer
createNormalizerWith :: (Ptr UErrorCode -> IO (Ptr UNormalizer2)) -> IO Normalizer
createNormalizerWith Ptr UErrorCode -> IO (Ptr UNormalizer2)
f = Ptr UNormalizer2 -> Normalizer
Normalizer (Ptr UNormalizer2 -> Normalizer)
-> IO (Ptr UNormalizer2) -> IO Normalizer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr UErrorCode -> IO (Ptr UNormalizer2)) -> IO (Ptr UNormalizer2)
forall a. (Ptr UErrorCode -> IO a) -> IO a
handleError Ptr UErrorCode -> IO (Ptr UNormalizer2)
f
    -- from the ICU documentation: "Returns an unmodifiable singleton instance of `unorm2_getInstance()`. Do not delete it."
    -- Thats why we use raw pointer here.

-- | Create a normalizer for a given normalization mode. This function is more similar to
-- the interface in the 'Data.Text.ICU.Normalize' module.
normalizer :: NormalizationMode -> IO Normalizer
normalizer :: NormalizationMode -> IO Normalizer
normalizer NormalizationMode
NFD = IO Normalizer
nfdNormalizer
normalizer NormalizationMode
NFKD = IO Normalizer
nfkdNormalizer
normalizer NormalizationMode
NFC = IO Normalizer
nfcNormalizer
normalizer NormalizationMode
NFKC = IO Normalizer
nfkcNormalizer
normalizer NormalizationMode
NFKCCasefold = IO Normalizer
nfkcCasefoldNormalizer

-- | Create an NFC normalizer.
nfcNormalizer :: IO Normalizer
nfcNormalizer :: IO Normalizer
nfcNormalizer = (Ptr UErrorCode -> IO (Ptr UNormalizer2)) -> IO Normalizer
createNormalizerWith Ptr UErrorCode -> IO (Ptr UNormalizer2)
unorm2_getNFCInstance

-- | Create an NFD normalizer.
nfdNormalizer :: IO Normalizer
nfdNormalizer :: IO Normalizer
nfdNormalizer = (Ptr UErrorCode -> IO (Ptr UNormalizer2)) -> IO Normalizer
createNormalizerWith Ptr UErrorCode -> IO (Ptr UNormalizer2)
unorm2_getNFDInstance

-- | Create an NFKC normalizer.
nfkcNormalizer :: IO Normalizer
nfkcNormalizer :: IO Normalizer
nfkcNormalizer = (Ptr UErrorCode -> IO (Ptr UNormalizer2)) -> IO Normalizer
createNormalizerWith Ptr UErrorCode -> IO (Ptr UNormalizer2)
unorm2_getNFKCInstance

-- | Create an NFKD normalizer.
nfkdNormalizer :: IO Normalizer
nfkdNormalizer :: IO Normalizer
nfkdNormalizer = (Ptr UErrorCode -> IO (Ptr UNormalizer2)) -> IO Normalizer
createNormalizerWith Ptr UErrorCode -> IO (Ptr UNormalizer2)
unorm2_getNFKDInstance

-- | Create an NFKCCasefold normalizer.
nfkcCasefoldNormalizer :: IO Normalizer
nfkcCasefoldNormalizer :: IO Normalizer
nfkcCasefoldNormalizer = (Ptr UErrorCode -> IO (Ptr UNormalizer2)) -> IO Normalizer
createNormalizerWith Ptr UErrorCode -> IO (Ptr UNormalizer2)
unorm2_getNFKCCasefoldInstance

-- * Normalization

-- | Normalize a string with the given normalizer.
normalizeWith :: Normalizer -> Text -> Text
normalizeWith :: Normalizer -> Text -> Text
normalizeWith (Normalizer Ptr UNormalizer2
nfPtr) Text
t = IO Text -> Text
forall a. IO a -> a
unsafePerformIO (IO Text -> Text) -> IO Text -> Text
forall a b. (a -> b) -> a -> b
$
  Text -> (Ptr UChar -> I16 -> IO Text) -> IO Text
forall a. Text -> (Ptr UChar -> I16 -> IO a) -> IO a
useAsUCharPtr Text
t ((Ptr UChar -> I16 -> IO Text) -> IO Text)
-> (Ptr UChar -> I16 -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \Ptr UChar
sptr I16
slen ->
    let slen' :: Int32
slen' = I16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral I16
slen
    in Int
-> (Ptr UChar -> Int32 -> Ptr UErrorCode -> IO Int32)
-> (Ptr UChar -> Int -> IO Text)
-> IO Text
forall a b.
Storable a =>
Int
-> (Ptr a -> Int32 -> Ptr UErrorCode -> IO Int32)
-> (Ptr a -> Int -> IO b)
-> IO b
handleOverflowError (I16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral I16
slen)
        (\Ptr UChar
dptr Int32
dlen -> Ptr UNormalizer2
-> Ptr UChar
-> Int32
-> Ptr UChar
-> Int32
-> Ptr UErrorCode
-> IO Int32
unorm2_normalize Ptr UNormalizer2
nfPtr Ptr UChar
sptr Int32
slen' Ptr UChar
dptr (Int32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
dlen))
        (\Ptr UChar
dptr Int
dlen -> Ptr UChar -> I16 -> IO Text
fromUCharPtr Ptr UChar
dptr (Int -> I16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dlen))

-- | Normalize a string using the given normalization mode.
normalize :: NormalizationMode -> Text -> Text
normalize :: NormalizationMode -> Text -> Text
normalize NormalizationMode
NFC = Text -> Text
nfc
normalize NormalizationMode
NFD = Text -> Text
nfd
normalize NormalizationMode
NFKC = Text -> Text
nfkc
normalize NormalizationMode
NFKD = Text -> Text
nfkd
normalize NormalizationMode
NFKCCasefold = Text -> Text
nfkcCasefold

-- | Create an NFC normalizer and apply this to the given text.
--
-- Let's have a look at a concrete example that contains the letter a with an acute accent twice.
-- First as a combination of two codepoints and second as a canonical composite or precomposed
-- character. Both look exactly the same but one character consists of two and one of only one
-- codepoint. A bytewise comparison does not give equality of these.
--
-- >>> import Data.Text
-- >>> let t = pack "a\x301á"
-- >>> t
-- "a\769\225"
-- >>> putStr t
-- áá
-- pack "a\x301" == pack "á"
-- False
--
-- But now lets apply some normalization functions and see how these characters coincide afterwards
-- in two different ways:
--
-- >>> nfc t
-- "\225\225"
-- >>> nfd t
-- "a\769a\769"
--
-- That is exactly what 'compareUnicode'' does:
--
-- >>> pack "a\x301" `compareUnicode'` pack "á"
nfc :: Text -> Text
nfc :: Text -> Text
nfc Text
t = IO Text -> Text
forall a. IO a -> a
unsafePerformIO (IO Text -> Text) -> IO Text -> Text
forall a b. (a -> b) -> a -> b
$ do
  Normalizer
nf <- IO Normalizer
nfcNormalizer
  Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ Normalizer -> Text -> Text
normalizeWith Normalizer
nf Text
t

-- | Create an NFKC normalizer and apply this to the given text.
nfkc :: Text -> Text
nfkc :: Text -> Text
nfkc Text
t = IO Text -> Text
forall a. IO a -> a
unsafePerformIO (IO Text -> Text) -> IO Text -> Text
forall a b. (a -> b) -> a -> b
$ do
  Normalizer
nf <- IO Normalizer
nfkcNormalizer
  Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ Normalizer -> Text -> Text
normalizeWith Normalizer
nf Text
t

-- | Create an NFD normalizer and apply this to the given text.
nfd :: Text -> Text
nfd :: Text -> Text
nfd Text
t = IO Text -> Text
forall a. IO a -> a
unsafePerformIO (IO Text -> Text) -> IO Text -> Text
forall a b. (a -> b) -> a -> b
$ do
  Normalizer
nf <- IO Normalizer
nfdNormalizer
  Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ Normalizer -> Text -> Text
normalizeWith Normalizer
nf Text
t

-- | Create an NFC normalizer and apply this to the given text.
nfkd :: Text -> Text
nfkd :: Text -> Text
nfkd Text
t = IO Text -> Text
forall a. IO a -> a
unsafePerformIO (IO Text -> Text) -> IO Text -> Text
forall a b. (a -> b) -> a -> b
$ do
  Normalizer
nf <- IO Normalizer
nfkdNormalizer
  Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ Normalizer -> Text -> Text
normalizeWith Normalizer
nf Text
t

-- | Create an NFKCCasefold normalizer and apply this to the given text.
nfkcCasefold :: Text -> Text
nfkcCasefold :: Text -> Text
nfkcCasefold Text
t = IO Text -> Text
forall a. IO a -> a
unsafePerformIO (IO Text -> Text) -> IO Text -> Text
forall a b. (a -> b) -> a -> b
$ do
  Normalizer
nf <- IO Normalizer
nfkcCasefoldNormalizer
  Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ Normalizer -> Text -> Text
normalizeWith Normalizer
nf Text
t

-- * Checks for normalization

-- | Perform an efficient check on a string, to quickly determine if
-- the string is in a particular normalization form.
--
-- A 'Nothing' result indicates that a definite answer could not be
-- determined quickly, and a more thorough check is required,
-- e.g. with 'isNormalized'.  The user may have to convert the string
-- to its normalized form and compare the results.
--
-- A result of 'Just' 'True' or 'Just' 'False' indicates that the
-- string definitely is, or is not, in the given normalization form.
quickCheckWith :: Normalizer -> Text -> Maybe Bool
quickCheckWith :: Normalizer -> Text -> Maybe Bool
quickCheckWith (Normalizer Ptr UNormalizer2
nfPtr) Text
t = IO (Maybe Bool) -> Maybe Bool
forall a. IO a -> a
unsafePerformIO (IO (Maybe Bool) -> Maybe Bool) -> IO (Maybe Bool) -> Maybe Bool
forall a b. (a -> b) -> a -> b
$
  Text -> (Ptr UChar -> I16 -> IO (Maybe Bool)) -> IO (Maybe Bool)
forall a. Text -> (Ptr UChar -> I16 -> IO a) -> IO a
useAsUCharPtr Text
t ((Ptr UChar -> I16 -> IO (Maybe Bool)) -> IO (Maybe Bool))
-> (Ptr UChar -> I16 -> IO (Maybe Bool)) -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ \Ptr UChar
sptr I16
slen ->
    (UErrorCode -> Maybe Bool) -> IO UErrorCode -> IO (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UErrorCode -> Maybe Bool
toNCR (IO UErrorCode -> IO (Maybe Bool))
-> ((Ptr UErrorCode -> IO UErrorCode) -> IO UErrorCode)
-> (Ptr UErrorCode -> IO UErrorCode)
-> IO (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr UErrorCode -> IO UErrorCode) -> IO UErrorCode
forall a. (Ptr UErrorCode -> IO a) -> IO a
handleError ((Ptr UErrorCode -> IO UErrorCode) -> IO (Maybe Bool))
-> (Ptr UErrorCode -> IO UErrorCode) -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Ptr UNormalizer2
-> Ptr UChar -> Int32 -> Ptr UErrorCode -> IO UErrorCode
unorm2_quickCheck Ptr UNormalizer2
nfPtr Ptr UChar
sptr (I16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral I16
slen)

quickCheck :: NormalizationMode -> Text -> Maybe Bool
quickCheck :: NormalizationMode -> Text -> Maybe Bool
quickCheck NormalizationMode
NFD Text
t = IO (Maybe Bool) -> Maybe Bool
forall a. IO a -> a
unsafePerformIO (IO (Maybe Bool) -> Maybe Bool) -> IO (Maybe Bool) -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ do
  Normalizer
nf <- IO Normalizer
nfdNormalizer
  Maybe Bool -> IO (Maybe Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Bool -> IO (Maybe Bool)) -> Maybe Bool -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Normalizer -> Text -> Maybe Bool
quickCheckWith Normalizer
nf Text
t
quickCheck NormalizationMode
NFC Text
t = IO (Maybe Bool) -> Maybe Bool
forall a. IO a -> a
unsafePerformIO (IO (Maybe Bool) -> Maybe Bool) -> IO (Maybe Bool) -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ do
  Normalizer
nf <- IO Normalizer
nfcNormalizer
  Maybe Bool -> IO (Maybe Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Bool -> IO (Maybe Bool)) -> Maybe Bool -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Normalizer -> Text -> Maybe Bool
quickCheckWith Normalizer
nf Text
t
quickCheck NormalizationMode
NFKD Text
t = IO (Maybe Bool) -> Maybe Bool
forall a. IO a -> a
unsafePerformIO (IO (Maybe Bool) -> Maybe Bool) -> IO (Maybe Bool) -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ do
  Normalizer
nf <- IO Normalizer
nfkdNormalizer
  Maybe Bool -> IO (Maybe Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Bool -> IO (Maybe Bool)) -> Maybe Bool -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Normalizer -> Text -> Maybe Bool
quickCheckWith Normalizer
nf Text
t
quickCheck NormalizationMode
NFKC Text
t = IO (Maybe Bool) -> Maybe Bool
forall a. IO a -> a
unsafePerformIO (IO (Maybe Bool) -> Maybe Bool) -> IO (Maybe Bool) -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ do
  Normalizer
nf <- IO Normalizer
nfkcNormalizer
  Maybe Bool -> IO (Maybe Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Bool -> IO (Maybe Bool)) -> Maybe Bool -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Normalizer -> Text -> Maybe Bool
quickCheckWith Normalizer
nf Text
t
quickCheck NormalizationMode
NFKCCasefold Text
t = IO (Maybe Bool) -> Maybe Bool
forall a. IO a -> a
unsafePerformIO (IO (Maybe Bool) -> Maybe Bool) -> IO (Maybe Bool) -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ do
  Normalizer
nf <- IO Normalizer
nfkcCasefoldNormalizer
  Maybe Bool -> IO (Maybe Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Bool -> IO (Maybe Bool)) -> Maybe Bool -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Normalizer -> Text -> Maybe Bool
quickCheckWith Normalizer
nf Text
t

-- | Indicate whether a string is in a given normalization form.
--
-- Unlike 'quickCheck', this function returns a definitive result.
-- For 'NFD' and 'NFKD' normalization forms, both functions
-- work in exactly the same ways.  For 'NFC' and 'NFKC' forms, where
-- 'quickCheck' may return 'Nothing', this function will perform
-- further tests to arrive at a definitive result.
isNormalizedWith :: Normalizer -> Text -> Bool
isNormalizedWith :: Normalizer -> Text -> Bool
isNormalizedWith (Normalizer Ptr UNormalizer2
nfPtr) Text
t = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
  Text -> (Ptr UChar -> I16 -> IO Bool) -> IO Bool
forall a. Text -> (Ptr UChar -> I16 -> IO a) -> IO a
useAsUCharPtr Text
t ((Ptr UChar -> I16 -> IO Bool) -> IO Bool)
-> (Ptr UChar -> I16 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr UChar
sptr I16
slen ->
    (UBool -> Bool) -> IO UBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UBool -> Bool
forall a. Integral a => a -> Bool
asBool (IO UBool -> IO Bool)
-> ((Ptr UErrorCode -> IO UBool) -> IO UBool)
-> (Ptr UErrorCode -> IO UBool)
-> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr UErrorCode -> IO UBool) -> IO UBool
forall a. (Ptr UErrorCode -> IO a) -> IO a
handleError ((Ptr UErrorCode -> IO UBool) -> IO Bool)
-> (Ptr UErrorCode -> IO UBool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ Ptr UNormalizer2
-> Ptr UChar -> Int32 -> Ptr UErrorCode -> IO UBool
unorm2_isNormalized Ptr UNormalizer2
nfPtr Ptr UChar
sptr (I16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral I16
slen)

isNormalized :: NormalizationMode -> Text -> Bool
isNormalized :: NormalizationMode -> Text -> Bool
isNormalized NormalizationMode
NFD Text
t = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
  Normalizer
nf <- IO Normalizer
nfdNormalizer
  Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Normalizer -> Text -> Bool
isNormalizedWith Normalizer
nf Text
t
isNormalized NormalizationMode
NFC Text
t = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
  Normalizer
nf <- IO Normalizer
nfcNormalizer
  Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Normalizer -> Text -> Bool
isNormalizedWith Normalizer
nf Text
t
isNormalized NormalizationMode
NFKD Text
t = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
  Normalizer
nf <- IO Normalizer
nfkdNormalizer
  Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Normalizer -> Text -> Bool
isNormalizedWith Normalizer
nf Text
t
isNormalized NormalizationMode
NFKC Text
t = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
  Normalizer
nf <- IO Normalizer
nfkcNormalizer
  Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Normalizer -> Text -> Bool
isNormalizedWith Normalizer
nf Text
t
isNormalized NormalizationMode
NFKCCasefold Text
t = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
  Normalizer
nf <- IO Normalizer
nfkcCasefoldNormalizer
  Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Normalizer -> Text -> Bool
isNormalizedWith Normalizer
nf Text
t

-- * Comparison

type UCompareOption = Word32

-- | Options to 'compare'.
data CompareOption = InputIsFCD
                   -- ^ The caller knows that both strings fulfill the
                   -- 'FCD' conditions.  If /not/ set, 'compare' will
                   -- 'quickCheck' for 'FCD' and normalize if
                   -- necessary.
                   | CompareIgnoreCase
                   -- ^ Compare strings case-insensitively using case
                   -- folding, instead of case-sensitively.  If set,
                   -- then the following case folding options are
                   -- used.
                   | FoldCaseExcludeSpecialI
                   -- ^ When case folding, exclude the special I
                   -- character.  For use with Turkic
                   -- (Turkish/Azerbaijani) text data.
                     deriving (CompareOption -> CompareOption -> Bool
(CompareOption -> CompareOption -> Bool)
-> (CompareOption -> CompareOption -> Bool) -> Eq CompareOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompareOption -> CompareOption -> Bool
$c/= :: CompareOption -> CompareOption -> Bool
== :: CompareOption -> CompareOption -> Bool
$c== :: CompareOption -> CompareOption -> Bool
Eq, Int -> CompareOption -> ShowS
[CompareOption] -> ShowS
CompareOption -> String
(Int -> CompareOption -> ShowS)
-> (CompareOption -> String)
-> ([CompareOption] -> ShowS)
-> Show CompareOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompareOption] -> ShowS
$cshowList :: [CompareOption] -> ShowS
show :: CompareOption -> String
$cshow :: CompareOption -> String
showsPrec :: Int -> CompareOption -> ShowS
$cshowsPrec :: Int -> CompareOption -> ShowS
Show, Int -> CompareOption
CompareOption -> Int
CompareOption -> [CompareOption]
CompareOption -> CompareOption
CompareOption -> CompareOption -> [CompareOption]
CompareOption -> CompareOption -> CompareOption -> [CompareOption]
(CompareOption -> CompareOption)
-> (CompareOption -> CompareOption)
-> (Int -> CompareOption)
-> (CompareOption -> Int)
-> (CompareOption -> [CompareOption])
-> (CompareOption -> CompareOption -> [CompareOption])
-> (CompareOption -> CompareOption -> [CompareOption])
-> (CompareOption
    -> CompareOption -> CompareOption -> [CompareOption])
-> Enum CompareOption
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 :: CompareOption -> CompareOption -> CompareOption -> [CompareOption]
$cenumFromThenTo :: CompareOption -> CompareOption -> CompareOption -> [CompareOption]
enumFromTo :: CompareOption -> CompareOption -> [CompareOption]
$cenumFromTo :: CompareOption -> CompareOption -> [CompareOption]
enumFromThen :: CompareOption -> CompareOption -> [CompareOption]
$cenumFromThen :: CompareOption -> CompareOption -> [CompareOption]
enumFrom :: CompareOption -> [CompareOption]
$cenumFrom :: CompareOption -> [CompareOption]
fromEnum :: CompareOption -> Int
$cfromEnum :: CompareOption -> Int
toEnum :: Int -> CompareOption
$ctoEnum :: Int -> CompareOption
pred :: CompareOption -> CompareOption
$cpred :: CompareOption -> CompareOption
succ :: CompareOption -> CompareOption
$csucc :: CompareOption -> CompareOption
Enum, Typeable)

fromCompareOption :: CompareOption -> UCompareOption
fromCompareOption :: CompareOption -> UCompareOption
fromCompareOption CompareOption
InputIsFCD              = UCompareOption
131072
{-# LINE 365 "Data/Text/ICU/Normalize2.hsc" #-}
fromCompareOption CompareIgnoreCase       = 65536
{-# LINE 366 "Data/Text/ICU/Normalize2.hsc" #-}
fromCompareOption FoldCaseExcludeSpecialI = 1
{-# LINE 367 "Data/Text/ICU/Normalize2.hsc" #-}

reduceCompareOptions :: [CompareOption] -> UCompareOption
reduceCompareOptions :: [CompareOption] -> UCompareOption
reduceCompareOptions = (UCompareOption -> CompareOption -> UCompareOption)
-> UCompareOption -> [CompareOption] -> UCompareOption
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' UCompareOption -> CompareOption -> UCompareOption
orO (UCompareOption
32768)
{-# LINE 370 "Data/Text/ICU/Normalize2.hsc" #-}
    where UCompareOption
a orO :: UCompareOption -> CompareOption -> UCompareOption
`orO` CompareOption
b = UCompareOption
a UCompareOption -> UCompareOption -> UCompareOption
forall a. Bits a => a -> a -> a
.|. CompareOption -> UCompareOption
fromCompareOption CompareOption
b

-- | Compare two strings for canonical equivalence. Further options
-- include case-insensitive comparison and codepoint order (as
-- opposed to code unit order).
--
-- Canonical equivalence between two strings is defined as their
-- normalized forms ('NFD' or 'NFC') being identical.  This function
-- compares strings incrementally instead of normalizing (and
-- optionally case-folding) both strings entirely, improving
-- performance significantly.
--
-- Bulk normalization is only necessary if the strings do not fulfill
-- the 'FCD' conditions. Only in this case, and only if the strings
-- are relatively long, is memory allocated temporarily.  For 'FCD'
-- strings and short non-'FCD' strings there is no memory allocation.
compareUnicode :: [CompareOption] -> Text -> Text -> Ordering
compareUnicode :: [CompareOption] -> Text -> Text -> Ordering
compareUnicode [CompareOption]
opts Text
a Text
b = IO Ordering -> Ordering
forall a. IO a -> a
unsafePerformIO (IO Ordering -> Ordering) -> IO Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$ do
  Text -> (Ptr UChar -> I16 -> IO Ordering) -> IO Ordering
forall a. Text -> (Ptr UChar -> I16 -> IO a) -> IO a
useAsUCharPtr Text
a ((Ptr UChar -> I16 -> IO Ordering) -> IO Ordering)
-> (Ptr UChar -> I16 -> IO Ordering) -> IO Ordering
forall a b. (a -> b) -> a -> b
$ \Ptr UChar
aptr I16
alen ->
    Text -> (Ptr UChar -> I16 -> IO Ordering) -> IO Ordering
forall a. Text -> (Ptr UChar -> I16 -> IO a) -> IO a
useAsUCharPtr Text
b ((Ptr UChar -> I16 -> IO Ordering) -> IO Ordering)
-> (Ptr UChar -> I16 -> IO Ordering) -> IO Ordering
forall a b. (a -> b) -> a -> b
$ \Ptr UChar
bptr I16
blen ->
      (Int32 -> Ordering) -> IO Int32 -> IO Ordering
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> Ordering
forall a. Integral a => a -> Ordering
asOrdering (IO Int32 -> IO Ordering)
-> ((Ptr UErrorCode -> IO Int32) -> IO Int32)
-> (Ptr UErrorCode -> IO Int32)
-> IO Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr UErrorCode -> IO Int32) -> IO Int32
forall a. (Ptr UErrorCode -> IO a) -> IO a
handleError ((Ptr UErrorCode -> IO Int32) -> IO Ordering)
-> (Ptr UErrorCode -> IO Int32) -> IO Ordering
forall a b. (a -> b) -> a -> b
$
      Ptr UChar
-> Int32
-> Ptr UChar
-> Int32
-> UCompareOption
-> Ptr UErrorCode
-> IO Int32
unorm_compare Ptr UChar
aptr (I16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral I16
alen) Ptr UChar
bptr (I16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral I16
blen)
                    ([CompareOption] -> UCompareOption
reduceCompareOptions [CompareOption]
opts)

-- | This is equivalent to `compareUnicode []`.
compareUnicode' :: Text -> Text -> Ordering
compareUnicode' :: Text -> Text -> Ordering
compareUnicode' = [CompareOption] -> Text -> Text -> Ordering
compareUnicode []

foreign import ccall unsafe "hs_text_icu.h __hs_unorm2_getNFCInstance" unorm2_getNFCInstance
    :: Ptr UErrorCode
    -> IO (Ptr UNormalizer2)
foreign import ccall unsafe "hs_text_icu.h __hs_unorm2_getNFDInstance" unorm2_getNFDInstance
    :: Ptr UErrorCode
    -> IO (Ptr UNormalizer2)
foreign import ccall unsafe "hs_text_icu.h __hs_unorm2_getNFKCInstance" unorm2_getNFKCInstance
    :: Ptr UErrorCode
    -> IO (Ptr UNormalizer2)
foreign import ccall unsafe "hs_text_icu.h __hs_unorm2_getNFKDInstance" unorm2_getNFKDInstance
    :: Ptr UErrorCode
    -> IO (Ptr UNormalizer2)
foreign import ccall unsafe "hs_text_icu.h __hs_unorm2_getNFKCCasefoldInstance" unorm2_getNFKCCasefoldInstance
    :: Ptr UErrorCode
    -> IO (Ptr UNormalizer2)

foreign import ccall unsafe "hs_text_icu.h __hs_unorm_compare" unorm_compare
    :: Ptr UChar -> Int32
    -> Ptr UChar -> Int32
    -> Word32
    -> Ptr UErrorCode
    -> IO Int32

foreign import ccall unsafe "hs_text_icu.h __hs_unorm2_quickCheck" unorm2_quickCheck
    :: Ptr UNormalizer2
    -> Ptr UChar -> Int32
    -> Ptr UErrorCode
    -> IO UNormalizationCheckResult

foreign import ccall unsafe "hs_text_icu.h __hs_unorm2_isNormalized" unorm2_isNormalized
    :: Ptr UNormalizer2
    -> Ptr UChar -> Int32
    -> Ptr UErrorCode
    -> IO UBool

foreign import ccall unsafe "hs_text_icu.h __hs_unorm2_normalize" unorm2_normalize
    :: Ptr UNormalizer2
    -> Ptr UChar -> Int32
    -> Ptr UChar -> Int32
    -> Ptr UErrorCode
    -> IO Int32