Tibetan.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}

-- | Parser to parse Tibetan numerals
module Text.Megaparsec.Lexer.Tibetan
    ( parseNumber
    , readBo
    ) where

import Data.Composition
import Data.Either.Combinators
import qualified Data.Text as T
import Text.Megaparsec
import Text.Megaparsec.String
import Text.Megaparsec.Prim
import System.Environment

-- | Read a string in, returning integral value or error
--
-- > λ > readBo "༣༢༠༥"
-- > Just 3205
readBo :: (Integral a) => String -> Maybe a
readBo = fmap fromIntegral . rightToMaybe . (runParser (parseNumber :: Parser Integer) "")

-- | Return verbose errors.
readBoV :: (Integral a) => String -> Either (ParseError Char Dec) a
readBoV = fmap fromIntegral . (runParser (parseNumber :: Parser Integer) "")

-- | Parse Tibetan numerals, returning a positive integer
parseNumber :: (Integral a, MonadParsec e s m, Token s ~ Char) => m a
parseNumber = do
    digits <- reverse <$> some parseNumeral
    (pure . (`div` 10) $ foldr ((*10) .* (+)) 0 digits) <?> "tibetan integer"

-- | Parse a single digit
parseNumeral :: (Integral a, MonadParsec e s m, Token s ~ Char) => m a
parseNumeral = foldr (<|>) (parseDigit '༠' 0) $ zipWith parseDigit "༠༡༢༣༤༥༦༧༨༩" (0:[1..9])

-- | m a given char as a given integer
parseDigit :: (Integral a, MonadParsec e s m, Token s ~ Char) => Char -> a -> m a
parseDigit c i = do
    char c
    pure i