diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Thomas Mahler (c) 2023 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,130 @@ +# devanagari-transliterations + +[![License BSD3](https://img.shields.io/badge/license-BSD3-brightgreen.svg)](http://opensource.org/licenses/BSD-3-Clause) +[![Actions Status](https://github.com/thma/devanagari-transliterations/workflows/Haskell%20CI/badge.svg)](https://github.com/thma/devanagari-transliterations/actions) +[![codecov](https://codecov.io/gh/thma/devanagari-transliterations/graph/badge.svg?token=DBCFLEA8JZ)](https://codecov.io/gh/thma/devanagari-transliterations) +[![Available on Hackage](https://img.shields.io/hackage/v/devanagari-transliterations.svg?style=flat)](https://github.com/thma/devanagari-transliterations) + +This library provides conversions between Devanagari (unicode block 0900-097F) and the transliterations [Harvard-Kyoto](https://en.wikipedia.org/wiki/Harvard-Kyoto), [IAST](https://en.wikipedia.org/wiki/International_Alphabet_of_Sanskrit_Transliteration) and [ISO15919](https://en.wikipedia.org/wiki/ISO_15919). + +It is particulary useful to produce Devanagari output from a +Harvard-Kyoto (ASCII-only) source. +This is shown in the example below. + +## Usage + +```haskell +{-# LANGUAGE OverloadedStrings #-} + +import Data.Char.Devanagari (tokenize, toDevanagari, toHarvard, toIast, toIso) +import qualified Data.Text.IO as TIO + +main :: IO () +main = do + let tokens = tokenize "zubha lAbha" -- meaning "good luck" + TIO.putStrLn $ "Devanagari: " <> toDevanagari tokens + TIO.putStrLn $ "IAST: " <> toIast tokens + TIO.putStrLn $ "ISO15919: " <> toIso tokens + TIO.putStrLn $ "Harvard Kyoto: " <> toHarvard tokens +``` + +### Output: + +```bash +Devanagari: शुभ लाभ +IAST: śubha lābha +ISO15919: śubha lābha +Harvard Kyoto: zubha lAbha +``` + +## Available on Hackage + +[https://hackage.haskell.org/package/devanagari-transliterations](https://hackage.haskell.org/package/devanagari-transliterations) + +Add the following to your `package.yaml` file: + +```yaml +dependencies: +- devanagari-transliterations +``` + + +## The complete conversion table + +|Harvard-Kyoto|Devanagari|IAST|ISO15919| +|----|----|----|----| +|a|अ|a|a| +|A|आ|ā|ā| +|i|इ|i|i| +|I|ई|ī|ī| +|u|उ|u|u| +|U|ऊ|ū|ū| +|R|ऋ|ṛ|r̥| +|RR|ॠ|ṝ|r̥̄| +|lR|ऌ|ḷ|l̥| +|lRR|ॡ|ḹ|l̥̄| +|e|ए|e|ē| +|o|ओ|o|ō| +|ai|ऐ|ai|ai| +|au|औ|au|au| +|k|क्|k|k| +|c|च्|c|c| +|T|ट्|ṭ|ṭ| +|t|त्|t|t| +|p|प्|p|p| +|g|ग्|g|g| +|j|ज्|j|j| +|D|ड्|ḍ|ḍ| +|d|द्|d|d| +|b|ब्|b|b| +|G|ङ्|ṅ|ṅ| +|J|ञ्|ñ|ñ| +|N|ण्|ṇ|ṇ| +|n|न्|n|n| +|m|म्|m|m| +|h|ह्|h|h| +|y|य्|y|y| +|r|र्|r|r| +|l|ल्|l|l| +|v|व्|v|v| +|Z|ज़्|z|z| +|f|फ़्|f|f| +|z|श्|ś|ś| +|S|ष्|ṣ|ṣ| +|s|स्|s|s| +|kh|ख्|kh|kh| +|ch|छ्|ch|ch| +|Th|ठ्|ṭh|ṭh| +|th|थ्|th|th| +|ph|फ्|ph|ph| +|gh|घ्|gh|gh| +|jh|झ्|jh|jh| +|Dh|ढ्|ḍh|ḍh| +|dh|ध्|dh|dh| +|bh|भ्|bh|bh| +|ġ|ग़्|ġ|ġ| +|0|०|0|0| +|1|१|1|1| +|2|२|2|2| +|3|३|3|3| +|4|४|4|4| +|5|५|5|5| +|6|६|6|6| +|7|७|7|7| +|8|८|8|8| +|9|९|9|9| +|M|ं|ṃ|ṁ| +|MM|ँ|m̐|m̐| +|H|ः|ḥ|ḥ| +|'|ऽ|'|'| +||्||| +|OM|ॐ|oṃ|ōṁ| +|||।|।|।| +||||॥|॥|॥| +|_|‌|_|_| +|\|‍|\|\| + + + + + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain diff --git a/devanagari-transliterations.cabal b/devanagari-transliterations.cabal new file mode 100644 --- /dev/null +++ b/devanagari-transliterations.cabal @@ -0,0 +1,88 @@ +cabal-version: 2.2 + +-- This file has been generated from package.yaml by hpack version 0.35.2. +-- +-- see: https://github.com/sol/hpack + +name: devanagari-transliterations +version: 0.1.0.0 +synopsis: Conversion between Devanagari Unicode, Harvard-Kyoto, IAST and ISO15919. +description: Please see the README on GitHub at +category: Linguistics +homepage: https://github.com/thma/devanagari-transliterations#readme +bug-reports: https://github.com/thma/devanagari-transliterations/issues +author: Thomas Mahler +maintainer: thma@apache.org +copyright: 2023 Thomas Mahler +license: BSD-3-Clause +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + +source-repository head + type: git + location: https://github.com/thma/devanagari-transliterations + +library + exposed-modules: + Data.Char.Devanagari + Data.Char.Devanagari.DevanagariTokens + Data.Char.Devanagari.Generators + Data.Char.Devanagari.Tokenizer + Data.Char.Devanagari.TokenTables + other-modules: + Paths_devanagari_transliterations + autogen-modules: + Paths_devanagari_transliterations + hs-source-dirs: + src + default-extensions: + DeriveGeneric + DeriveAnyClass + DerivingStrategies + OverloadedStrings + TemplateHaskell + QuasiQuotes + LambdaCase + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints + build-depends: + array >=0.5.5 && <0.6 + , base >=4.7 && <5 + , containers >=0.6.7 && <0.7 + , deepseq >=1.4.8 && <1.5 + , extra >=1.7.14 && <1.8 + , text >=2.0.2 && <2.1 + default-language: GHC2021 + +test-suite devanagari-transliterations-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_devanagari_transliterations + autogen-modules: + Paths_devanagari_transliterations + hs-source-dirs: + test + default-extensions: + DeriveGeneric + DeriveAnyClass + DerivingStrategies + OverloadedStrings + TemplateHaskell + QuasiQuotes + LambdaCase + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N + build-depends: + QuickCheck + , array >=0.5.5 && <0.6 + , base >=4.7 && <5 + , containers >=0.6.7 && <0.7 + , deepseq >=1.4.8 && <1.5 + , devanagari-transliterations + , extra >=1.7.14 && <1.8 + , hedgehog + , hspec + , hspec-hedgehog + , text >=2.0.2 && <2.1 + default-language: GHC2021 diff --git a/src/Data/Char/Devanagari.hs b/src/Data/Char/Devanagari.hs new file mode 100644 --- /dev/null +++ b/src/Data/Char/Devanagari.hs @@ -0,0 +1,25 @@ +module Data.Char.Devanagari + ( DevanagariToken (..), + Vowel (..), + Consonant (..), + Digit (..), + Tokenizer, + tokenize, + selectTokenizerByContent, + fromDevanagari, + fromIso, + fromHarvard, + fromIast, + toDevanagari, + toIso, + toHarvard, + toIast, + tokenMap, + tokenMapToMd, + tokenMapToHtml + ) +where + +import Data.Char.Devanagari.DevanagariTokens +import Data.Char.Devanagari.Generators +import Data.Char.Devanagari.Tokenizer diff --git a/src/Data/Char/Devanagari/DevanagariTokens.hs b/src/Data/Char/Devanagari/DevanagariTokens.hs new file mode 100644 --- /dev/null +++ b/src/Data/Char/Devanagari/DevanagariTokens.hs @@ -0,0 +1,36 @@ +module Data.Char.Devanagari.DevanagariTokens ( + DevanagariToken(..) + , Vowel(..) + , Consonant(..) + , Digit(..) +) + +where + +{- + This module contains a normalized representation of the Devanagari script. + + A Tokenizer for Devanagari or one of its roman transliterations will parse a UTF8 Text representation and + produce a Sequence of DevanagariToken instances as output. + + A Generator for Devanagari or one of its roman transliterations will take a sequence of DevanagariToken instances + as input and will generate a UTF8 Text representation as output. +-} + +data DevanagariToken + = Vow Vowel | Cons Consonant | Dig Digit | Anusvara | Anunasika | Visarga | Avagraha | Virama | OM + | PurnaViram | DeerghViram | ZWNJ | ZWJ | Unmapped Char + deriving (Eq, Ord, Show) + +data Vowel + = A | AA | I | II | U | UU | RI | RII | LI | LII | E | O | AI | AU + deriving (Eq, Ord, Bounded, Enum, Show) + +data Consonant + = K | C | Tdot | T | P | G | J | Ddot | D | B | Ntop | Ntild + | Ndot | N | M | H | Y | R | L | V | Z | F | Stop | Sdot | S + | KH | CH | TdotH | TH | PH | GH | JH | DdotH | DH | BH| Gtop + deriving (Eq, Ord, Bounded, Enum, Show) + +data Digit = ZERO | ONE | TWO | THREE | FOUR | FIVE | SIX | SEVEN | EIGHT | NINE + deriving (Eq, Ord, Bounded, Enum, Show) diff --git a/src/Data/Char/Devanagari/Generators.hs b/src/Data/Char/Devanagari/Generators.hs new file mode 100644 --- /dev/null +++ b/src/Data/Char/Devanagari/Generators.hs @@ -0,0 +1,146 @@ +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 = Map.fromList (map swap $ devanagariIndependentTable ++ viramsDeva) + +dependentMapDevanagari :: TranslateMap +dependentMapDevanagari = Map.fromList (map swap $ devanagariDependentTable ++ viramsDeva) + +iastMap :: TranslateMap +iastMap = Map.fromList (map swap $ iastTable ++ virams) + +isoMap :: TranslateMap +isoMap = Map.fromList (map swap $ isoTable ++ virams) + +harvardMap :: TranslateMap +harvardMap = Map.fromList (map swap $ harvardKyotoTable ++ viramsHarvard) + +mapToken :: TranslateMap -> DevanagariToken -> Text +mapToken _ (Unmapped c) = T.singleton c +mapToken m token = + let maybeString = Map.lookup token m + in fromJust maybeString + +mapIndependent, mapDependent, mapIast, mapHarvard, mapIso :: DevanagariToken -> Text +mapIndependent = mapToken independentMapDevanagari +mapDependent = mapToken dependentMapDevanagari +mapIast = mapToken iastMap +mapHarvard = mapToken harvardMap +mapIso = mapToken isoMap + +toDevanagari :: Generator +toDevanagari = translateToDeva T.empty + +translateToDeva :: Text -> Generator +translateToDeva acc Empty = acc +translateToDeva acc (x :<| xs) = + let (firstChars, restTokens) = translateToken x xs + in translateToDeva (acc `T.append` firstChars) restTokens + where + translateToken :: DevanagariToken -> Seq DevanagariToken -> (Text, Seq DevanagariToken) + translateToken cons@(Cons _) Empty = (mapIndependent cons `T.append` mapIndependent Virama, Empty) + translateToken token Empty = (mapIndependent token, Empty) + translateToken cons@(Cons _) (Vow A :<| ts) = (mapIndependent cons, ts) + translateToken cons@(Cons _) (vow@(Vow _) :<| ts) = (mapIndependent cons `T.append` mapDependent vow, ts) + translateToken cons@(Cons _) ts@(Cons _ :<| _) = (mapIndependent cons `T.append` mapIndependent Virama, ts) + translateToken cons@(Cons _) ts@(Unmapped _ :<| _) = (mapIndependent cons `T.append` mapIndependent Virama, ts) + translateToken cons@(Cons _) (ZWNJ :<| ts) = (mapIndependent cons `T.append` mapIndependent Virama `T.append` mapIndependent ZWNJ, ts) + translateToken cons@(Cons _) (ZWJ :<| ts) = (mapIndependent cons `T.append` mapIndependent Virama `T.append` mapIndependent ZWJ, ts) + translateToken token tokens@(_ :<| _) = (mapIndependent token, tokens) + +toHarvard :: Generator +toHarvard = toTransliteration mapHarvard T.empty + +toIast :: Generator +toIast = toTransliteration mapIast T.empty + +toIso :: Generator +toIso = toTransliteration mapIso T.empty + +toTransliteration :: (DevanagariToken -> Text) -> Text -> Generator +toTransliteration _f acc Empty = acc +toTransliteration f acc (x :<| xs) = toTransliteration f (acc `T.append` f x) xs + +-- | this function creates a markdown table +-- containing the complete character map in all four encodings. +tokenMapToMd :: Text +tokenMapToMd = + T.concat $ + tableHeader + : map + ( \(hky, dev, ias, iso) -> + "|" <> hky <> "|" <> dev <> "|" <> ias <> "|" <> iso <> "|\r" + ) + tokenMap + where + tableHeader :: Text + tableHeader = "|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 = + T.concat $ + map + ( \(hky, dev, ias, iso) -> + "" + <> hky + <> "" + <> dev + <> "" + <> ias + <> "" + <> iso + <> "\r" + ) + tokenMap + +-- | returns a list of tuples containing all available characters in all four encodings. +tokenMap :: [(Text, Text, Text, Text)] +tokenMap = map (\tok -> (toHarvard tok, toDevanagari tok, toIast tok, toIso tok)) allTokens + where + allTokens :: [Seq DevanagariToken] + allTokens = allVowels ++ allConsonants ++ allDigits ++ allSpecialCharacters + + allVowels :: [Seq DevanagariToken] + allVowels = map (\v -> fromList [Vow v]) enumerate + + allConsonants :: [Seq DevanagariToken] + allConsonants = map (\c -> fromList [Cons c, Virama]) enumerate + + allDigits :: [Seq DevanagariToken] + allDigits = map (\d -> fromList [Dig d]) enumerate + + allSpecialCharacters :: [Seq DevanagariToken] + allSpecialCharacters = map (\tok -> fromList [tok]) [Anusvara, Anunasika, Visarga, Avagraha, Virama, OM, PurnaViram, DeerghViram, ZWNJ, ZWJ] diff --git a/src/Data/Char/Devanagari/TokenTables.hs b/src/Data/Char/Devanagari/TokenTables.hs new file mode 100644 --- /dev/null +++ b/src/Data/Char/Devanagari/TokenTables.hs @@ -0,0 +1,363 @@ +module Data.Char.Devanagari.TokenTables + ( harvardKyotoTable, + iastTable, + isoTable, + devanagariIndependentTable, + devanagariDependentTable, + inputVirams, + virams, + viramsHarvard, + viramsDeva, + ) +where + +{- + This module contains Token tables for the Devanagari script and its roman transliterations Harvard-Kyoto, IAST and ISO15919. + These tables are used to generate token ReadMaps for the Tokenizers as well as TranslateMaps for the Generators. +-} + +import Data.Char.Devanagari.DevanagariTokens +import Data.Text (Text, pack) + +harvardKyotoTable :: [(Text, DevanagariToken)] +harvardKyotoTable = + [ ("lRR", Vow LII), + ("RR", Vow RII), + ("lR", Vow LI), + ("OM", OM), + ("kh", Cons KH), + ("gh", Cons GH), + ("ch", Cons CH), + ("jh", Cons JH), + ("Th", Cons TdotH), + ("Dh", Cons DdotH), + ("th", Cons TH), + ("dh", Cons DH), + ("ph", Cons PH), + ("bh", Cons BH), + ("k", Cons K), + ("g", Cons G), + ("G", Cons Ntop), + ("c", Cons C), + ("j", Cons J), + ("J", Cons Ntild), + ("T", Cons Tdot), + ("D", Cons Ddot), + ("N", Cons Ndot), + ("t", Cons T), + ("d", Cons D), + ("n", Cons N), + ("p", Cons P), + ("b", Cons B), + ("m", Cons M), + ("y", Cons Y), + ("r", Cons R), + ("l", Cons L), + ("v", Cons V), + ("z", Cons Stop), + ("Z", Cons Z), + ("S", Cons Sdot), + ("s", Cons S), + ("h", Cons H), + ("ai", Vow AI), + ("au", Vow AU), + ("ġ", Cons Gtop), -- this is not part of the original HarvardKyoto definition. I added it to allow full compatibility between all transliterations. + ("f", Cons F), + ("a", Vow A), + ("A", Vow AA), + ("i", Vow I), + ("I", Vow II), + ("u", Vow U), + ("U", Vow UU), + ("e", Vow E), + ("o", Vow O), + ("R", Vow RI), + ("M", Anusvara), + ("MM", Anunasika), -- this is not part of the original HarvardKyoto definition. I added it to allow full compatibility between all transliterations. + ("H", Visarga), + ("", Virama), + ("'", Avagraha), + ("0", Dig ZERO), + ("1", Dig ONE), + ("2", Dig TWO), + ("3", Dig THREE), + ("4", Dig FOUR), + ("5", Dig FIVE), + ("6", Dig SIX), + ("7", Dig SEVEN), + ("8", Dig EIGHT), + ("9", Dig NINE) + ] + +iastTable :: [(Text, DevanagariToken)] +iastTable = + [ ("kh", Cons KH), + ("gh", Cons GH), + ("ch", Cons CH), + ("jh", Cons JH), + ("ṭh", Cons TdotH), + ("ḍh", Cons DdotH), + ("th", Cons TH), + ("dh", Cons DH), + ("ph", Cons PH), + ("bh", Cons BH), + ("oṃ", OM), + ("k", Cons K), + ("g", Cons G), + ("ṅ", Cons Ntop), + ("c", Cons C), + ("j", Cons J), + ("ñ", Cons Ntild), + ("ṭ", Cons Tdot), + ("ḍ", Cons Ddot), + ("ṇ", Cons Ndot), + ("t", Cons T), + ("d", Cons D), + ("n", Cons N), + ("p", Cons P), + ("b", Cons B), + ("m", Cons M), + ("y", Cons Y), + ("r", Cons R), + ("l", Cons L), + ("v", Cons V), + ("ś", Cons Stop), + ("ṣ", Cons Sdot), + ("s", Cons S), + ("z", Cons Z), + ("h", Cons H), + ("ai", Vow AI), + ("au", Vow AU), + ("ġ", Cons Gtop), + ("f", Cons F), + ("a", Vow A), + ("ā", Vow AA), + ("i", Vow I), + ("ī", Vow II), + ("u", Vow U), + ("ū", Vow UU), + ("e", Vow E), + ("o", Vow O), + ("ṛ", Vow RI), + ("ṝ", Vow RII), + ("ḷ", Vow LI), + ("ḹ", Vow LII), + ("ṃ", Anusvara), + ("m̐", Anunasika), + ("ḥ", Visarga), + ("'", Avagraha), + ("", Virama), + ("0", Dig ZERO), + ("1", Dig ONE), + ("2", Dig TWO), + ("3", Dig THREE), + ("4", Dig FOUR), + ("5", Dig FIVE), + ("6", Dig SIX), + ("7", Dig SEVEN), + ("8", Dig EIGHT), + ("9", Dig NINE) + ] + +isoTable :: [(Text, DevanagariToken)] +isoTable = + [ ("kh", Cons KH), + ("gh", Cons GH), + ("ch", Cons CH), + ("jh", Cons JH), + ("ṭh", Cons TdotH), + ("ḍh", Cons DdotH), + ("th", Cons TH), + ("dh", Cons DH), + ("ph", Cons PH), + ("bh", Cons BH), + ("ōṁ", OM), + ("k", Cons K), + ("g", Cons G), + ("ṅ", Cons Ntop), + ("c", Cons C), + ("j", Cons J), + ("ñ", Cons Ntild), + ("ṭ", Cons Tdot), + ("ḍ", Cons Ddot), + ("ṇ", Cons Ndot), + ("t", Cons T), + ("d", Cons D), + ("n", Cons N), + ("p", Cons P), + ("b", Cons B), + ("m", Cons M), + ("y", Cons Y), + ("r", Cons R), + ("l", Cons L), + ("v", Cons V), + ("ś", Cons Stop), + ("ṣ", Cons Sdot), + ("s", Cons S), + ("z", Cons Z), + ("h", Cons H), + ("ai", Vow AI), + ("au", Vow AU), + ("ġ", Cons Gtop), + ("f", Cons F), + ("a", Vow A), + ("ā", Vow AA), + ("i", Vow I), + ("ī", Vow II), + ("u", Vow U), + ("ū", Vow UU), + ("ē", Vow E), + ("ō", Vow O), + ("r̥", Vow RI), + ("r̥̄", Vow RII), + ("l̥", Vow LI), + ("l̥̄", Vow LII), + ("ṁ", Anusvara), + ("m̐", Anunasika), + ("ḥ", Visarga), + ("'", Avagraha), + ("", Virama), + ("0", Dig ZERO), + ("1", Dig ONE), + ("2", Dig TWO), + ("3", Dig THREE), + ("4", Dig FOUR), + ("5", Dig FIVE), + ("6", Dig SIX), + ("7", Dig SEVEN), + ("8", Dig EIGHT), + ("9", Dig NINE) + ] + +devanagariIndependentTable :: [(Text, DevanagariToken)] +devanagariIndependentTable = + [ ("ख", Cons KH), + ("घ", Cons GH), + ("छ", Cons CH), + ("झ", Cons JH), + ("ठ", Cons TdotH), + ("ढ", Cons DdotH), + ("थ", Cons TH), + ("ध", Cons DH), + ("फ", Cons PH), + ("भ", Cons BH), + ("ॐ", OM), + ("क", Cons K), + ("ग", Cons G), + ("ग़", Cons Gtop), + ("ङ", Cons Ntop), + ("च", Cons C), + ("ज", Cons J), + ("ञ", Cons Ntild), + ("ट", Cons Tdot), + ("ड", Cons Ddot), + ("ण", Cons Ndot), + ("त", Cons T), + ("द", Cons D), + ("न", Cons N), + ("प", Cons P), + ("ब", Cons B), + ("म", Cons M), + ("य", Cons Y), + ("र", Cons R), + ("ल", Cons L), + ("व", Cons V), + ("श", Cons Stop), + ("ष", Cons Sdot), + ("स", Cons S), + ("ह", Cons H), + ("ग", Cons G), + ("ज़", Cons Z), + ("फ़", Cons F), + ("अ", Vow A), + ("आ", Vow AA), + ("इ", Vow I), + ("ई", Vow II), + ("उ", Vow U), + ("ऊ", Vow UU), + ("ए", Vow E), + ("ओ", Vow O), + ("ऋ", Vow RI), + ("ॠ", Vow RII), + ("ऌ", Vow LI), + ("ॡ", Vow LII), + ("ऐ", Vow AI), + ("औ", Vow AU), + ("्", Virama), + ("ं", Anusvara), + ("ँ", Anunasika), + ("ः", Visarga), + ("ऽ", Avagraha), + ("०", Dig ZERO), + ("१", Dig ONE), + ("२", Dig TWO), + ("३", Dig THREE), + ("४", Dig FOUR), + ("५", Dig FIVE), + ("६", Dig SIX), + ("७", Dig SEVEN), + ("८", Dig EIGHT), + ("९", Dig NINE) + ] + +devanagariDependentTable :: [(Text, DevanagariToken)] +devanagariDependentTable = + [ ("ं", Anusvara), + ("ँ", Anunasika), + ("ः", Visarga), + ("ऽ", Avagraha), + ("ा", Vow AA), + ("ि", Vow I), + ("ी", Vow II), + ("ु", Vow U), + ("ू", Vow UU), + ("ृ", Vow RI), + ("ॄ", Vow RII), + ("ॢ", Vow LI), + ("ॣ", Vow LII), + ("े", Vow E), + ("ै", Vow AI), + ("ो", Vow O), + ("ौ", Vow AU) + ] + +-- The handling for virams is not symmetric for input and output. +-- This is meant as an optimization to ease manual input by using |, ||, +-- _ representing the ZWNJ (zero width non joiner) +-- \ representing the ZWJ (zero width joiner) +inputVirams :: [(Text, DevanagariToken)] +inputVirams = + [ ("|", PurnaViram), + ("||", DeerghViram), + ("।", PurnaViram), + ("॥", DeerghViram), + ("_", ZWNJ), + ("\\", ZWJ), + (pack ['\8204'], ZWNJ), + (pack ['\8205'], ZWJ) + ] + +virams :: [(Text, DevanagariToken)] +virams = + [ ("।", PurnaViram), + ("॥", DeerghViram), + ("_", ZWNJ), + ("\\", ZWJ) + ] + +viramsHarvard :: [(Text, DevanagariToken)] +viramsHarvard = + [ ("|", PurnaViram), + ("||", DeerghViram), + ("_", ZWNJ), + ("\\", ZWJ) + ] + +-- Devanagari needs special unicode characters for ZWNJ and ZWJ +viramsDeva :: [(Text, DevanagariToken)] +viramsDeva = + [ ("।", PurnaViram), + ("॥", DeerghViram), + (pack ['\8204'], ZWNJ), + (pack ['\8205'], ZWJ) + ] diff --git a/src/Data/Char/Devanagari/Tokenizer.hs b/src/Data/Char/Devanagari/Tokenizer.hs new file mode 100644 --- /dev/null +++ b/src/Data/Char/Devanagari/Tokenizer.hs @@ -0,0 +1,116 @@ +module Data.Char.Devanagari.Tokenizer + ( selectTokenizerByContent, + tokenize, + fromDevanagari, + fromIso, + fromHarvard, + fromIast, + Tokenizer, + ) +where + +{- + This module contains Tokenizers for the Devanagari script and its roman transliterations Harvard-Kyoto, IAST and ISO15919. + It also contains a generic tokenize function that detects the input encoding and automatically selects the right + tokenizer to use. +-} + +import Control.Monad (join) +import Data.Char.Devanagari.DevanagariTokens +import Data.Char.Devanagari.TokenTables +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Maybe (isJust) +import Data.Sequence (Seq (Empty, (:<|)), + empty, (|>)) +import Data.Text (Text) +import qualified Data.Text as T + +-- | A Tokenizer is a function that takes a Text as input and produces a Sequence of DevanagariToken instances as output. +type Tokenizer = (Text -> Seq DevanagariToken) + +-- | A ParseMap is a Map from a Text to a DevanagariToken. +type ParseMap = Map Text DevanagariToken + +harvardKyotoParseMap :: ParseMap +harvardKyotoParseMap = Map.fromList (harvardKyotoTable ++ inputVirams) + +iastParseMap :: ParseMap +iastParseMap = Map.fromList (iastTable ++ inputVirams) + +isoParseMap :: ParseMap +isoParseMap = Map.fromList (isoTable ++ inputVirams) + +devanagariParseMap :: ParseMap +devanagariParseMap = Map.fromList (devanagariIndependentTable ++ devanagariDependentTable ++ inputVirams) + +-- | parse a Text into a Sequence of DevanagariToken instances using a ParseMap. +parse :: ParseMap -> Text -> Seq DevanagariToken +parse pMap s = parse1 s pMap empty + where + parse1 :: Text -> ParseMap -> Seq DevanagariToken -> Seq DevanagariToken + parse1 str _ tokens + | str == T.empty = tokens + parse1 str parseMap tokens = + case tryMatch str 3 parseMap of + Just (token, rest) -> parse1 rest parseMap (tokens |> token) + Nothing -> + case tryMatch str 2 parseMap of + Just (token, rest) -> parse1 rest parseMap (tokens |> token) + Nothing -> + case tryMatch str 1 parseMap of + Just (token, rest) -> parse1 rest parseMap (tokens |> token) + Nothing -> parse1 (T.drop 1 str) parseMap (tokens |> Unmapped (head $ T.unpack $ T.take 1 str)) + + tryMatch :: Text -> Int -> ParseMap -> Maybe (DevanagariToken, Text) + tryMatch str n parseMap = + let tok = T.take n str + rest = snd $ T.splitAt (T.length tok) str + maybeToken = Map.lookup tok parseMap + in case maybeToken of + Just token -> Just (token, rest) + Nothing -> Nothing + +-- | a tokenizer function that parses a Text containing IAST encoded Devanagari script into a Sequence of DevanagariToken instances. +fromIast :: Tokenizer +fromIast = parse iastParseMap + +-- | a tokenizer function that parses a Text containing ISO15919 encoded Devanagari script into a Sequence of DevanagariToken instances. +fromIso :: Tokenizer +fromIso = parse isoParseMap + +-- | a tokenizer function that parses a Text containing Harvard-Kyoto encoded Devanagari script into a Sequence of DevanagariToken instances. +fromHarvard :: Tokenizer +fromHarvard = parse harvardKyotoParseMap + +-- | a tokenizer function that parses a Text containing Devanagari script into a Sequence of DevanagariToken instances. +fromDevanagari :: Tokenizer +fromDevanagari s = addExplicitVowA empty (parse devanagariParseMap s) + where + addExplicitVowA :: Seq DevanagariToken -> Seq DevanagariToken -> Seq DevanagariToken + addExplicitVowA acc Empty = acc + addExplicitVowA acc (cons@(Cons _) :<| Virama :<| xs) = addExplicitVowA (acc |> cons) xs + addExplicitVowA acc (cons@(Cons _) :<| vow@(Vow _) :<| xs) = addExplicitVowA (acc |> cons |> vow) xs + addExplicitVowA acc (cons@(Cons _) :<| xs) = addExplicitVowA (acc |> cons |> Vow A) xs + addExplicitVowA acc (x :<| xs) = addExplicitVowA (acc |> x) xs + +-- | tokenize a string of Text into a sequence of DevanagariTokens. +-- The actual tokenizer is selected based on the content of the input string. +-- This tokenizer is then applied to the input string. +tokenize :: Tokenizer +tokenize = join selectTokenizerByContent + +-- | select the correct tokenizer based on the content of the input string. +selectTokenizerByContent :: Text -> Tokenizer +selectTokenizerByContent str + | containsDevanagari str = fromDevanagari + | containsIso str = fromIso + | containsIast str = fromIast + | otherwise = fromHarvard + where + containsDevanagari = containsAnyOf (['\x900' .. '\x963'] ++ ['\x966' .. '\x97F']) -- Unicode section for Devanagari + containsIso = containsAnyOf ("ēōṁ" ++ ['\0325', '\0304']) -- ISO15919 diacritics + containsIast = containsAnyOf (['\241' .. '\363'] ++ ['\7693' .. '\7789']) -- IAST diacritics + containsAnyOf :: [Char] -> Text -> Bool + containsAnyOf chars text = T.any (`isInfixOf` text) $ T.pack chars + isInfixOf c text = isJust (T.find (== c) text) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,129 @@ +import Data.Char.Devanagari +import Data.Sequence +import qualified Hedgehog.Gen as Gen +import Test.Hspec +import Test.Hspec.Hedgehog (Gen, forAll, hedgehog, + tripping) +import Data.Text (Text, pack) +import qualified Data.Text.IO as TIO +import Control.Monad (join) + +toEither :: Tokenizer -> Text -> Either String (Seq DevanagariToken) +toEither f = Right . f + +-- `main` is here so that this module can be run from GHCi on its own. It is +-- not needed for automatic spec discovery. +main :: IO () +main = hspec spec + +zwnj :: [Char] +zwnj = ['\8204'] -- Zero Width Non Joiner + +zwj :: [Char] +zwj = ['\8205'] -- Zero Width Joiner + +harvard :: Text +harvard = pack "smAramiM" + +iast :: Text +iast = pack "smāramiṃ" + +deva :: Text +deva = pack "स्मारमिं" + +iso :: Text +iso = pack "smāramiṁ" + +spec :: Spec +spec = do + describe "roundtrip" $ + it "has output identical to input after complex roundtrip" $ do + let roundtrip = (toIast . fromIso . toIso . fromDevanagari . toDevanagari . fromHarvard . toHarvard . fromIast) iast + roundtrip `shouldBe` iast + describe "token based roundtrip" $ do + it "works for all vowels" $ hedgehog $ do + x <- forAll (Gen.enumBounded :: Gen Vowel) + tripping (fromList [Vow x]) toDevanagari (toEither fromDevanagari) + tripping (fromList [Vow x]) toHarvard (toEither fromHarvard) + tripping (fromList [Vow x]) toIast (toEither fromIast) + tripping (fromList [Vow x]) toIso (toEither fromIso) + it "works for all consonants" $ hedgehog $ do + x <- forAll (Gen.enumBounded :: Gen Consonant) + tripping (fromList [Cons x, Vow A]) toDevanagari (toEither fromDevanagari) + tripping (fromList [Cons x, Vow A]) toHarvard (toEither fromHarvard) + tripping (fromList [Cons x, Vow A]) toIast (toEither fromIast) + tripping (fromList [Cons x, Vow A]) toIso (toEither fromIso) + it "works for all digits" $ hedgehog $ do + x <- forAll (Gen.enumBounded :: Gen Digit) + tripping (fromList [Dig x]) toDevanagari (toEither fromDevanagari) + tripping (fromList [Dig x]) toHarvard (toEither fromHarvard) + tripping (fromList [Dig x]) toIast (toEither fromIast) + tripping (fromList [Dig x]) toIso (toEither fromIso) + it "works for special characters" $ hedgehog $ do + let specials = [Anusvara, Anunasika, Visarga, Avagraha, Virama, OM, PurnaViram, DeerghViram] + x <- forAll (Gen.element specials) + tripping (fromList [x]) toDevanagari (toEither fromDevanagari) + + describe "selectParserByContent" $ + it "selects correct parse function based on input" $ do + join selectTokenizerByContent deva `shouldBe` fromDevanagari deva + join selectTokenizerByContent iast `shouldBe` fromIast iast + join selectTokenizerByContent harvard `shouldBe` fromHarvard harvard + join selectTokenizerByContent iso `shouldBe` fromIso iso + describe "tokenize" $ + it "produces correct tokens for any input" $ do + let expected = fromList [Cons S, Cons M, Vow AA, Cons R, Vow A, Cons M, Vow I, Anusvara] + tokenize harvard `shouldBe` expected + tokenize iast `shouldBe` expected + tokenize deva `shouldBe` expected + tokenize iso `shouldBe` expected + describe "ligature handling" $ do + it "produces correct consonant ligatures " $ do + let harvard' = pack "sadgamaye" + (toDevanagari . fromHarvard) harvard' `shouldBe` pack "सद्गमये" + let harvard'' = pack "vakSyAmi" + (toDevanagari . fromHarvard) harvard'' `shouldBe` pack "वक्ष्यामि" + it "adds a virama if a consonant is not followed by a vowel" $ do + let harvard' = pack "param " + tokens = tokenize harvard' + tokens `shouldBe` fromList [Cons P, Vow A, Cons R, Vow A, Cons M, Unmapped ' '] + toDevanagari tokens `shouldBe` pack "परम् " + it "adds a virama even without trailing blank" $ do + let harvard' = pack "param" + tokens = tokenize harvard' + tokens `shouldBe` fromList [Cons P, Vow A, Cons R, Vow A, Cons M] + toDevanagari tokens `shouldBe` pack "परम्" + it "can detect tokens up to 3 chars" $ do + let harvard' = pack "parlRRlRRm " + tokens = tokenize harvard' + tokens `shouldBe` fromList [Cons P, Vow A, Cons R, Vow LII, Vow LII, Cons M, Unmapped ' '] + toDevanagari tokens `shouldBe` pack "परॣॡम् " + it "can enforce usage of an explicit virama to suppress consonant ligatures " $ do + let harvard' = pack "sad_gamaye" + deva' = pack ("सद्" ++ zwnj ++ "गमये") + (toDevanagari . fromHarvard) harvard' `shouldBe` deva' + it "can enforce usage of regular consonant ligatures instead of complex ligatures" $ do + let harvard' = pack "vak\\SyAmi" + deva' = pack ("वक्" ++ zwj ++ "ष्यामि") + (toDevanagari . fromHarvard) harvard' `shouldBe` deva' + describe "reading of special chars for viramas" $ do + it "reads | correctly as PurnaViram" $ do + let harvard' = pack "OM zAntiH |" + deva' = pack "ॐ शान्तिः ।" + (toDevanagari . fromHarvard) harvard' `shouldBe` deva' + it "reads || correctly as DeerghViram" $ do + let harvard' = pack "OM zAntiH ||" + deva' = pack "ॐ शान्तिः ॥" + (toDevanagari . fromHarvard) harvard' `shouldBe` deva' + it "handles unmapped characters gracefully" $ do + let harvard' = pack "rüpel" + deva' = pack "र्üपेल्" + (toDevanagari . fromHarvard) harvard' `shouldBe` deva' + + describe "Auto-Documentation" $ do + it "produces complete markdown Table" $ do + let mdTokenMap = tokenMapToMd + TIO.writeFile "tokenMap.md" mdTokenMap + it "produces complete html Table" $ do + let htmlTokenMap = tokenMapToHtml + TIO.writeFile "tokenMap.html" htmlTokenMap