    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