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

-- | Parser to parse Tibetan numerals
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 :: forall a b. Either a b -> Maybe b
rightToMaybe Left{}    = forall a. Maybe a
Nothing
rightToMaybe (Right b
x) = forall a. a -> Maybe a
Just b
x

-- | Read a string in, returning integral value or error
--
-- > λ:> readBo "༣༢༠༥"
-- > Just 3205
readBo :: (Integral a) => String -> Maybe a
readBo :: forall a. Integral a => String -> Maybe a
readBo = forall a b. Either a b -> Maybe b
rightToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Integral a =>
String -> Either (ParseErrorBundle String Void) a
readBoV

-- | Return verbose errors.
--
-- @since 0.1.2.0
readBoV :: (Integral a) => String -> Either (ParseErrorBundle String Void) a
readBoV :: forall a.
Integral a =>
String -> Either (ParseErrorBundle String Void) a
readBoV = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (forall a e s (m :: * -> *).
(Integral a, MonadParsec e s m, Token s ~ Char) =>
m a
parseNumber :: Parser Integer) String
""

-- | Parse Tibetan numerals, returning a positive integer
parseNumber :: (Integral a, MonadParsec e s m, Token s ~ Char) => m a
parseNumber :: forall a e s (m :: * -> *).
(Integral a, MonadParsec e s m, Token s ~ Char) =>
m a
parseNumber = do
    [a]
digits <- forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall a e s (m :: * -> *).
(Integral a, MonadParsec e s m, Token s ~ Char) =>
m a
parseNumeral
    (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Integral a => a -> a -> a
`div` a
10) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((forall a. Num a => a -> a -> a
*a
10) forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* forall a. Num a => a -> a -> a
(+)) a
0 [a]
digits) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"tibetan integer"

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

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