module Data.Char.Devanagari.Generators
  ( toIast,
    toDevanagari,
    toIso,
    toHarvard,
    tokenMapToMd,
    tokenMapToHtml,
    tokenMap,
  )
where

{-
  This module contains Generators for the Devanagari script and its roman transliterations Harvard-Kyoto, IAST and ISO15919.
-}

import           Data.Char.Devanagari.DevanagariTokens
import           Data.Char.Devanagari.TokenTables
import           Data.List.Extra                       (enumerate)
import           Data.Map.Strict                       (Map)
import qualified Data.Map.Strict                       as Map
import           Data.Maybe                            (fromJust)
import           Data.Sequence
import           Data.Text                             (Text)
import qualified Data.Text                             as T
import           Data.Tuple                            (swap)

-- | a TranslateMap models a specific transliteration scheme from DevanagariTokens to a given representation
-- (e.g. Harvard-Kyoto, IAST, ISO15919, Devanagari)
type TranslateMap = Map DevanagariToken Text

-- | a Generator is a function that takes a sequence of DevanagariTokens and returns a specific textual representation of the sequence
-- (e.g. Harvard-Kyoto, IAST, ISO15919, Devanagari)
type Generator = Seq DevanagariToken -> Text

independentMapDevanagari :: TranslateMap
independentMapDevanagari :: TranslateMap
independentMapDevanagari = [(DevanagariToken, Text)] -> TranslateMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (((Text, DevanagariToken) -> (DevanagariToken, Text))
-> [(Text, DevanagariToken)] -> [(DevanagariToken, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, DevanagariToken) -> (DevanagariToken, Text)
forall a b. (a, b) -> (b, a)
swap ([(Text, DevanagariToken)] -> [(DevanagariToken, Text)])
-> [(Text, DevanagariToken)] -> [(DevanagariToken, Text)]
forall a b. (a -> b) -> a -> b
$ [(Text, DevanagariToken)]
devanagariIndependentTable [(Text, DevanagariToken)]
-> [(Text, DevanagariToken)] -> [(Text, DevanagariToken)]
forall a. [a] -> [a] -> [a]
++ [(Text, DevanagariToken)]
viramsDeva)

dependentMapDevanagari :: TranslateMap
dependentMapDevanagari :: TranslateMap
dependentMapDevanagari = [(DevanagariToken, Text)] -> TranslateMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (((Text, DevanagariToken) -> (DevanagariToken, Text))
-> [(Text, DevanagariToken)] -> [(DevanagariToken, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, DevanagariToken) -> (DevanagariToken, Text)
forall a b. (a, b) -> (b, a)
swap ([(Text, DevanagariToken)] -> [(DevanagariToken, Text)])
-> [(Text, DevanagariToken)] -> [(DevanagariToken, Text)]
forall a b. (a -> b) -> a -> b
$ [(Text, DevanagariToken)]
devanagariDependentTable [(Text, DevanagariToken)]
-> [(Text, DevanagariToken)] -> [(Text, DevanagariToken)]
forall a. [a] -> [a] -> [a]
++ [(Text, DevanagariToken)]
viramsDeva)

iastMap :: TranslateMap
iastMap :: TranslateMap
iastMap = [(DevanagariToken, Text)] -> TranslateMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (((Text, DevanagariToken) -> (DevanagariToken, Text))
-> [(Text, DevanagariToken)] -> [(DevanagariToken, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, DevanagariToken) -> (DevanagariToken, Text)
forall a b. (a, b) -> (b, a)
swap ([(Text, DevanagariToken)] -> [(DevanagariToken, Text)])
-> [(Text, DevanagariToken)] -> [(DevanagariToken, Text)]
forall a b. (a -> b) -> a -> b
$ [(Text, DevanagariToken)]
iastTable [(Text, DevanagariToken)]
-> [(Text, DevanagariToken)] -> [(Text, DevanagariToken)]
forall a. [a] -> [a] -> [a]
++ [(Text, DevanagariToken)]
virams)

isoMap :: TranslateMap
isoMap :: TranslateMap
isoMap = [(DevanagariToken, Text)] -> TranslateMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (((Text, DevanagariToken) -> (DevanagariToken, Text))
-> [(Text, DevanagariToken)] -> [(DevanagariToken, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, DevanagariToken) -> (DevanagariToken, Text)
forall a b. (a, b) -> (b, a)
swap ([(Text, DevanagariToken)] -> [(DevanagariToken, Text)])
-> [(Text, DevanagariToken)] -> [(DevanagariToken, Text)]
forall a b. (a -> b) -> a -> b
$ [(Text, DevanagariToken)]
isoTable [(Text, DevanagariToken)]
-> [(Text, DevanagariToken)] -> [(Text, DevanagariToken)]
forall a. [a] -> [a] -> [a]
++ [(Text, DevanagariToken)]
virams)

harvardMap :: TranslateMap
harvardMap :: TranslateMap
harvardMap = [(DevanagariToken, Text)] -> TranslateMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (((Text, DevanagariToken) -> (DevanagariToken, Text))
-> [(Text, DevanagariToken)] -> [(DevanagariToken, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, DevanagariToken) -> (DevanagariToken, Text)
forall a b. (a, b) -> (b, a)
swap ([(Text, DevanagariToken)] -> [(DevanagariToken, Text)])
-> [(Text, DevanagariToken)] -> [(DevanagariToken, Text)]
forall a b. (a -> b) -> a -> b
$ [(Text, DevanagariToken)]
harvardKyotoTable [(Text, DevanagariToken)]
-> [(Text, DevanagariToken)] -> [(Text, DevanagariToken)]
forall a. [a] -> [a] -> [a]
++ [(Text, DevanagariToken)]
viramsHarvard)

mapToken :: TranslateMap -> DevanagariToken -> Text
mapToken :: TranslateMap -> DevanagariToken -> Text
mapToken TranslateMap
_ (Unmapped Char
c) = Char -> Text
T.singleton Char
c
mapToken TranslateMap
m DevanagariToken
token =
  let maybeString :: Maybe Text
maybeString = DevanagariToken -> TranslateMap -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DevanagariToken
token TranslateMap
m
   in Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
maybeString

mapIndependent, mapDependent, mapIast, mapHarvard, mapIso :: DevanagariToken -> Text
mapIndependent :: DevanagariToken -> Text
mapIndependent = TranslateMap -> DevanagariToken -> Text
mapToken TranslateMap
independentMapDevanagari
mapDependent :: DevanagariToken -> Text
mapDependent = TranslateMap -> DevanagariToken -> Text
mapToken TranslateMap
dependentMapDevanagari
mapIast :: DevanagariToken -> Text
mapIast = TranslateMap -> DevanagariToken -> Text
mapToken TranslateMap
iastMap
mapHarvard :: DevanagariToken -> Text
mapHarvard = TranslateMap -> DevanagariToken -> Text
mapToken TranslateMap
harvardMap
mapIso :: DevanagariToken -> Text
mapIso = TranslateMap -> DevanagariToken -> Text
mapToken TranslateMap
isoMap

toDevanagari :: Generator
toDevanagari :: Generator
toDevanagari = Text -> Generator
translateToDeva Text
T.empty

translateToDeva :: Text -> Generator
translateToDeva :: Text -> Generator
translateToDeva Text
acc Seq DevanagariToken
Empty = Text
acc
translateToDeva Text
acc (DevanagariToken
x :<| Seq DevanagariToken
xs) =
  let (Text
firstChars, Seq DevanagariToken
restTokens) = DevanagariToken
-> Seq DevanagariToken -> (Text, Seq DevanagariToken)
translateToken DevanagariToken
x Seq DevanagariToken
xs
   in Text -> Generator
translateToDeva (Text
acc Text -> Text -> Text
`T.append` Text
firstChars) Seq DevanagariToken
restTokens
  where
    translateToken :: DevanagariToken -> Seq DevanagariToken -> (Text, Seq DevanagariToken)
    translateToken :: DevanagariToken
-> Seq DevanagariToken -> (Text, Seq DevanagariToken)
translateToken cons :: DevanagariToken
cons@(Cons Consonant
_) Seq DevanagariToken
Empty = (DevanagariToken -> Text
mapIndependent DevanagariToken
cons Text -> Text -> Text
`T.append` DevanagariToken -> Text
mapIndependent DevanagariToken
Virama, Seq DevanagariToken
forall a. Seq a
Empty)
    translateToken DevanagariToken
token Seq DevanagariToken
Empty = (DevanagariToken -> Text
mapIndependent DevanagariToken
token, Seq DevanagariToken
forall a. Seq a
Empty)
    translateToken cons :: DevanagariToken
cons@(Cons Consonant
_) (Vow Vowel
A :<| Seq DevanagariToken
ts) = (DevanagariToken -> Text
mapIndependent DevanagariToken
cons, Seq DevanagariToken
ts)
    translateToken cons :: DevanagariToken
cons@(Cons Consonant
_) (vow :: DevanagariToken
vow@(Vow Vowel
_) :<| Seq DevanagariToken
ts) = (DevanagariToken -> Text
mapIndependent DevanagariToken
cons Text -> Text -> Text
`T.append` DevanagariToken -> Text
mapDependent DevanagariToken
vow, Seq DevanagariToken
ts)
    translateToken cons :: DevanagariToken
cons@(Cons Consonant
_) ts :: Seq DevanagariToken
ts@(Cons Consonant
_ :<| Seq DevanagariToken
_) = (DevanagariToken -> Text
mapIndependent DevanagariToken
cons Text -> Text -> Text
`T.append` DevanagariToken -> Text
mapIndependent DevanagariToken
Virama, Seq DevanagariToken
ts)
    translateToken cons :: DevanagariToken
cons@(Cons Consonant
_) ts :: Seq DevanagariToken
ts@(Unmapped Char
_ :<| Seq DevanagariToken
_) = (DevanagariToken -> Text
mapIndependent DevanagariToken
cons Text -> Text -> Text
`T.append` DevanagariToken -> Text
mapIndependent DevanagariToken
Virama, Seq DevanagariToken
ts)
    translateToken cons :: DevanagariToken
cons@(Cons Consonant
_) (DevanagariToken
ZWNJ :<| Seq DevanagariToken
ts) = (DevanagariToken -> Text
mapIndependent DevanagariToken
cons Text -> Text -> Text
`T.append` DevanagariToken -> Text
mapIndependent DevanagariToken
Virama Text -> Text -> Text
`T.append` DevanagariToken -> Text
mapIndependent DevanagariToken
ZWNJ, Seq DevanagariToken
ts)
    translateToken cons :: DevanagariToken
cons@(Cons Consonant
_) (DevanagariToken
ZWJ :<| Seq DevanagariToken
ts) = (DevanagariToken -> Text
mapIndependent DevanagariToken
cons Text -> Text -> Text
`T.append` DevanagariToken -> Text
mapIndependent DevanagariToken
Virama Text -> Text -> Text
`T.append` DevanagariToken -> Text
mapIndependent DevanagariToken
ZWJ, Seq DevanagariToken
ts)
    translateToken DevanagariToken
token tokens :: Seq DevanagariToken
tokens@(DevanagariToken
_ :<| Seq DevanagariToken
_) = (DevanagariToken -> Text
mapIndependent DevanagariToken
token, Seq DevanagariToken
tokens)

toHarvard :: Generator
toHarvard :: Generator
toHarvard = (DevanagariToken -> Text) -> Text -> Generator
toTransliteration DevanagariToken -> Text
mapHarvard Text
T.empty

toIast :: Generator
toIast :: Generator
toIast = (DevanagariToken -> Text) -> Text -> Generator
toTransliteration DevanagariToken -> Text
mapIast Text
T.empty

toIso :: Generator
toIso :: Generator
toIso = (DevanagariToken -> Text) -> Text -> Generator
toTransliteration DevanagariToken -> Text
mapIso Text
T.empty

toTransliteration :: (DevanagariToken -> Text) -> Text -> Generator
toTransliteration :: (DevanagariToken -> Text) -> Text -> Generator
toTransliteration DevanagariToken -> Text
_f Text
acc Seq DevanagariToken
Empty = Text
acc
toTransliteration DevanagariToken -> Text
f Text
acc (DevanagariToken
x :<| Seq DevanagariToken
xs) = (DevanagariToken -> Text) -> Text -> Generator
toTransliteration DevanagariToken -> Text
f (Text
acc Text -> Text -> Text
`T.append` DevanagariToken -> Text
f DevanagariToken
x) Seq DevanagariToken
xs

-- | this function creates a markdown table
--   containing the complete character map in all four encodings.
tokenMapToMd :: Text
tokenMapToMd :: Text
tokenMapToMd =
  [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
    Text
tableHeader
      Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ((Text, Text, Text, Text) -> Text)
-> [(Text, Text, Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map
        ( \(Text
hky, Text
dev, Text
ias, Text
iso) ->
            Text
"|" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hky Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"|" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dev Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"|" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ias Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"|" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
iso Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"|\r"
        )
        [(Text, Text, Text, Text)]
tokenMap
  where
    tableHeader :: Text
    tableHeader :: Text
tableHeader = Text
"|Harvard-Kyoto|Devanagari|IAST|ISO15919|\r|----|----|----|----|\r"

-- | this function creates an html table containing the complete character map in all four encodings.
tokenMapToHtml :: Text
tokenMapToHtml :: Text
tokenMapToHtml =
  [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
    ((Text, Text, Text, Text) -> Text)
-> [(Text, Text, Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map
      ( \(Text
hky, Text
dev, Text
ias, Text
iso) ->
          Text
"<tr><td>"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hky
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</td><td>"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dev
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</td><td>"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ias
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</td><td>"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
iso
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</td></tr>\r"
      )
      [(Text, Text, Text, Text)]
tokenMap

-- | returns a list of tuples containing all available characters in all four encodings.
tokenMap :: [(Text, Text, Text, Text)]
tokenMap :: [(Text, Text, Text, Text)]
tokenMap = (Seq DevanagariToken -> (Text, Text, Text, Text))
-> [Seq DevanagariToken] -> [(Text, Text, Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\Seq DevanagariToken
tok -> (Generator
toHarvard Seq DevanagariToken
tok, Generator
toDevanagari Seq DevanagariToken
tok, Generator
toIast Seq DevanagariToken
tok, Generator
toIso Seq DevanagariToken
tok)) [Seq DevanagariToken]
allTokens
  where
    allTokens :: [Seq DevanagariToken]
    allTokens :: [Seq DevanagariToken]
allTokens = [Seq DevanagariToken]
allVowels [Seq DevanagariToken]
-> [Seq DevanagariToken] -> [Seq DevanagariToken]
forall a. [a] -> [a] -> [a]
++ [Seq DevanagariToken]
allConsonants [Seq DevanagariToken]
-> [Seq DevanagariToken] -> [Seq DevanagariToken]
forall a. [a] -> [a] -> [a]
++ [Seq DevanagariToken]
allDigits [Seq DevanagariToken]
-> [Seq DevanagariToken] -> [Seq DevanagariToken]
forall a. [a] -> [a] -> [a]
++ [Seq DevanagariToken]
allSpecialCharacters

    allVowels :: [Seq DevanagariToken]
    allVowels :: [Seq DevanagariToken]
allVowels = (Vowel -> Seq DevanagariToken) -> [Vowel] -> [Seq DevanagariToken]
forall a b. (a -> b) -> [a] -> [b]
map (\Vowel
v -> [DevanagariToken] -> Seq DevanagariToken
forall a. [a] -> Seq a
fromList [Vowel -> DevanagariToken
Vow Vowel
v]) [Vowel]
forall a. (Enum a, Bounded a) => [a]
enumerate

    allConsonants :: [Seq DevanagariToken]
    allConsonants :: [Seq DevanagariToken]
allConsonants = (Consonant -> Seq DevanagariToken)
-> [Consonant] -> [Seq DevanagariToken]
forall a b. (a -> b) -> [a] -> [b]
map (\Consonant
c -> [DevanagariToken] -> Seq DevanagariToken
forall a. [a] -> Seq a
fromList [Consonant -> DevanagariToken
Cons Consonant
c, DevanagariToken
Virama]) [Consonant]
forall a. (Enum a, Bounded a) => [a]
enumerate

    allDigits :: [Seq DevanagariToken]
    allDigits :: [Seq DevanagariToken]
allDigits = (Digit -> Seq DevanagariToken) -> [Digit] -> [Seq DevanagariToken]
forall a b. (a -> b) -> [a] -> [b]
map (\Digit
d -> [DevanagariToken] -> Seq DevanagariToken
forall a. [a] -> Seq a
fromList [Digit -> DevanagariToken
Dig Digit
d]) [Digit]
forall a. (Enum a, Bounded a) => [a]
enumerate

    allSpecialCharacters :: [Seq DevanagariToken]
    allSpecialCharacters :: [Seq DevanagariToken]
allSpecialCharacters = (DevanagariToken -> Seq DevanagariToken)
-> [DevanagariToken] -> [Seq DevanagariToken]
forall a b. (a -> b) -> [a] -> [b]
map (\DevanagariToken
tok -> [DevanagariToken] -> Seq DevanagariToken
forall a. [a] -> Seq a
fromList [DevanagariToken
tok]) [DevanagariToken
Anusvara, DevanagariToken
Anunasika, DevanagariToken
Visarga, DevanagariToken
Avagraha, DevanagariToken
Virama, DevanagariToken
OM, DevanagariToken
PurnaViram, DevanagariToken
DeerghViram, DevanagariToken
ZWNJ, DevanagariToken
ZWJ]