{- |
Module      :  Text.Zenhan
Description :  Converter between Full-width Japanese and Half-width Japanese
Copyright   :  2017 karky7 Calimakvonia
License     :  BSD3

Maintainer  :  cantimerny.g@gmail.com
Stability   :  unstable
Portability :  portable

This module ported Python's zenhan library, similar to the
"zenhan" library found in pypi:

<https://pypi.python.org/pypi/zenhan/>

Let's see an example.

@
{-# LANGUAGE OverloadedStrings #-}

import Text.Zenhan
import Data.Text (pack, unpack)

main :: IO ()
main = do
  let h = h2z [Kana, Digit, Ascii] \"A\" \"ABCd\\\\｢｣ｱｲｳｴｵ123\"
      z = z2h [Kana, Digit, Ascii] \"Ｂエ\" h
  putStrLn $ toString h
  putStrLn $ toString z
@

This library is still a work-in-progress, and contributions are welcome for
missing pieces and to fix bugs. Please see the Github page to contribute with
code or bug reports:

<https://github.com/karky7/hzenhan>
-}

{-# LANGUAGE OverloadedStrings #-}

module Text.Zenhan
  (
    z2h
  , h2z
  , isAllZenKana
  , isAllHanKana
  , isAllZen
  , toString
  , Mode(..)
  ) where

import Data.Tuple (swap)
import qualified Data.Text as T
import qualified Data.Map as M
import Text.Table.Chars

-- | Type for character type to be converted
data Mode = Kana | Digit | Ascii deriving(Mode -> Mode -> Bool
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c== :: Mode -> Mode -> Bool
Eq, Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
(Int -> Mode -> ShowS)
-> (Mode -> String) -> ([Mode] -> ShowS) -> Show Mode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> String
$cshow :: Mode -> String
showsPrec :: Int -> Mode -> ShowS
$cshowsPrec :: Int -> Mode -> ShowS
Show)

-- | Convert from Full-width Japanese character to Half-width Japanese character
z2h ::
     [Mode] -- ^ Type of character to be converted
  -> T.Text -- ^ Conversion exclusion character
  -> T.Text -- ^ Characters to be converted
  -> T.Text -- ^ Result
z2h :: [Mode] -> Text -> Text -> Text
z2h [Mode]
mode Text
ignore Text
text = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ([Mode] -> [Text] -> Text -> Text
zhTrans [Mode]
mode (Text -> [Text]
convAry Text
ignore)) (Text -> [Text]
convAry Text
text)

-- | Convert from Half-width Japanese character to Full-width Japanese character
h2z ::
     [Mode] -- ^ Type of character to be converted
  -> T.Text -- ^ Conversion exclusion character
  -> T.Text -- ^ Characters to be converted
  -> T.Text -- ^ Result
h2z :: [Mode] -> Text -> Text -> Text
h2z [Mode]
mode Text
ignore Text
text = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ([Mode] -> [Text] -> Text -> Text
hzTrans [Mode]
mode (Text -> [Text]
hconvAry Text
ignore)) (Text -> [Text]
hconvAry Text
text)

-- | Check Full-width Japanese character zen kana, return True if all text is Zen Kana
isAllZenKana ::
     T.Text -- ^ The text to be checked
  -> Bool   -- ^ Result
isAllZenKana :: Text -> Bool
isAllZenKana = (Char -> Bool) -> Text -> Bool
T.all ((Char -> String -> Bool) -> String -> Char -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
z_kana))

-- | Check Full-width Japanese character zen kana, return True if all text is Hen Kana
isAllHanKana ::
     T.Text -- ^ The text to be checked
  -> Bool   -- ^ Result
isAllHanKana :: Text -> Bool
isAllHanKana = (Char -> Bool) -> Text -> Bool
T.all ((Char -> String -> Bool) -> String -> Char -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
h_kana))

-- | Check Full-width Japanese character zen kana, returns True if the text all Zen Kana
isAllZen ::
     T.Text -- ^ The text to be checked
  -> Bool   -- ^ Result
isAllZen :: Text -> Bool
isAllZen = Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Bool
T.any ((Char -> String -> Bool) -> String -> Char -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ([Text]
h_asciidigit [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
h_kana)))

-- | Convert to String
toString :: T.Text -> String
toString :: Text -> String
toString = Text -> String
T.unpack

zhTrans :: [Mode] -> [T.Text] -> T.Text -> T.Text
zhTrans :: [Mode] -> [Text] -> Text -> Text
zhTrans [Mode]
mode [Text]
ign Text
t = case Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
t ([Mode] -> Map Text Text
z2hMap [Mode]
mode) of
  Just Text
v -> Bool -> Text -> Text -> Text
forall a. Bool -> a -> a -> a
choice (Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Text
t [Text]
ign) Text
t Text
v
  Maybe Text
Nothing -> Text
t

hzTrans :: [Mode] -> [T.Text] -> T.Text -> T.Text
hzTrans :: [Mode] -> [Text] -> Text -> Text
hzTrans [Mode]
mode [Text]
ign Text
t = case Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
t ([Mode] -> Map Text Text
h2zMap [Mode]
mode) of
  Just Text
v -> Bool -> Text -> Text -> Text
forall a. Bool -> a -> a -> a
choice (Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Text
t [Text]
ign) Text
t Text
v
  Maybe Text
Nothing -> Text
t

choice :: Bool -> a -> a -> a
choice :: Bool -> a -> a -> a
choice Bool
True a
t a
_ = a
t
choice Bool
False a
_ a
v = a
v

z2hMap :: [Mode] -> M.Map T.Text T.Text
z2hMap :: [Mode] -> Map Text Text
z2hMap [] = Map Text Text
forall k a. Map k a
M.empty
z2hMap (Mode
x:[Mode]
xs) = [Map Text Text] -> Map Text Text
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions ([Mode -> Map Text Text
zhMap Mode
x, [Mode] -> Map Text Text
z2hMap [Mode]
xs])

zhMap :: Mode -> M.Map T.Text T.Text
zhMap :: Mode -> Map Text Text
zhMap Mode
Kana  = Map Text Text
zh_kana
zhMap Mode
Digit = Map Text Text
zh_digit
zhMap Mode
Ascii = Map Text Text
zh_ascii

h2zMap :: [Mode] -> M.Map T.Text T.Text
h2zMap :: [Mode] -> Map Text Text
h2zMap [] = Map Text Text
forall k a. Map k a
M.empty
h2zMap (Mode
x:[Mode]
xs) = [Map Text Text] -> Map Text Text
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions ([Mode -> Map Text Text
hzMap Mode
x, [Mode] -> Map Text Text
h2zMap [Mode]
xs])

hzMap :: Mode -> M.Map T.Text T.Text
hzMap :: Mode -> Map Text Text
hzMap Mode
Kana  = Map Text Text
hz_kana
hzMap Mode
Digit = Map Text Text
hz_digit
hzMap Mode
Ascii = Map Text Text
hz_ascii

convAry :: T.Text -> [T.Text]
convAry :: Text -> [Text]
convAry Text
xs = [Text] -> [Text]
T.transpose [Text
xs]

hconvAry :: T.Text -> [T.Text]
hconvAry :: Text -> [Text]
hconvAry = [Text] -> [Text]
mergeWord ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
convAry

mergeWord :: [T.Text] -> [T.Text]
mergeWord :: [Text] -> [Text]
mergeWord (Text
x:Text
y:[Text]
xs) = Bool -> [Text] -> [Text] -> [Text]
forall a. Bool -> a -> a -> a
choice (Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ([Text] -> Text
T.concat [Text
x, Text
y]) ([Text]
h_kana_d [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
h_kana_p))
                         ([Text] -> Text
T.concat [Text
x, Text
y] Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
mergeWord [Text]
xs) (Text
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
mergeWord (Text
yText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
xs))
mergeWord (Text
x:[Text]
xs) = Text
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
mergeWord [Text]
xs
mergeWord [] = []

zh_ascii :: M.Map T.Text T.Text
zh_ascii :: Map Text Text
zh_ascii = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, Text)] -> Map Text Text)
-> [(Text, Text)] -> Map Text Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
z_ascii [Text]
h_ascii

hz_ascii :: M.Map T.Text T.Text
hz_ascii :: Map Text Text
hz_ascii = Map Text Text -> Map Text Text
transposeMap Map Text Text
zh_ascii

zh_digit :: M.Map T.Text T.Text
zh_digit :: Map Text Text
zh_digit = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, Text)] -> Map Text Text)
-> [(Text, Text)] -> Map Text Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
z_digit [Text]
h_digit

hz_digit :: M.Map T.Text T.Text
hz_digit :: Map Text Text
hz_digit = Map Text Text -> Map Text Text
transposeMap Map Text Text
zh_digit

zh_kana :: M.Map T.Text T.Text
zh_kana :: Map Text Text
zh_kana = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, Text)] -> Map Text Text)
-> [(Text, Text)] -> Map Text Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
z_kana [Text]
h_kana

hz_kana :: M.Map T.Text T.Text
hz_kana :: Map Text Text
hz_kana = Map Text Text -> Map Text Text
transposeMap Map Text Text
zh_kana

transposeMap :: M.Map T.Text T.Text -> M.Map T.Text T.Text
transposeMap :: Map Text Text -> Map Text Text
transposeMap = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, Text)] -> Map Text Text)
-> (Map Text Text -> [(Text, Text)])
-> Map Text Text
-> Map Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> (Text, Text)) -> [(Text, Text)] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> (Text, Text)
forall a b. (a, b) -> (b, a)
swap ([(Text, Text)] -> [(Text, Text)])
-> (Map Text Text -> [(Text, Text)])
-> Map Text Text
-> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
M.toList