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

-- | Compare two strings using @i;unicode-casemap@,
-- the simple unicode collation algorithm described in RFC 5051.
compareUnicode :: String -> String -> Ordering
compareUnicode :: String -> String -> Ordering
compareUnicode x :: String
x y :: String
y = case [[Int]] -> [[Int]] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [[Int]]
x' [[Int]]
y' of
                          EQ  -> ([[Int]], String) -> ([[Int]], String) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([[Int]]
x', String
x) ([[Int]]
y', String
y)
                          v :: Ordering
v   -> Ordering
v
  where x' :: [[Int]]
x' = String -> [[Int]]
canonicalize String
x
        y' :: [[Int]]
y' = String -> [[Int]]
canonicalize String
y

canonicalize :: String -> [[Int]]
canonicalize :: String -> [[Int]]
canonicalize = (Char -> [Int]) -> String -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map (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 c :: Int
c =
  case Int -> Maybe [Int]
decompose' Int
c of
         Nothing -> [Int
c]
         Just xs :: [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' c :: 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