{-# 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
, CollatorOptions -> Bool
optFrenchAccents :: Bool
, CollatorOptions -> Bool
optUpperBeforeLower :: Bool
, CollatorOptions -> Bool
optNormalize :: Bool
, CollatorOptions -> Collation
optCollation :: Collation
} 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
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
rootCollator :: Collator
rootCollator :: Collator
rootCollator =
CollatorOptions -> Collator
mkCollator CollatorOptions
defaultCollatorOptions{ optCollation :: Collation
optCollation = Collation
ducetCollation }
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 }
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 :: 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 }
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 }
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
}
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
}
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
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
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 =
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
, 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