{-# LINE 1 "Data/Text/ICU/Collate.hsc" #-}
{-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable, ForeignFunctionInterface #-}
-- |
-- Module      : Data.Text.ICU.Collate
-- Copyright   : (c) 2010 Bryan O'Sullivan
--
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- String collation functions for Unicode, implemented as bindings to
-- the International Components for Unicode (ICU) libraries.

module Data.Text.ICU.Collate
    (
    -- * Unicode collation API
    -- $api
    -- * Types
      MCollator
    , Attribute(..)
    , AlternateHandling(..)
    , CaseFirst(..)
    , Strength(..)
    -- * Functions
    , open
    , collate
    , collateIter
    -- ** Utility functions
    , getAttribute
    , setAttribute
    , sortKey
    , clone
    , freeze
    ) where



import Control.DeepSeq (NFData(..))
import Data.ByteString (empty)
import Data.ByteString.Internal (ByteString(..), create, mallocByteString,
                                 memcpy)
import Data.Int (Int32)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Foreign (useAsPtr)
import Data.Text.ICU.Collate.Internal (Collator(..), MCollator, UCollator,
                                       withCollator, wrap)
import Data.Text.ICU.Error.Internal (UErrorCode, handleError)
import Data.Text.ICU.Internal
    (LocaleName, UChar, CharIterator, UCharIterator,
     asOrdering, withCharIterator, withLocaleName, useAsUCharPtr)
import Data.Typeable (Typeable)
import Data.Word (Word8)
import Foreign.C.String (CString)
import Foreign.C.Types (CInt(..))
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Marshal.Utils (with)
import Foreign.Ptr (Ptr, nullPtr)

-- $api
--

-- | Control the handling of variable weight elements.
data AlternateHandling = NonIgnorable
                       -- ^ Treat all codepoints with non-ignorable primary
                       -- weights in the same way.
                       | Shifted
                         -- ^ Cause codepoints with primary weights that are
                         -- equal to or below the variable top value to be
                         -- ignored on primary level and moved to the
                         -- quaternary level.
                         deriving (AlternateHandling -> AlternateHandling -> Bool
(AlternateHandling -> AlternateHandling -> Bool)
-> (AlternateHandling -> AlternateHandling -> Bool)
-> Eq AlternateHandling
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlternateHandling -> AlternateHandling -> Bool
$c/= :: AlternateHandling -> AlternateHandling -> Bool
== :: AlternateHandling -> AlternateHandling -> Bool
$c== :: AlternateHandling -> AlternateHandling -> Bool
Eq, AlternateHandling
AlternateHandling -> AlternateHandling -> Bounded AlternateHandling
forall a. a -> a -> Bounded a
maxBound :: AlternateHandling
$cmaxBound :: AlternateHandling
minBound :: AlternateHandling
$cminBound :: AlternateHandling
Bounded, Int -> AlternateHandling
AlternateHandling -> Int
AlternateHandling -> [AlternateHandling]
AlternateHandling -> AlternateHandling
AlternateHandling -> AlternateHandling -> [AlternateHandling]
AlternateHandling
-> AlternateHandling -> AlternateHandling -> [AlternateHandling]
(AlternateHandling -> AlternateHandling)
-> (AlternateHandling -> AlternateHandling)
-> (Int -> AlternateHandling)
-> (AlternateHandling -> Int)
-> (AlternateHandling -> [AlternateHandling])
-> (AlternateHandling -> AlternateHandling -> [AlternateHandling])
-> (AlternateHandling -> AlternateHandling -> [AlternateHandling])
-> (AlternateHandling
    -> AlternateHandling -> AlternateHandling -> [AlternateHandling])
-> Enum AlternateHandling
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 :: AlternateHandling
-> AlternateHandling -> AlternateHandling -> [AlternateHandling]
$cenumFromThenTo :: AlternateHandling
-> AlternateHandling -> AlternateHandling -> [AlternateHandling]
enumFromTo :: AlternateHandling -> AlternateHandling -> [AlternateHandling]
$cenumFromTo :: AlternateHandling -> AlternateHandling -> [AlternateHandling]
enumFromThen :: AlternateHandling -> AlternateHandling -> [AlternateHandling]
$cenumFromThen :: AlternateHandling -> AlternateHandling -> [AlternateHandling]
enumFrom :: AlternateHandling -> [AlternateHandling]
$cenumFrom :: AlternateHandling -> [AlternateHandling]
fromEnum :: AlternateHandling -> Int
$cfromEnum :: AlternateHandling -> Int
toEnum :: Int -> AlternateHandling
$ctoEnum :: Int -> AlternateHandling
pred :: AlternateHandling -> AlternateHandling
$cpred :: AlternateHandling -> AlternateHandling
succ :: AlternateHandling -> AlternateHandling
$csucc :: AlternateHandling -> AlternateHandling
Enum, Int -> AlternateHandling -> ShowS
[AlternateHandling] -> ShowS
AlternateHandling -> String
(Int -> AlternateHandling -> ShowS)
-> (AlternateHandling -> String)
-> ([AlternateHandling] -> ShowS)
-> Show AlternateHandling
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlternateHandling] -> ShowS
$cshowList :: [AlternateHandling] -> ShowS
show :: AlternateHandling -> String
$cshow :: AlternateHandling -> String
showsPrec :: Int -> AlternateHandling -> ShowS
$cshowsPrec :: Int -> AlternateHandling -> ShowS
Show, Typeable)

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

-- | Control the ordering of upper and lower case letters.
data CaseFirst = UpperFirst     -- ^ Force upper case letters to sort before
                                -- lower case.
               | LowerFirst     -- ^ Force lower case letters to sort before
                                -- upper case.
                deriving (CaseFirst -> CaseFirst -> Bool
(CaseFirst -> CaseFirst -> Bool)
-> (CaseFirst -> CaseFirst -> Bool) -> Eq CaseFirst
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CaseFirst -> CaseFirst -> Bool
$c/= :: CaseFirst -> CaseFirst -> Bool
== :: CaseFirst -> CaseFirst -> Bool
$c== :: CaseFirst -> CaseFirst -> Bool
Eq, CaseFirst
CaseFirst -> CaseFirst -> Bounded CaseFirst
forall a. a -> a -> Bounded a
maxBound :: CaseFirst
$cmaxBound :: CaseFirst
minBound :: CaseFirst
$cminBound :: CaseFirst
Bounded, Int -> CaseFirst
CaseFirst -> Int
CaseFirst -> [CaseFirst]
CaseFirst -> CaseFirst
CaseFirst -> CaseFirst -> [CaseFirst]
CaseFirst -> CaseFirst -> CaseFirst -> [CaseFirst]
(CaseFirst -> CaseFirst)
-> (CaseFirst -> CaseFirst)
-> (Int -> CaseFirst)
-> (CaseFirst -> Int)
-> (CaseFirst -> [CaseFirst])
-> (CaseFirst -> CaseFirst -> [CaseFirst])
-> (CaseFirst -> CaseFirst -> [CaseFirst])
-> (CaseFirst -> CaseFirst -> CaseFirst -> [CaseFirst])
-> Enum CaseFirst
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 :: CaseFirst -> CaseFirst -> CaseFirst -> [CaseFirst]
$cenumFromThenTo :: CaseFirst -> CaseFirst -> CaseFirst -> [CaseFirst]
enumFromTo :: CaseFirst -> CaseFirst -> [CaseFirst]
$cenumFromTo :: CaseFirst -> CaseFirst -> [CaseFirst]
enumFromThen :: CaseFirst -> CaseFirst -> [CaseFirst]
$cenumFromThen :: CaseFirst -> CaseFirst -> [CaseFirst]
enumFrom :: CaseFirst -> [CaseFirst]
$cenumFrom :: CaseFirst -> [CaseFirst]
fromEnum :: CaseFirst -> Int
$cfromEnum :: CaseFirst -> Int
toEnum :: Int -> CaseFirst
$ctoEnum :: Int -> CaseFirst
pred :: CaseFirst -> CaseFirst
$cpred :: CaseFirst -> CaseFirst
succ :: CaseFirst -> CaseFirst
$csucc :: CaseFirst -> CaseFirst
Enum, Int -> CaseFirst -> ShowS
[CaseFirst] -> ShowS
CaseFirst -> String
(Int -> CaseFirst -> ShowS)
-> (CaseFirst -> String)
-> ([CaseFirst] -> ShowS)
-> Show CaseFirst
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CaseFirst] -> ShowS
$cshowList :: [CaseFirst] -> ShowS
show :: CaseFirst -> String
$cshow :: CaseFirst -> String
showsPrec :: Int -> CaseFirst -> ShowS
$cshowsPrec :: Int -> CaseFirst -> ShowS
Show, Typeable)

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

-- | The strength attribute. The usual strength for most locales (except
-- Japanese) is tertiary. Quaternary strength is useful when combined with
-- shifted setting for alternate handling attribute and for JIS x 4061
-- collation, when it is used to distinguish between Katakana and Hiragana
-- (this is achieved by setting 'HiraganaQuaternaryMode' mode to
-- 'True'). Otherwise, quaternary level is affected only by the number of
-- non ignorable code points in the string. Identical strength is rarely
-- useful, as it amounts to codepoints of the 'NFD' form of the string.
data Strength = Primary
              | Secondary
              | Tertiary
              | Quaternary
              | Identical
                deriving (Strength -> Strength -> Bool
(Strength -> Strength -> Bool)
-> (Strength -> Strength -> Bool) -> Eq Strength
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Strength -> Strength -> Bool
$c/= :: Strength -> Strength -> Bool
== :: Strength -> Strength -> Bool
$c== :: Strength -> Strength -> Bool
Eq, Strength
Strength -> Strength -> Bounded Strength
forall a. a -> a -> Bounded a
maxBound :: Strength
$cmaxBound :: Strength
minBound :: Strength
$cminBound :: Strength
Bounded, Int -> Strength
Strength -> Int
Strength -> [Strength]
Strength -> Strength
Strength -> Strength -> [Strength]
Strength -> Strength -> Strength -> [Strength]
(Strength -> Strength)
-> (Strength -> Strength)
-> (Int -> Strength)
-> (Strength -> Int)
-> (Strength -> [Strength])
-> (Strength -> Strength -> [Strength])
-> (Strength -> Strength -> [Strength])
-> (Strength -> Strength -> Strength -> [Strength])
-> Enum Strength
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 :: Strength -> Strength -> Strength -> [Strength]
$cenumFromThenTo :: Strength -> Strength -> Strength -> [Strength]
enumFromTo :: Strength -> Strength -> [Strength]
$cenumFromTo :: Strength -> Strength -> [Strength]
enumFromThen :: Strength -> Strength -> [Strength]
$cenumFromThen :: Strength -> Strength -> [Strength]
enumFrom :: Strength -> [Strength]
$cenumFrom :: Strength -> [Strength]
fromEnum :: Strength -> Int
$cfromEnum :: Strength -> Int
toEnum :: Int -> Strength
$ctoEnum :: Int -> Strength
pred :: Strength -> Strength
$cpred :: Strength -> Strength
succ :: Strength -> Strength
$csucc :: Strength -> Strength
Enum, Int -> Strength -> ShowS
[Strength] -> ShowS
Strength -> String
(Int -> Strength -> ShowS)
-> (Strength -> String) -> ([Strength] -> ShowS) -> Show Strength
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Strength] -> ShowS
$cshowList :: [Strength] -> ShowS
show :: Strength -> String
$cshow :: Strength -> String
showsPrec :: Int -> Strength -> ShowS
$cshowsPrec :: Int -> Strength -> ShowS
Show, Typeable)

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

data Attribute = French Bool
               -- ^ Direction of secondary weights, used in French.  'True',
               -- results in secondary weights being considered backwards,
               -- while 'False' treats secondary weights in the order in
               -- which they appear.
               | AlternateHandling AlternateHandling
                 -- ^ For handling variable elements.  'NonIgnorable' is
                 -- default.
               | CaseFirst (Maybe CaseFirst)
               -- ^ Control the ordering of upper and lower case letters.
               -- 'Nothing' (the default) orders upper and lower case
               -- letters in accordance to their tertiary weights.
               | CaseLevel Bool
                 -- ^ Controls whether an extra case level (positioned
                 -- before the third level) is generated or not.  When
                 -- 'False' (default), case level is not generated; when
                 -- 'True', the case level is generated. Contents of the
                 -- case level are affected by the value of the 'CaseFirst'
                 -- attribute. A simple way to ignore accent differences in
                 -- a string is to set the strength to 'Primary' and enable
                 -- case level.
               | NormalizationMode Bool
               -- ^ Controls whether the normalization check and necessary
               -- normalizations are performed. When 'False' (default) no
               -- normalization check is performed. The correctness of the
               -- result is guaranteed only if the input data is in
               -- so-called 'FCD' form (see users manual for more info).
               -- When 'True', an incremental check is performed to see
               -- whether the input data is in 'FCD' form. If the data is
               -- not in 'FCD' form, incremental 'NFD' normalization is
               -- performed.
               | Strength Strength
               | HiraganaQuaternaryMode Bool
                 -- ^ When turned on, this attribute positions Hiragana
                 -- before all non-ignorables on quaternary level. This is a
                 -- sneaky way to produce JIS sort order.
               | Numeric Bool
                 -- ^ When enabled, this attribute generates a collation key
                 -- for the numeric value of substrings of digits.  This is
                 -- a way to get '100' to sort /after/ '2'.
                 deriving (Attribute -> Attribute -> Bool
(Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool) -> Eq Attribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attribute -> Attribute -> Bool
$c/= :: Attribute -> Attribute -> Bool
== :: Attribute -> Attribute -> Bool
$c== :: Attribute -> Attribute -> Bool
Eq, Int -> Attribute -> ShowS
[Attribute] -> ShowS
Attribute -> String
(Int -> Attribute -> ShowS)
-> (Attribute -> String)
-> ([Attribute] -> ShowS)
-> Show Attribute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attribute] -> ShowS
$cshowList :: [Attribute] -> ShowS
show :: Attribute -> String
$cshow :: Attribute -> String
showsPrec :: Int -> Attribute -> ShowS
$cshowsPrec :: Int -> Attribute -> ShowS
Show, Typeable)

instance NFData Attribute where
    rnf :: Attribute -> ()
rnf (French !Bool
_)                 = ()
    rnf (AlternateHandling !AlternateHandling
_)      = ()
    rnf (CaseFirst Maybe CaseFirst
c)               = Maybe CaseFirst -> ()
forall a. NFData a => a -> ()
rnf Maybe CaseFirst
c
    rnf (CaseLevel !Bool
_)              = ()
    rnf (NormalizationMode !Bool
_)      = ()
    rnf (Strength !Strength
_)               = ()
    rnf (HiraganaQuaternaryMode !Bool
_) = ()
    rnf (Numeric !Bool
_)                = ()

type UColAttribute = CInt
type UColAttributeValue = CInt

toUAttribute :: Attribute -> (UColAttribute, UColAttributeValue)
toUAttribute :: Attribute -> (UCollationResult, UCollationResult)
toUAttribute (French Bool
v)
    = ((UCollationResult
0), Bool -> UCollationResult
toOO Bool
v)
{-# LINE 163 "Data/Text/ICU/Collate.hsc" #-}
toUAttribute (AlternateHandling v)
    = ((1), toAH v)
{-# LINE 165 "Data/Text/ICU/Collate.hsc" #-}
toUAttribute (CaseFirst v)
    = ((2), toCF v)
{-# LINE 167 "Data/Text/ICU/Collate.hsc" #-}
toUAttribute (CaseLevel v)
    = ((3), toOO v)
{-# LINE 169 "Data/Text/ICU/Collate.hsc" #-}
toUAttribute (NormalizationMode v)
    = ((4), toOO v)
{-# LINE 171 "Data/Text/ICU/Collate.hsc" #-}
toUAttribute (Strength v)
    = ((5), toS v)
{-# LINE 173 "Data/Text/ICU/Collate.hsc" #-}
toUAttribute (HiraganaQuaternaryMode v)
    = ((6), toOO v)
{-# LINE 175 "Data/Text/ICU/Collate.hsc" #-}
toUAttribute (Numeric v)
    = ((7), toOO v)
{-# LINE 177 "Data/Text/ICU/Collate.hsc" #-}

toOO :: Bool -> UColAttributeValue
toOO :: Bool -> UCollationResult
toOO Bool
False = UCollationResult
16
{-# LINE 180 "Data/Text/ICU/Collate.hsc" #-}
toOO True  = 17
{-# LINE 181 "Data/Text/ICU/Collate.hsc" #-}

toAH :: AlternateHandling -> UColAttributeValue
toAH :: AlternateHandling -> UCollationResult
toAH AlternateHandling
NonIgnorable = UCollationResult
21
{-# LINE 184 "Data/Text/ICU/Collate.hsc" #-}
toAH Shifted      = 20
{-# LINE 185 "Data/Text/ICU/Collate.hsc" #-}

toCF :: Maybe CaseFirst -> UColAttributeValue
toCF :: Maybe CaseFirst -> UCollationResult
toCF Maybe CaseFirst
Nothing           = UCollationResult
16
{-# LINE 188 "Data/Text/ICU/Collate.hsc" #-}
toCF (Just UpperFirst) = 25
{-# LINE 189 "Data/Text/ICU/Collate.hsc" #-}
toCF (Just LowerFirst) = 24
{-# LINE 190 "Data/Text/ICU/Collate.hsc" #-}

toS :: Strength -> UColAttributeValue
toS :: Strength -> UCollationResult
toS Strength
Primary    = UCollationResult
0
{-# LINE 193 "Data/Text/ICU/Collate.hsc" #-}
toS Secondary  = 1
{-# LINE 194 "Data/Text/ICU/Collate.hsc" #-}
toS Tertiary   = 2
{-# LINE 195 "Data/Text/ICU/Collate.hsc" #-}
toS Quaternary = 3
{-# LINE 196 "Data/Text/ICU/Collate.hsc" #-}
toS Identical  = 15
{-# LINE 197 "Data/Text/ICU/Collate.hsc" #-}

fromOO :: UColAttributeValue -> Bool
fromOO :: UCollationResult -> Bool
fromOO (UCollationResult
16) = Bool
False
{-# LINE 200 "Data/Text/ICU/Collate.hsc" #-}
fromOO (17)  = True
{-# LINE 201 "Data/Text/ICU/Collate.hsc" #-}
fromOO bad = valueError "fromOO" bad

fromAH :: UColAttributeValue -> AlternateHandling
fromAH :: UCollationResult -> AlternateHandling
fromAH (UCollationResult
21) = AlternateHandling
NonIgnorable
{-# LINE 205 "Data/Text/ICU/Collate.hsc" #-}
fromAH (20)       = Shifted
{-# LINE 206 "Data/Text/ICU/Collate.hsc" #-}
fromAH bad = valueError "fromAH" bad

fromCF :: UColAttributeValue -> Maybe CaseFirst
fromCF :: UCollationResult -> Maybe CaseFirst
fromCF (UCollationResult
16)         = Maybe CaseFirst
forall a. Maybe a
Nothing
{-# LINE 210 "Data/Text/ICU/Collate.hsc" #-}
fromCF (25) = Just UpperFirst
{-# LINE 211 "Data/Text/ICU/Collate.hsc" #-}
fromCF (24) = Just LowerFirst
{-# LINE 212 "Data/Text/ICU/Collate.hsc" #-}
fromCF bad = valueError "fromCF" bad

fromS :: UColAttributeValue -> Strength
fromS :: UCollationResult -> Strength
fromS (UCollationResult
0)    = Strength
Primary
{-# LINE 216 "Data/Text/ICU/Collate.hsc" #-}
fromS (1)  = Secondary
{-# LINE 217 "Data/Text/ICU/Collate.hsc" #-}
fromS (2)   = Tertiary
{-# LINE 218 "Data/Text/ICU/Collate.hsc" #-}
fromS (3) = Quaternary
{-# LINE 219 "Data/Text/ICU/Collate.hsc" #-}
fromS (15)  = Identical
{-# LINE 220 "Data/Text/ICU/Collate.hsc" #-}
fromS bad = valueError "fromS" bad

fromUAttribute :: UColAttribute -> UColAttributeValue -> Attribute
fromUAttribute :: UCollationResult -> UCollationResult -> Attribute
fromUAttribute UCollationResult
key UCollationResult
val =
  case UCollationResult
key of
    (UCollationResult
0)         -> Bool -> Attribute
French (UCollationResult -> Bool
fromOO UCollationResult
val)
{-# LINE 226 "Data/Text/ICU/Collate.hsc" #-}
    (1)       -> AlternateHandling (fromAH val)
{-# LINE 227 "Data/Text/ICU/Collate.hsc" #-}
    (2)               -> CaseFirst (fromCF val)
{-# LINE 228 "Data/Text/ICU/Collate.hsc" #-}
    (3)               -> CaseLevel (fromOO val)
{-# LINE 229 "Data/Text/ICU/Collate.hsc" #-}
    (4)       -> NormalizationMode (fromOO val)
{-# LINE 230 "Data/Text/ICU/Collate.hsc" #-}
    (5)                 -> Strength (fromS val)
{-# LINE 231 "Data/Text/ICU/Collate.hsc" #-}
    (6) -> HiraganaQuaternaryMode (fromOO val)
{-# LINE 232 "Data/Text/ICU/Collate.hsc" #-}
    (7)        -> Numeric (fromOO val)
{-# LINE 233 "Data/Text/ICU/Collate.hsc" #-}
    _ -> valueError "fromUAttribute" key

valueError :: Show a => String -> a -> z
valueError :: forall a z. Show a => String -> a -> z
valueError String
func a
bad = String -> z
forall a. HasCallStack => String -> a
error (String
"Data.Text.ICU.Collate." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
func String -> ShowS
forall a. [a] -> [a] -> [a]
++
                             String
": invalid value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
bad)

type UCollationResult = CInt

-- | Open a 'Collator' for comparing strings.
open :: LocaleName
     -- ^ The locale containing the required collation rules.
     -> IO MCollator
open :: LocaleName -> IO MCollator
open LocaleName
loc = IO (Ptr UCollator) -> IO MCollator
wrap (IO (Ptr UCollator) -> IO MCollator)
-> IO (Ptr UCollator) -> IO MCollator
forall a b. (a -> b) -> a -> b
$ LocaleName -> (CString -> IO (Ptr UCollator)) -> IO (Ptr UCollator)
forall a. LocaleName -> (CString -> IO a) -> IO a
withLocaleName LocaleName
loc ((Ptr UCollationResult -> IO (Ptr UCollator)) -> IO (Ptr UCollator)
forall a. (Ptr UCollationResult -> IO a) -> IO a
handleError ((Ptr UCollationResult -> IO (Ptr UCollator))
 -> IO (Ptr UCollator))
-> (CString -> Ptr UCollationResult -> IO (Ptr UCollator))
-> CString
-> IO (Ptr UCollator)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> Ptr UCollationResult -> IO (Ptr UCollator)
ucol_open)

-- | Set the value of an 'MCollator' attribute.
setAttribute :: MCollator -> Attribute -> IO ()
setAttribute :: MCollator -> Attribute -> IO ()
setAttribute MCollator
c Attribute
a =
  MCollator -> (Ptr UCollator -> IO ()) -> IO ()
forall a. MCollator -> (Ptr UCollator -> IO a) -> IO a
withCollator MCollator
c ((Ptr UCollator -> IO ()) -> IO ())
-> (Ptr UCollator -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr UCollator
cptr ->
    (Ptr UCollationResult -> IO ()) -> IO ()
forall a. (Ptr UCollationResult -> IO a) -> IO a
handleError ((Ptr UCollationResult -> IO ()) -> IO ())
-> (Ptr UCollationResult -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ (UCollationResult
 -> UCollationResult -> Ptr UCollationResult -> IO ())
-> (UCollationResult, UCollationResult)
-> Ptr UCollationResult
-> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Ptr UCollator
-> UCollationResult
-> UCollationResult
-> Ptr UCollationResult
-> IO ()
ucol_setAttribute Ptr UCollator
cptr) (Attribute -> (UCollationResult, UCollationResult)
toUAttribute Attribute
a)

-- | Get the value of an 'MCollator' attribute.
--
-- It is safe to provide a dummy argument to an 'Attribute' constructor when
-- using this function, so the following will work:
--
-- > getAttribute mcol (NormalizationMode undefined)
getAttribute :: MCollator -> Attribute -> IO Attribute
getAttribute :: MCollator -> Attribute -> IO Attribute
getAttribute MCollator
c Attribute
a = do
  let name :: UCollationResult
name = (UCollationResult, UCollationResult) -> UCollationResult
forall a b. (a, b) -> a
fst (Attribute -> (UCollationResult, UCollationResult)
toUAttribute Attribute
a)
  UCollationResult
val <- MCollator
-> (Ptr UCollator -> IO UCollationResult) -> IO UCollationResult
forall a. MCollator -> (Ptr UCollator -> IO a) -> IO a
withCollator MCollator
c ((Ptr UCollator -> IO UCollationResult) -> IO UCollationResult)
-> (Ptr UCollator -> IO UCollationResult) -> IO UCollationResult
forall a b. (a -> b) -> a -> b
$ \Ptr UCollator
cptr -> (Ptr UCollationResult -> IO UCollationResult)
-> IO UCollationResult
forall a. (Ptr UCollationResult -> IO a) -> IO a
handleError ((Ptr UCollationResult -> IO UCollationResult)
 -> IO UCollationResult)
-> (Ptr UCollationResult -> IO UCollationResult)
-> IO UCollationResult
forall a b. (a -> b) -> a -> b
$ Ptr UCollator
-> UCollationResult -> Ptr UCollationResult -> IO UCollationResult
ucol_getAttribute Ptr UCollator
cptr UCollationResult
name
  Attribute -> IO Attribute
forall (m :: * -> *) a. Monad m => a -> m a
return (Attribute -> IO Attribute) -> Attribute -> IO Attribute
forall a b. (a -> b) -> a -> b
$! UCollationResult -> UCollationResult -> Attribute
fromUAttribute UCollationResult
name UCollationResult
val

-- | Compare two strings.
collate :: MCollator -> Text -> Text -> IO Ordering
collate :: MCollator -> Text -> Text -> IO Ordering
collate MCollator
c Text
a Text
b =
  MCollator -> (Ptr UCollator -> IO Ordering) -> IO Ordering
forall a. MCollator -> (Ptr UCollator -> IO a) -> IO a
withCollator MCollator
c ((Ptr UCollator -> IO Ordering) -> IO Ordering)
-> (Ptr UCollator -> IO Ordering) -> IO Ordering
forall a b. (a -> b) -> a -> b
$ \Ptr UCollator
cptr ->
    Text -> (Ptr Word8 -> I8 -> IO Ordering) -> IO Ordering
forall a. Text -> (Ptr Word8 -> I8 -> IO a) -> IO a
useAsPtr Text
a ((Ptr Word8 -> I8 -> IO Ordering) -> IO Ordering)
-> (Ptr Word8 -> I8 -> IO Ordering) -> IO Ordering
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
aptr I8
alen ->
      Text -> (Ptr Word8 -> I8 -> IO Ordering) -> IO Ordering
forall a. Text -> (Ptr Word8 -> I8 -> IO a) -> IO a
useAsPtr Text
b ((Ptr Word8 -> I8 -> IO Ordering) -> IO Ordering)
-> (Ptr Word8 -> I8 -> IO Ordering) -> IO Ordering
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bptr I8
blen ->
        (UCollationResult -> Ordering)
-> IO UCollationResult -> IO Ordering
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UCollationResult -> Ordering
forall a. Integral a => a -> Ordering
asOrdering (IO UCollationResult -> IO Ordering)
-> ((Ptr UCollationResult -> IO UCollationResult)
    -> IO UCollationResult)
-> (Ptr UCollationResult -> IO UCollationResult)
-> IO Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr UCollationResult -> IO UCollationResult)
-> IO UCollationResult
forall a. (Ptr UCollationResult -> IO a) -> IO a
handleError ((Ptr UCollationResult -> IO UCollationResult) -> IO Ordering)
-> (Ptr UCollationResult -> IO UCollationResult) -> IO Ordering
forall a b. (a -> b) -> a -> b
$

{-# LINE 273 "Data/Text/ICU/Collate.hsc" #-}
        Ptr UCollator
-> Ptr Word8
-> Int32
-> Ptr Word8
-> Int32
-> Ptr UCollationResult
-> IO UCollationResult
ucol_strcollUTF8

{-# LINE 277 "Data/Text/ICU/Collate.hsc" #-}
        Ptr UCollator
cptr Ptr Word8
aptr (I8 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral I8
alen) Ptr Word8
bptr (I8 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral I8
blen)

-- | Compare two 'CharIterator's.
--
-- If either iterator was constructed from a 'ByteString', it does not need
-- to be copied or converted internally, so this function can be quite
-- cheap.
collateIter :: MCollator -> CharIterator -> CharIterator -> IO Ordering
collateIter :: MCollator -> CharIterator -> CharIterator -> IO Ordering
collateIter MCollator
c CharIterator
a CharIterator
b =
  (UCollationResult -> Ordering)
-> IO UCollationResult -> IO Ordering
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UCollationResult -> Ordering
forall a. Integral a => a -> Ordering
asOrdering (IO UCollationResult -> IO Ordering)
-> ((Ptr UCollator -> IO UCollationResult) -> IO UCollationResult)
-> (Ptr UCollator -> IO UCollationResult)
-> IO Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MCollator
-> (Ptr UCollator -> IO UCollationResult) -> IO UCollationResult
forall a. MCollator -> (Ptr UCollator -> IO a) -> IO a
withCollator MCollator
c ((Ptr UCollator -> IO UCollationResult) -> IO Ordering)
-> (Ptr UCollator -> IO UCollationResult) -> IO Ordering
forall a b. (a -> b) -> a -> b
$ \Ptr UCollator
cptr ->
    CharIterator
-> (Ptr UCharIterator -> IO UCollationResult)
-> IO UCollationResult
forall a. CharIterator -> (Ptr UCharIterator -> IO a) -> IO a
withCharIterator CharIterator
a ((Ptr UCharIterator -> IO UCollationResult) -> IO UCollationResult)
-> (Ptr UCharIterator -> IO UCollationResult)
-> IO UCollationResult
forall a b. (a -> b) -> a -> b
$ \Ptr UCharIterator
ai ->
      CharIterator
-> (Ptr UCharIterator -> IO UCollationResult)
-> IO UCollationResult
forall a. CharIterator -> (Ptr UCharIterator -> IO a) -> IO a
withCharIterator CharIterator
b ((Ptr UCharIterator -> IO UCollationResult) -> IO UCollationResult)
-> (Ptr UCharIterator -> IO UCollationResult)
-> IO UCollationResult
forall a b. (a -> b) -> a -> b
$ (Ptr UCollationResult -> IO UCollationResult)
-> IO UCollationResult
forall a. (Ptr UCollationResult -> IO a) -> IO a
handleError ((Ptr UCollationResult -> IO UCollationResult)
 -> IO UCollationResult)
-> (Ptr UCharIterator
    -> Ptr UCollationResult -> IO UCollationResult)
-> Ptr UCharIterator
-> IO UCollationResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr UCollator
-> Ptr UCharIterator
-> Ptr UCharIterator
-> Ptr UCollationResult
-> IO UCollationResult
ucol_strcollIter Ptr UCollator
cptr Ptr UCharIterator
ai

-- | Create a key for sorting the 'Text' using the given 'Collator'.
-- The result of comparing two 'ByteString's that have been
-- transformed with 'sortKey' will be the same as the result of
-- 'collate' on the two untransformed 'Text's.
sortKey :: MCollator -> Text -> IO ByteString
sortKey :: MCollator -> Text -> IO ByteString
sortKey MCollator
c Text
t
    | Text -> Bool
T.null Text
t = ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
empty
    | Bool
otherwise = do
  MCollator -> (Ptr UCollator -> IO ByteString) -> IO ByteString
forall a. MCollator -> (Ptr UCollator -> IO a) -> IO a
withCollator MCollator
c ((Ptr UCollator -> IO ByteString) -> IO ByteString)
-> (Ptr UCollator -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr UCollator
cptr ->
    Text -> (Ptr UChar -> I16 -> IO ByteString) -> IO ByteString
forall a. Text -> (Ptr UChar -> I16 -> IO a) -> IO a
useAsUCharPtr Text
t ((Ptr UChar -> I16 -> IO ByteString) -> IO ByteString)
-> (Ptr UChar -> I16 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr UChar
tptr I16
tlen -> do
      let len :: Int32
len = I16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral I16
tlen
          loop :: Int32 -> IO ByteString
loop Int32
n = do
            ForeignPtr Word8
fp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocByteString (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
n)
            Int32
i <- ForeignPtr Word8 -> (Ptr Word8 -> IO Int32) -> IO Int32
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO Int32) -> IO Int32)
-> (Ptr Word8 -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr UCollator
-> Ptr UChar -> Int32 -> Ptr Word8 -> Int32 -> IO Int32
ucol_getSortKey Ptr UCollator
cptr Ptr UChar
tptr Int32
len Ptr Word8
p Int32
n
            let j :: Int
j = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i
            case Any
forall a. HasCallStack => a
undefined of
              Any
_ | Int32
i Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
0         -> String -> IO ByteString
forall a. HasCallStack => String -> a
error String
"Data.Text.ICU.Collate.sortKey: internal error"
                | Int32
i Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
> Int32
n          -> Int32 -> IO ByteString
loop Int32
i
                | Int32
i Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32
n Int32 -> Int32 -> Int32
forall a. Integral a => a -> a -> a
`div` Int32
2 -> Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
j ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
op ->
                                    Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
p Ptr Word8
op (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i)
                | Bool
otherwise      -> ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp Int
0 Int
j
      Int32 -> IO ByteString
loop (Int32 -> Int32 -> Int32
forall a. Ord a => a -> a -> a
min (Int32
len Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
4) Int32
8)

-- | Make a safe copy of a mutable 'MCollator' for use in pure code.
-- Subsequent changes to the 'MCollator' will not affect the state of
-- the returned 'Collator'.
freeze :: MCollator -> IO Collator
freeze :: MCollator -> IO Collator
freeze = (MCollator -> Collator) -> IO MCollator -> IO Collator
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MCollator -> Collator
C (IO MCollator -> IO Collator)
-> (MCollator -> IO MCollator) -> MCollator -> IO Collator
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MCollator -> IO MCollator
clone

-- | Make a copy of a mutable 'MCollator'.
-- Subsequent changes to the input 'MCollator' will not affect the state of
-- the returned 'MCollator'.
clone :: MCollator -> IO MCollator
clone :: MCollator -> IO MCollator
clone MCollator
c =
  IO (Ptr UCollator) -> IO MCollator
wrap (IO (Ptr UCollator) -> IO MCollator)
-> IO (Ptr UCollator) -> IO MCollator
forall a b. (a -> b) -> a -> b
$ MCollator
-> (Ptr UCollator -> IO (Ptr UCollator)) -> IO (Ptr UCollator)
forall a. MCollator -> (Ptr UCollator -> IO a) -> IO a
withCollator MCollator
c ((Ptr UCollator -> IO (Ptr UCollator)) -> IO (Ptr UCollator))
-> (Ptr UCollator -> IO (Ptr UCollator)) -> IO (Ptr UCollator)
forall a b. (a -> b) -> a -> b
$ \Ptr UCollator
cptr ->
    Int32 -> (Ptr Int32 -> IO (Ptr UCollator)) -> IO (Ptr UCollator)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Int32
1)
{-# LINE 326 "Data/Text/ICU/Collate.hsc" #-}
      (handleError . ucol_safeClone cptr nullPtr)

foreign import ccall unsafe "hs_text_icu.h __hs_ucol_open" ucol_open
    :: CString -> Ptr UErrorCode -> IO (Ptr UCollator)

foreign import ccall unsafe "hs_text_icu.h __hs_ucol_getAttribute" ucol_getAttribute
    :: Ptr UCollator -> UColAttribute -> Ptr UErrorCode -> IO UColAttributeValue

foreign import ccall unsafe "hs_text_icu.h __hs_ucol_setAttribute" ucol_setAttribute
    :: Ptr UCollator -> UColAttribute -> UColAttributeValue -> Ptr UErrorCode -> IO ()


{-# LINE 338 "Data/Text/ICU/Collate.hsc" #-}
foreign import ccall unsafe "hs_text_icu.h __hs_ucol_strcollUTF8" ucol_strcollUTF8
    :: Ptr UCollator -> Ptr Word8 -> Int32 -> Ptr Word8 -> Int32
    -> Ptr UErrorCode -> IO UCollationResult

{-# LINE 346 "Data/Text/ICU/Collate.hsc" #-}

foreign import ccall unsafe "hs_text_icu.h __hs_ucol_getSortKey" ucol_getSortKey
    :: Ptr UCollator -> Ptr UChar -> Int32 -> Ptr Word8 -> Int32
    -> IO Int32

foreign import ccall unsafe "hs_text_icu.h __hs_ucol_strcollIter" ucol_strcollIter
    :: Ptr UCollator -> Ptr UCharIterator -> Ptr UCharIterator -> Ptr UErrorCode
    -> IO UCollationResult

foreign import ccall unsafe "hs_text_icu.h __hs_ucol_safeClone" ucol_safeClone
        :: Ptr UCollator -> Ptr a -> Ptr Int32 -> Ptr UErrorCode
        -> IO (Ptr UCollator)