{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Text.Collate.Collator
  ( Collator(..)
  , SortKey(..)
  , VariableWeighting(..)
  , rootCollator
  , setVariableWeighting
  , setFrenchAccents
  , setUpperBeforeLower
  , setNormalization
  , collator
  , defaultCollatorOptions
  , collatorFor
  , mkCollator
  )
where

import Text.Collate.Lang
import Text.Collate.Tailorings
import Text.Collate.Collation (getCollationElements, Collation(..),
                               CollationElement(..), VariableWeighting(..))
import Data.Word (Word16)
import Data.String
import qualified Data.Text.Normalize as N
import qualified Data.Text as T
import Data.Text (Text)
import Data.Ord (comparing)
import Data.Char (ord)
import Data.List (intercalate)
import Text.Printf (printf)
import Language.Haskell.TH.Quote (QuasiQuoter(..))
#if MIN_VERSION_base(4,11,0)
#else
import Data.Semigroup (Semigroup(..))
#endif

data CollatorOptions =
  CollatorOptions
  { CollatorOptions -> VariableWeighting
optVariableWeighting  :: VariableWeighting  -- ^ Method for handling
      -- variable elements (see <http://www.unicode.org/reports/tr10/>,
      -- Tables 11 and 12).
  , CollatorOptions -> Bool
optFrenchAccents      :: Bool -- ^ If True, secondary weights are scanned
      -- in reverse order, so we get the sorting
      -- "cote côte coté côté" instead of "cote coté côte côté"
  , CollatorOptions -> Bool
optUpperBeforeLower   :: Bool -- ^ Sort uppercase letters before lower
  , CollatorOptions -> Bool
optNormalize          :: Bool -- ^ If True, strings are normalized
      -- to NFD before collation elements are constructed.  If the input
      -- is already normalized, this option can be set to False for
      -- better performance.
  , CollatorOptions -> Collation
optCollation          :: Collation  -- ^ The collation to use.
  } deriving (Int -> CollatorOptions -> ShowS
[CollatorOptions] -> ShowS
CollatorOptions -> String
(Int -> CollatorOptions -> ShowS)
-> (CollatorOptions -> String)
-> ([CollatorOptions] -> ShowS)
-> Show CollatorOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CollatorOptions] -> ShowS
$cshowList :: [CollatorOptions] -> ShowS
show :: CollatorOptions -> String
$cshow :: CollatorOptions -> String
showsPrec :: Int -> CollatorOptions -> ShowS
$cshowsPrec :: Int -> CollatorOptions -> ShowS
Show, CollatorOptions -> CollatorOptions -> Bool
(CollatorOptions -> CollatorOptions -> Bool)
-> (CollatorOptions -> CollatorOptions -> Bool)
-> Eq CollatorOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CollatorOptions -> CollatorOptions -> Bool
$c/= :: CollatorOptions -> CollatorOptions -> Bool
== :: CollatorOptions -> CollatorOptions -> Bool
$c== :: CollatorOptions -> CollatorOptions -> Bool
Eq, Eq CollatorOptions
Eq CollatorOptions
-> (CollatorOptions -> CollatorOptions -> Ordering)
-> (CollatorOptions -> CollatorOptions -> Bool)
-> (CollatorOptions -> CollatorOptions -> Bool)
-> (CollatorOptions -> CollatorOptions -> Bool)
-> (CollatorOptions -> CollatorOptions -> Bool)
-> (CollatorOptions -> CollatorOptions -> CollatorOptions)
-> (CollatorOptions -> CollatorOptions -> CollatorOptions)
-> Ord CollatorOptions
CollatorOptions -> CollatorOptions -> Bool
CollatorOptions -> CollatorOptions -> Ordering
CollatorOptions -> CollatorOptions -> CollatorOptions
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CollatorOptions -> CollatorOptions -> CollatorOptions
$cmin :: CollatorOptions -> CollatorOptions -> CollatorOptions
max :: CollatorOptions -> CollatorOptions -> CollatorOptions
$cmax :: CollatorOptions -> CollatorOptions -> CollatorOptions
>= :: CollatorOptions -> CollatorOptions -> Bool
$c>= :: CollatorOptions -> CollatorOptions -> Bool
> :: CollatorOptions -> CollatorOptions -> Bool
$c> :: CollatorOptions -> CollatorOptions -> Bool
<= :: CollatorOptions -> CollatorOptions -> Bool
$c<= :: CollatorOptions -> CollatorOptions -> Bool
< :: CollatorOptions -> CollatorOptions -> Bool
$c< :: CollatorOptions -> CollatorOptions -> Bool
compare :: CollatorOptions -> CollatorOptions -> Ordering
$ccompare :: CollatorOptions -> CollatorOptions -> Ordering
$cp1Ord :: Eq CollatorOptions
Ord)

showWordList :: [Word16] -> String
showWordList :: [Word16] -> String
showWordList [Word16]
ws =
    String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
","
            ((Word16 -> String) -> [Word16] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"0x%04X" (Int -> String) -> (Word16 -> Int) -> Word16 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word16 -> Int)) [Word16]
ws) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"

newtype SortKey = SortKey [Word16]
  deriving (SortKey -> SortKey -> Bool
(SortKey -> SortKey -> Bool)
-> (SortKey -> SortKey -> Bool) -> Eq SortKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SortKey -> SortKey -> Bool
$c/= :: SortKey -> SortKey -> Bool
== :: SortKey -> SortKey -> Bool
$c== :: SortKey -> SortKey -> Bool
Eq, Eq SortKey
Eq SortKey
-> (SortKey -> SortKey -> Ordering)
-> (SortKey -> SortKey -> Bool)
-> (SortKey -> SortKey -> Bool)
-> (SortKey -> SortKey -> Bool)
-> (SortKey -> SortKey -> Bool)
-> (SortKey -> SortKey -> SortKey)
-> (SortKey -> SortKey -> SortKey)
-> Ord SortKey
SortKey -> SortKey -> Bool
SortKey -> SortKey -> Ordering
SortKey -> SortKey -> SortKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SortKey -> SortKey -> SortKey
$cmin :: SortKey -> SortKey -> SortKey
max :: SortKey -> SortKey -> SortKey
$cmax :: SortKey -> SortKey -> SortKey
>= :: SortKey -> SortKey -> Bool
$c>= :: SortKey -> SortKey -> Bool
> :: SortKey -> SortKey -> Bool
$c> :: SortKey -> SortKey -> Bool
<= :: SortKey -> SortKey -> Bool
$c<= :: SortKey -> SortKey -> Bool
< :: SortKey -> SortKey -> Bool
$c< :: SortKey -> SortKey -> Bool
compare :: SortKey -> SortKey -> Ordering
$ccompare :: SortKey -> SortKey -> Ordering
$cp1Ord :: Eq SortKey
Ord)

instance Show SortKey where
 show :: SortKey -> String
show (SortKey [Word16]
ws) = String
"SortKey " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Word16] -> String
showWordList [Word16]
ws

-- Note that & b < q <<< Q is the same as & b < q, & q <<< Q
-- Another syntactic shortcut is:
-- & a <* bcd-gp-s => & a < b < c < d < e < f < g < p < q < r < s
-- & a =* bB => & a = b = B (without that, we have a contraction)
-- &[before 2] a << b => sorts sorts b before a


data Collator = Collator { Collator -> Text -> Text -> Ordering
collate         :: Text -> Text -> Ordering
                         , Collator -> Text -> SortKey
sortKey         :: Text -> SortKey
                         , Collator -> CollatorOptions
collatorOptions :: CollatorOptions }

instance IsString Collator where
 fromString :: String -> Collator
fromString = Lang -> Collator
collatorFor (Lang -> Collator) -> (String -> Lang) -> String -> Collator
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Lang
forall a. IsString a => String -> a
fromString

-- | Default collator based on DUCET table (@allkeys.txt@).
rootCollator :: Collator
rootCollator :: Collator
rootCollator =
  CollatorOptions -> Collator
mkCollator CollatorOptions
defaultCollatorOptions{ optCollation :: Collation
optCollation = Collation
ducetCollation }

-- | Set method for handling variable elements (punctuation
-- and spaces): see <http://www.unicode.org/reports/tr10/>,
-- Tables 11 and 12.
setVariableWeighting :: VariableWeighting -> Collator -> Collator
setVariableWeighting :: VariableWeighting -> Collator -> Collator
setVariableWeighting VariableWeighting
w Collator
coll =
  CollatorOptions -> Collator
mkCollator (Collator -> CollatorOptions
collatorOptions Collator
coll){ optVariableWeighting :: VariableWeighting
optVariableWeighting = VariableWeighting
w }

-- | The Unicode Collation Algorithm expects input to be normalized
-- into its canonical decomposition (NFD). By default, collators perform
-- this normalization. If your input is already normalized, you can increase
-- performance by disabling this step: @setNormalization False@.
setNormalization :: Bool -> Collator -> Collator
setNormalization :: Bool -> Collator -> Collator
setNormalization Bool
normalize Collator
coll =
  CollatorOptions -> Collator
mkCollator (Collator -> CollatorOptions
collatorOptions Collator
coll){ optNormalize :: Bool
optNormalize = Bool
normalize }

-- | @setFrenchAccents True@ causes secondary weights to be scanned
-- in reverse order, so we get the sorting
-- @cote côte coté côté@ instead of @cote coté côte côté@.
-- The default is usually @False@, except for @fr-CA@ where it is @True@.
setFrenchAccents :: Bool -> Collator -> Collator
setFrenchAccents :: Bool -> Collator -> Collator
setFrenchAccents Bool
frAccents Collator
coll =
  CollatorOptions -> Collator
mkCollator (Collator -> CollatorOptions
collatorOptions Collator
coll){ optFrenchAccents :: Bool
optFrenchAccents = Bool
frAccents }

-- | Most collations default to sorting lowercase letters before
-- uppercase (exceptions: @mt@, @da@, @cu@).  To select the opposite
-- behavior, use @setUpperBeforeLower True@.
setUpperBeforeLower :: Bool -> Collator -> Collator
setUpperBeforeLower :: Bool -> Collator -> Collator
setUpperBeforeLower Bool
upperBefore Collator
coll =
  CollatorOptions -> Collator
mkCollator (Collator -> CollatorOptions
collatorOptions Collator
coll){ optUpperBeforeLower :: Bool
optUpperBeforeLower = Bool
upperBefore }

-- | Create a collator at compile time based on a BCP 47 language
-- tag: e.g., @[collator|es-u-co-trad|]@.  Requires the @QuasiQuotes@ extension.
collator :: QuasiQuoter
collator :: QuasiQuoter
collator = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
  { quoteExp :: String -> Q Exp
quoteExp = \String
langtag -> do
      case Text -> Either String Lang
parseLang (String -> Text
T.pack String
langtag) of
        Left String
e -> do
          String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ String
"Could not parse BCP47 tag " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
langtag String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
e
        Right Lang
lang ->
          case Lang -> [(Lang, Collation)] -> Maybe (Lang, Collation)
forall a. Lang -> [(Lang, a)] -> Maybe (Lang, a)
lookupLang Lang
lang [(Lang, Collation)]
tailorings of
            Maybe (Lang, Collation)
Nothing     -> [| rootCollator |]
            Just (Lang
_, Collation
_) -> [| collatorFor lang |]
  , quotePat :: String -> Q Pat
quotePat = String -> Q Pat
forall a. HasCallStack => a
undefined
  , quoteType :: String -> Q Type
quoteType = String -> Q Type
forall a. HasCallStack => a
undefined
  , quoteDec :: String -> Q [Dec]
quoteDec = String -> Q [Dec]
forall a. HasCallStack => a
undefined
  }

-- | Default 'CollatorOptions'.
defaultCollatorOptions :: CollatorOptions
defaultCollatorOptions :: CollatorOptions
defaultCollatorOptions =
  CollatorOptions :: VariableWeighting
-> Bool -> Bool -> Bool -> Collation -> CollatorOptions
CollatorOptions
  { optVariableWeighting :: VariableWeighting
optVariableWeighting = VariableWeighting
NonIgnorable
  , optFrenchAccents :: Bool
optFrenchAccents     = Bool
False
  , optUpperBeforeLower :: Bool
optUpperBeforeLower  = Bool
False
  , optNormalize :: Bool
optNormalize         = Bool
True
  , optCollation :: Collation
optCollation         = Collation
ducetCollation
  }

-- | Returns a collator based on a BCP 47 language tag.
-- If no exact match is found, we try to find the best match
-- (falling back to the root collation if nothing else succeeds).
-- If something other than the default collation for a language
-- is desired, the @co@ keyword of the unicode extensions can be
-- used (e.g. @es-u-co-trad@ for traditional Spanish).
-- Other unicode extensions affect the collator options:
--
-- - The @kb@ keyword has the same effect as
--   'setFrenchAccents' (e.g. @fr-FR-u-kb-true@).
-- - The @ka@ keyword has the same effect as 'setVariableWeight'
--   (e.g. @fr-FR-u-kb-ka-shifted@ or @en-u-ka-noignore@).
-- - The @kf@ keyword has the same effect as 'setUpperBeforeLower'
--   (e.g. @fr-u-kf-upper@ or @fr-u-kf-lower@).
-- - The @kk@ keyword has the same effect as 'setNormalization'
--   (e.g. @fr-u-kk-false@).
collatorFor :: Lang -> Collator
collatorFor :: Lang -> Collator
collatorFor Lang
lang = CollatorOptions -> Collator
mkCollator CollatorOptions
opts
  where
    opts :: CollatorOptions
opts = CollatorOptions
defaultCollatorOptions{
             optFrenchAccents :: Bool
optFrenchAccents =
               case Text -> [(Text, [(Text, Text)])] -> Maybe [(Text, Text)]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"u" [(Text, [(Text, Text)])]
exts Maybe [(Text, Text)]
-> ([(Text, Text)] -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"kb" of
                 Just Text
""       -> Bool
True
                                       -- true is default attribute value
                 Just Text
"true"   -> Bool
True
                 Just Text
_        -> Bool
False
                 Maybe Text
Nothing       -> Lang -> Text
langLanguage Lang
lang Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"cu" Bool -> Bool -> Bool
||
                   (Lang -> Text
langLanguage Lang
lang Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"fr" Bool -> Bool -> Bool
&& Lang -> Maybe Text
langRegion Lang
lang Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"CA"),
             optVariableWeighting :: VariableWeighting
optVariableWeighting =
               case Text -> [(Text, [(Text, Text)])] -> Maybe [(Text, Text)]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"u" [(Text, [(Text, Text)])]
exts Maybe [(Text, Text)]
-> ([(Text, Text)] -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"ka" of
                 Just Text
""         -> VariableWeighting
NonIgnorable
                 Just Text
"noignore" -> VariableWeighting
NonIgnorable
                 Just Text
"shifted"  -> VariableWeighting
Shifted
                 Maybe Text
Nothing | Lang -> Text
langLanguage Lang
lang Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"th"
                                 -> VariableWeighting
Shifted
                 Maybe Text
_               -> VariableWeighting
NonIgnorable,
             optUpperBeforeLower :: Bool
optUpperBeforeLower =
               case Text -> [(Text, [(Text, Text)])] -> Maybe [(Text, Text)]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"u" [(Text, [(Text, Text)])]
exts Maybe [(Text, Text)]
-> ([(Text, Text)] -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"kf" of
                 Just Text
""         -> Bool
True
                 Just Text
"upper"    -> Bool
True
                 Just Text
_          -> Bool
False
                 Maybe Text
Nothing         -> Lang -> Text
langLanguage Lang
lang Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"mt" Bool -> Bool -> Bool
||
                                    Lang -> Text
langLanguage Lang
lang Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"da" Bool -> Bool -> Bool
||
                                    Lang -> Text
langLanguage Lang
lang Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"cu",
             optNormalize :: Bool
optNormalize =
               case Text -> [(Text, [(Text, Text)])] -> Maybe [(Text, Text)]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"u" [(Text, [(Text, Text)])]
exts Maybe [(Text, Text)]
-> ([(Text, Text)] -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"kk" of
                 Just Text
""         -> Bool
True
                 Just Text
"true"     -> Bool
True
                 Just Text
"false"    -> Bool
False
                 Maybe Text
_               -> Bool
True,
             optCollation :: Collation
optCollation = Collation
ducetCollation Collation -> Collation -> Collation
forall a. Semigroup a => a -> a -> a
<> Collation
tailoring }
    tailoring :: Collation
tailoring = Collation
-> ((Lang, Collation) -> Collation)
-> Maybe (Lang, Collation)
-> Collation
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Collation
forall a. Monoid a => a
mempty (Lang, Collation) -> Collation
forall a b. (a, b) -> b
snd (Maybe (Lang, Collation) -> Collation)
-> Maybe (Lang, Collation) -> Collation
forall a b. (a -> b) -> a -> b
$ Lang -> [(Lang, Collation)] -> Maybe (Lang, Collation)
forall a. Lang -> [(Lang, a)] -> Maybe (Lang, a)
lookupLang Lang
lang [(Lang, Collation)]
tailorings
    exts :: [(Text, [(Text, Text)])]
exts = Lang -> [(Text, [(Text, Text)])]
langExtensions Lang
lang

-- | Returns a collator constructed using the collation and
-- variable weighting specified in the options.
mkCollator :: CollatorOptions -> Collator
mkCollator :: CollatorOptions -> Collator
mkCollator CollatorOptions
opts =
  Collator :: (Text -> Text -> Ordering)
-> (Text -> SortKey) -> CollatorOptions -> Collator
Collator { collate :: Text -> Text -> Ordering
collate = (Text -> SortKey) -> Text -> Text -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Text -> SortKey
sortKey'
           , sortKey :: Text -> SortKey
sortKey = Text -> SortKey
sortKey'
           , collatorOptions :: CollatorOptions
collatorOptions = CollatorOptions
opts
           }
 where
  sortKey' :: Text -> SortKey
sortKey' = CollatorOptions -> Text -> SortKey
toSortKey CollatorOptions
opts

toSortKey :: CollatorOptions -> Text -> SortKey
toSortKey :: CollatorOptions -> Text -> SortKey
toSortKey CollatorOptions
opts =
    CollatorOptions -> [CollationElement] -> SortKey
mkSortKey CollatorOptions
opts
  ([CollationElement] -> SortKey)
-> (Text -> [CollationElement]) -> Text -> SortKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VariableWeighting -> [CollationElement] -> [CollationElement]
handleVariable (CollatorOptions -> VariableWeighting
optVariableWeighting CollatorOptions
opts)
  ([CollationElement] -> [CollationElement])
-> (Text -> [CollationElement]) -> Text -> [CollationElement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Collation -> [Int] -> [CollationElement]
getCollationElements (CollatorOptions -> Collation
optCollation CollatorOptions
opts)
  ([Int] -> [CollationElement])
-> (Text -> [Int]) -> Text -> [CollationElement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> [Int] -> [Int]) -> [Int] -> Text -> [Int]
forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr ((:) (Int -> [Int] -> [Int]) -> (Char -> Int) -> Char -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) []
  (Text -> [Int]) -> (Text -> Text) -> Text -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. if CollatorOptions -> Bool
optNormalize CollatorOptions
opts
       then NormalizationMode -> Text -> Text
N.normalize NormalizationMode
N.NFD
       else Text -> Text
forall a. a -> a
id

handleVariable :: VariableWeighting -> [CollationElement] -> [CollationElement]
handleVariable :: VariableWeighting -> [CollationElement] -> [CollationElement]
handleVariable VariableWeighting
NonIgnorable = [CollationElement] -> [CollationElement]
forall a. a -> a
id
handleVariable VariableWeighting
Blanked = Bool -> Bool -> [CollationElement] -> [CollationElement]
doVariable Bool
False Bool
False
handleVariable VariableWeighting
Shifted = Bool -> Bool -> [CollationElement] -> [CollationElement]
doVariable Bool
True Bool
False
handleVariable VariableWeighting
ShiftTrimmed = VariableWeighting -> [CollationElement] -> [CollationElement]
handleVariable VariableWeighting
Shifted

doVariable :: Bool -> Bool -> [CollationElement] -> [CollationElement]
doVariable :: Bool -> Bool -> [CollationElement] -> [CollationElement]
doVariable Bool
_useL4 Bool
_afterVariable [] = []
doVariable Bool
useL4 Bool
afterVariable (CollationElement
e:[CollationElement]
es)
  | CollationElement -> Bool
collationVariable CollationElement
e
    =   CollationElement
e{ collationL1 :: Word16
collationL1 = Word16
0, collationL2 :: Word16
collationL2 = Word16
0, collationL3 :: Word16
collationL3 = Word16
0,
           collationL4 :: Word16
collationL4 = -- Table 11
             case Bool
useL4 of
               Bool
True
                 | CollationElement -> Word16
collationL1 CollationElement
e Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
0
                 , CollationElement -> Word16
collationL2 CollationElement
e Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
0
                 , CollationElement -> Word16
collationL3 CollationElement
e Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
0   -> Word16
0
                 | CollationElement -> Word16
collationL1 CollationElement
e Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
0
                 , CollationElement -> Word16
collationL3 CollationElement
e Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
0
                 , Bool
afterVariable        -> Word16
0
                 | CollationElement -> Word16
collationL1 CollationElement
e Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
0   -> CollationElement -> Word16
collationL1 CollationElement
e
                 | CollationElement -> Word16
collationL1 CollationElement
e Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
0
                 , CollationElement -> Word16
collationL3 CollationElement
e Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
0
                 , Bool -> Bool
not Bool
afterVariable    -> Word16
0xFFFF
               Bool
_                        -> Word16
0
         } CollationElement -> [CollationElement] -> [CollationElement]
forall a. a -> [a] -> [a]
: Bool -> Bool -> [CollationElement] -> [CollationElement]
doVariable Bool
useL4 Bool
True [CollationElement]
es
  | CollationElement -> Word16
collationL1 CollationElement
e Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
0 -- "ignorable"
  , Bool
afterVariable
    = CollationElement
e{ collationL1 :: Word16
collationL1 = Word16
0, collationL2 :: Word16
collationL2 = Word16
0, collationL3 :: Word16
collationL3 = Word16
0, collationL4 :: Word16
collationL4 = Word16
0 }
       CollationElement -> [CollationElement] -> [CollationElement]
forall a. a -> [a] -> [a]
: Bool -> Bool -> [CollationElement] -> [CollationElement]
doVariable Bool
useL4 Bool
afterVariable [CollationElement]
es
  | CollationElement -> Word16
collationL1 CollationElement
e Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
0
  , Bool -> Bool
not (CollationElement -> Bool
collationVariable CollationElement
e)
  , Bool
useL4
  = CollationElement
e{ collationL4 :: Word16
collationL4 = Word16
0xFFFF } CollationElement -> [CollationElement] -> [CollationElement]
forall a. a -> [a] -> [a]
: Bool -> Bool -> [CollationElement] -> [CollationElement]
doVariable Bool
useL4 Bool
False [CollationElement]
es
  | Bool
otherwise
    = CollationElement
e CollationElement -> [CollationElement] -> [CollationElement]
forall a. a -> [a] -> [a]
: Bool -> Bool -> [CollationElement] -> [CollationElement]
doVariable Bool
useL4 Bool
False [CollationElement]
es

mkSortKey :: CollatorOptions -> [CollationElement] -> SortKey
mkSortKey :: CollatorOptions -> [CollationElement] -> SortKey
mkSortKey CollatorOptions
opts [CollationElement]
elts = [Word16] -> SortKey
SortKey ([Word16] -> SortKey) -> [Word16] -> SortKey
forall a b. (a -> b) -> a -> b
$
    [Word16]
l1s [Word16] -> [Word16] -> [Word16]
forall a. [a] -> [a] -> [a]
++ (Word16
0Word16 -> [Word16] -> [Word16]
forall a. a -> [a] -> [a]
:[Word16]
l2s) [Word16] -> [Word16] -> [Word16]
forall a. [a] -> [a] -> [a]
++ (Word16
0Word16 -> [Word16] -> [Word16]
forall a. a -> [a] -> [a]
:[Word16]
l3s) [Word16] -> [Word16] -> [Word16]
forall a. [a] -> [a] -> [a]
++ if [Word16] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Word16]
l4s
                                    then []
                                    else Word16
0Word16 -> [Word16] -> [Word16]
forall a. a -> [a] -> [a]
:[Word16]
l4s
  where
    l1s :: [Word16]
l1s = (Word16 -> Bool) -> [Word16] -> [Word16]
forall a. (a -> Bool) -> [a] -> [a]
filter (Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/=Word16
0) ([Word16] -> [Word16]) -> [Word16] -> [Word16]
forall a b. (a -> b) -> a -> b
$ (CollationElement -> Word16) -> [CollationElement] -> [Word16]
forall a b. (a -> b) -> [a] -> [b]
map CollationElement -> Word16
collationL1 [CollationElement]
elts
    l2s :: [Word16]
l2s = (if CollatorOptions -> Bool
optFrenchAccents CollatorOptions
opts
              then [Word16] -> [Word16]
forall a. [a] -> [a]
reverse
              else [Word16] -> [Word16]
forall a. a -> a
id) ([Word16] -> [Word16]) -> [Word16] -> [Word16]
forall a b. (a -> b) -> a -> b
$ (Word16 -> Bool) -> [Word16] -> [Word16]
forall a. (a -> Bool) -> [a] -> [a]
filter (Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/=Word16
0) ([Word16] -> [Word16]) -> [Word16] -> [Word16]
forall a b. (a -> b) -> a -> b
$ (CollationElement -> Word16) -> [CollationElement] -> [Word16]
forall a b. (a -> b) -> [a] -> [b]
map CollationElement -> Word16
collationL2 [CollationElement]
elts
    l3s :: [Word16]
l3s = (Word16 -> Bool) -> [Word16] -> [Word16]
forall a. (a -> Bool) -> [a] -> [a]
filter (Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/=Word16
0) ([Word16] -> [Word16]) -> [Word16] -> [Word16]
forall a b. (a -> b) -> a -> b
$ (CollationElement -> Word16) -> [CollationElement] -> [Word16]
forall a b. (a -> b) -> [a] -> [b]
map ((if CollatorOptions -> Bool
optUpperBeforeLower CollatorOptions
opts
                                  then Word16 -> Word16
forall p. (Eq p, Num p) => p -> p
switchUpperAndLower
                                  else Word16 -> Word16
forall a. a -> a
id) (Word16 -> Word16)
-> (CollationElement -> Word16) -> CollationElement -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CollationElement -> Word16
collationL3) [CollationElement]
elts
    l4s :: [Word16]
l4s = (case CollatorOptions -> VariableWeighting
optVariableWeighting CollatorOptions
opts of
             VariableWeighting
ShiftTrimmed -> [Word16] -> [Word16]
trimTrailingFFFFs
             VariableWeighting
_             -> [Word16] -> [Word16]
forall a. a -> a
id) ([Word16] -> [Word16]) -> [Word16] -> [Word16]
forall a b. (a -> b) -> a -> b
$ (Word16 -> Bool) -> [Word16] -> [Word16]
forall a. (a -> Bool) -> [a] -> [a]
filter (Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/=Word16
0) ([Word16] -> [Word16]) -> [Word16] -> [Word16]
forall a b. (a -> b) -> a -> b
$ (CollationElement -> Word16) -> [CollationElement] -> [Word16]
forall a b. (a -> b) -> [a] -> [b]
map CollationElement -> Word16
collationL4 [CollationElement]
elts
    switchUpperAndLower :: p -> p
switchUpperAndLower p
0x0002 = p
0x0008
    switchUpperAndLower p
0x0008 = p
0x0002
    switchUpperAndLower p
x      = p
x

trimTrailingFFFFs :: [Word16] -> [Word16]
trimTrailingFFFFs :: [Word16] -> [Word16]
trimTrailingFFFFs = [Word16] -> [Word16]
forall a. [a] -> [a]
reverse ([Word16] -> [Word16])
-> ([Word16] -> [Word16]) -> [Word16] -> [Word16]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16 -> Bool) -> [Word16] -> [Word16]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
0xFFFF) ([Word16] -> [Word16])
-> ([Word16] -> [Word16]) -> [Word16] -> [Word16]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word16] -> [Word16]
forall a. [a] -> [a]
reverse