module Data.RFC5051 (compareUnicode)
where
import Data.RFC5051.UnicodeData (decompositionMap)
import qualified Data.Map as M
import Data.Char (ord, toTitle)
import Data.Text (Text)
import qualified Data.Text as T

-- | Compare two strings using @i;unicode-casemap@,
-- the simple unicode collation algorithm described in RFC 5051.
compareUnicode :: Text -> Text -> Ordering
compareUnicode :: Text -> Text -> Ordering
compareUnicode Text
x Text
y =
  case (Text -> Maybe (Char, Text)
T.uncons Text
x, Text -> Maybe (Char, Text)
T.uncons Text
y) of
    (Maybe (Char, Text)
Nothing, Maybe (Char, Text)
Nothing) -> Ordering
EQ
    (Maybe (Char, Text)
Nothing, Just (Char, Text)
_)  -> Ordering
LT
    (Just (Char, Text)
_, Maybe (Char, Text)
Nothing)  -> Ordering
GT
    (Just (Char
xc,Text
x'), Just (Char
yc,Text
y')) ->
      case [Int] -> [Int] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Char -> [Int]
canonicalize Char
xc) (Char -> [Int]
canonicalize Char
yc) of
        Ordering
GT -> Ordering
GT
        Ordering
LT -> Ordering
LT
        Ordering
EQ -> Text -> Text -> Ordering
compareUnicode Text
x' Text
y'

canonicalize :: Char -> [Int]
canonicalize :: Char -> [Int]
canonicalize = Int -> [Int]
decompose (Int -> [Int]) -> (Char -> Int) -> Char -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord (Char -> Int) -> (Char -> Char) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
toTitle

decompose :: Int -> [Int]
decompose :: Int -> [Int]
decompose Int
c =
  case Int -> Maybe [Int]
decompose' Int
c of
         Maybe [Int]
Nothing -> [Int
c]
         Just [Int]
xs -> (Int -> [Int]) -> [Int] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Int -> [Int]
decompose [Int]
xs

decompose' :: Int -> Maybe [Int]
decompose' :: Int -> Maybe [Int]
decompose' Int
c = Int -> Map Int [Int] -> Maybe [Int]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
c Map Int [Int]
decompositionMap