SortByPinyin.hs

module Text.SortByPinyin

(
  pinyin_char_map
, show_pinyin
, compare_chinese_char_by_pinyin
, compare_chinese_string_by_pinyin
)


where

import qualified Data.Char as Char
import qualified Data.Text.Read as Text.Read
import qualified Data.Text as Text
import qualified Data.ByteString.Char8 as StrictByteString
import qualified Data.Map as Map

import Text.SortByPinyinData (sort_by_pinyin_data)

import Air.Env
import Prelude ()

pinyin_data :: String
pinyin_data = sort_by_pinyin_data

pinyins :: [String]
pinyins = pinyin_data.lines.reject (starts_with "#")

pinyin_char_map :: Map.Map Char String
pinyin_char_map =
  pinyins
    .map words
    .map (take 2)
    .reject (length > is_not 2)
    .map (\(x:y:_) -> (x,y))
    .map_fst hex_to_char
    .concatMap (\(x,y) ->
              case x of
                Nothing -> []
                Just x' -> [(x',y)]
                )
    .to_h

hex_to_char :: String -> Maybe Char
hex_to_char x =
  case Text.Read.hexadecimal (Text.pack x) of
    Left _ -> Nothing
    Right (int_value,_) -> Just - Char.chr int_value

show_pinyin :: Char -> Maybe String
show_pinyin x = pinyin_char_map.Map.lookup x

compare_chinese_char_by_pinyin :: Char -> Char -> Ordering
compare_chinese_char_by_pinyin x y =
  let x_pinyin = show_pinyin x
      y_pinyin = show_pinyin y
  in

  case x_pinyin of
    Nothing -> compare x y
    Just x_pinyin_string ->
      case y_pinyin of
        Nothing -> compare x y
        Just y_pinyin_string ->
          compare x_pinyin_string y_pinyin_string


compare_chinese_string_by_pinyin :: String -> String -> Ordering
compare_chinese_string_by_pinyin [] ys = LT
compare_chinese_string_by_pinyin xs [] = GT
compare_chinese_string_by_pinyin (x:xs) (y:ys) =
  case compare_chinese_char_by_pinyin x y of
    EQ -> compare_chinese_string_by_pinyin xs ys
    LT -> LT
    GT -> GT