{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
module Text.Megaparsec.Lexer.Tibetan
( parseNumber
, readBo
, readBoV
) where
import Control.Composition
import qualified Data.Text as T
import Data.Void
import System.Environment
import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Megaparsec.Char.Tibetan
rightToMaybe :: Either a b -> Maybe b
rightToMaybe Left{} = Nothing
rightToMaybe (Right x) = Just x
readBo :: (Integral a) => String -> Maybe a
readBo = rightToMaybe . readBoV
readBoV :: (Integral a) => String -> Either (ParseErrorBundle String Void) a
readBoV = fmap fromIntegral . runParser (parseNumber :: Parser 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"
parseNumeral :: (Integral a, MonadParsec e s m, Token s ~ Char) => m a
parseNumeral = foldr (<|>) (parseDigit '༠' 0) $ zipWith parseDigit "༠༡༢༣༤༥༦༧༨༩" [0..9]
parseDigit :: (Integral a, MonadParsec e s m, Token s ~ Char) => Char -> a -> m a
parseDigit c i = do
char c
pure i