{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, Safe, TypeApplications #-}

{-|
Module      : Data.Char.Number.Mayan
Description : A module to print Mayan numerals.
Maintainer  : hapytexeu+gh@gmail.com
Stability   : experimental
Portability : POSIX

Unicode uses a <https://www.unicode.org/charts/PDF/U1D2E0.pdf code block> for Mayan numerals. Mayan numerals are written top to bottom,
so vertically. This module aims to make it more convenient to write Mayan numerals by offering
functions to convert numbers into a 'Text' object for Mayan numbers. Mayan numerals can /not/
present /negative/ numbers.
-}

module Data.Char.Number.Mayan (
    -- * Define Mayan literals
    MayanLiteral(Zero, One, Two, Three, Four, Five, Six, Seven, Eight, Nine, Ten, Eleven, Twelve, Thirteen, Fourteen, Fifteen, Sixteen, Seventeen, Eighteen, Nineteen)
    -- * Converting integers to Mayan numbers.
  , toMayanVertical, toMayanVertical', toMayanVertical'', toMayan, toMayan', toMayan''
  ) where

import Control.DeepSeq(NFData)

import Data.Char.Core(UnicodeCharacter(toUnicodeChar, fromUnicodeChar, fromUnicodeChar'), UnicodeText, mapFromEnum, mapToEnum, mapToEnumSafe)
import Data.Data(Data)
import Data.Hashable(Hashable)
import Data.Text(Text, pack)

import GHC.Generics(Generic)

import Test.QuickCheck.Arbitrary(Arbitrary(arbitrary), arbitraryBoundedEnum)

-- | The Mayan numerals, as defined in the Unicode block.
data MayanLiteral
  = Zero  -- ^ The unicode character for the Mayan numeral /zero/: 𝋠.
  | One  -- ^ The unicode character for the Mayan numeral /one/: 𝋡.
  | Two  -- ^ The unicode character for the Mayan numeral /two/: 𝋢.
  | Three  -- ^ The unicode character for the Mayan numeral /three/: 𝋣.
  | Four  -- ^ The unicode character for the Mayan numeral /four/: 𝋤.
  | Five  -- ^ The unicode character for the Mayan numeral /five/: 𝋥.
  | Six  -- ^ The unicode character for the Mayan numeral /six/: 𝋦.
  | Seven  -- ^ The unicode character for the Mayan numeral /seven/: 𝋧.
  | Eight  -- ^ The unicode character for the Mayan numeral /eight/: 𝋨.
  | Nine  -- ^ The unicode character for the Mayan numeral /nine/: 𝋩.
  | Ten  -- ^ The unicode character for the Mayan numeral /ten/: 𝋪.
  | Eleven  -- ^ The unicode character for the Mayan numeral /eleven/: 𝋫.
  | Twelve  -- ^ The unicode character for the Mayan numeral /twelve/: 𝋬.
  | Thirteen  -- ^ The unicode character for the Mayan numeral /thirteen/: 𝋭.
  | Fourteen  -- ^ The unicode character for the Mayan numeral /fourteen/: 𝋮.
  | Fifteen  -- ^ The unicode character for the Mayan numeral /fifteen/: 𝋯.
  | Sixteen  -- ^ The unicode character for the Mayan numeral /sixteen/: 𝋰.
  | Seventeen  -- ^ The unicode character for the Mayan numeral /seventeen/: 𝋱.
  | Eighteen  -- ^ The unicode character for the Mayan numeral /eighteen/: 𝋲.
  | Nineteen  -- ^ The unicode character for the Mayan numeral /nineteen/: 𝋳.
 deriving (MayanLiteral
MayanLiteral -> MayanLiteral -> Bounded MayanLiteral
forall a. a -> a -> Bounded a
maxBound :: MayanLiteral
$cmaxBound :: MayanLiteral
minBound :: MayanLiteral
$cminBound :: MayanLiteral
Bounded, Typeable MayanLiteral
DataType
Constr
Typeable MayanLiteral
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> MayanLiteral -> c MayanLiteral)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c MayanLiteral)
-> (MayanLiteral -> Constr)
-> (MayanLiteral -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c MayanLiteral))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c MayanLiteral))
-> ((forall b. Data b => b -> b) -> MayanLiteral -> MayanLiteral)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> MayanLiteral -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> MayanLiteral -> r)
-> (forall u. (forall d. Data d => d -> u) -> MayanLiteral -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> MayanLiteral -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> MayanLiteral -> m MayanLiteral)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MayanLiteral -> m MayanLiteral)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MayanLiteral -> m MayanLiteral)
-> Data MayanLiteral
MayanLiteral -> DataType
MayanLiteral -> Constr
(forall b. Data b => b -> b) -> MayanLiteral -> MayanLiteral
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MayanLiteral -> c MayanLiteral
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MayanLiteral
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> MayanLiteral -> u
forall u. (forall d. Data d => d -> u) -> MayanLiteral -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MayanLiteral -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MayanLiteral -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MayanLiteral -> m MayanLiteral
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MayanLiteral -> m MayanLiteral
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MayanLiteral
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MayanLiteral -> c MayanLiteral
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MayanLiteral)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MayanLiteral)
$cNineteen :: Constr
$cEighteen :: Constr
$cSeventeen :: Constr
$cSixteen :: Constr
$cFifteen :: Constr
$cFourteen :: Constr
$cThirteen :: Constr
$cTwelve :: Constr
$cEleven :: Constr
$cTen :: Constr
$cNine :: Constr
$cEight :: Constr
$cSeven :: Constr
$cSix :: Constr
$cFive :: Constr
$cFour :: Constr
$cThree :: Constr
$cTwo :: Constr
$cOne :: Constr
$cZero :: Constr
$tMayanLiteral :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> MayanLiteral -> m MayanLiteral
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MayanLiteral -> m MayanLiteral
gmapMp :: (forall d. Data d => d -> m d) -> MayanLiteral -> m MayanLiteral
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MayanLiteral -> m MayanLiteral
gmapM :: (forall d. Data d => d -> m d) -> MayanLiteral -> m MayanLiteral
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MayanLiteral -> m MayanLiteral
gmapQi :: Int -> (forall d. Data d => d -> u) -> MayanLiteral -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MayanLiteral -> u
gmapQ :: (forall d. Data d => d -> u) -> MayanLiteral -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MayanLiteral -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MayanLiteral -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MayanLiteral -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MayanLiteral -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MayanLiteral -> r
gmapT :: (forall b. Data b => b -> b) -> MayanLiteral -> MayanLiteral
$cgmapT :: (forall b. Data b => b -> b) -> MayanLiteral -> MayanLiteral
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MayanLiteral)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MayanLiteral)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c MayanLiteral)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MayanLiteral)
dataTypeOf :: MayanLiteral -> DataType
$cdataTypeOf :: MayanLiteral -> DataType
toConstr :: MayanLiteral -> Constr
$ctoConstr :: MayanLiteral -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MayanLiteral
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MayanLiteral
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MayanLiteral -> c MayanLiteral
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MayanLiteral -> c MayanLiteral
$cp1Data :: Typeable MayanLiteral
Data, Int -> MayanLiteral
MayanLiteral -> Int
MayanLiteral -> [MayanLiteral]
MayanLiteral -> MayanLiteral
MayanLiteral -> MayanLiteral -> [MayanLiteral]
MayanLiteral -> MayanLiteral -> MayanLiteral -> [MayanLiteral]
(MayanLiteral -> MayanLiteral)
-> (MayanLiteral -> MayanLiteral)
-> (Int -> MayanLiteral)
-> (MayanLiteral -> Int)
-> (MayanLiteral -> [MayanLiteral])
-> (MayanLiteral -> MayanLiteral -> [MayanLiteral])
-> (MayanLiteral -> MayanLiteral -> [MayanLiteral])
-> (MayanLiteral -> MayanLiteral -> MayanLiteral -> [MayanLiteral])
-> Enum MayanLiteral
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MayanLiteral -> MayanLiteral -> MayanLiteral -> [MayanLiteral]
$cenumFromThenTo :: MayanLiteral -> MayanLiteral -> MayanLiteral -> [MayanLiteral]
enumFromTo :: MayanLiteral -> MayanLiteral -> [MayanLiteral]
$cenumFromTo :: MayanLiteral -> MayanLiteral -> [MayanLiteral]
enumFromThen :: MayanLiteral -> MayanLiteral -> [MayanLiteral]
$cenumFromThen :: MayanLiteral -> MayanLiteral -> [MayanLiteral]
enumFrom :: MayanLiteral -> [MayanLiteral]
$cenumFrom :: MayanLiteral -> [MayanLiteral]
fromEnum :: MayanLiteral -> Int
$cfromEnum :: MayanLiteral -> Int
toEnum :: Int -> MayanLiteral
$ctoEnum :: Int -> MayanLiteral
pred :: MayanLiteral -> MayanLiteral
$cpred :: MayanLiteral -> MayanLiteral
succ :: MayanLiteral -> MayanLiteral
$csucc :: MayanLiteral -> MayanLiteral
Enum, MayanLiteral -> MayanLiteral -> Bool
(MayanLiteral -> MayanLiteral -> Bool)
-> (MayanLiteral -> MayanLiteral -> Bool) -> Eq MayanLiteral
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MayanLiteral -> MayanLiteral -> Bool
$c/= :: MayanLiteral -> MayanLiteral -> Bool
== :: MayanLiteral -> MayanLiteral -> Bool
$c== :: MayanLiteral -> MayanLiteral -> Bool
Eq, (forall x. MayanLiteral -> Rep MayanLiteral x)
-> (forall x. Rep MayanLiteral x -> MayanLiteral)
-> Generic MayanLiteral
forall x. Rep MayanLiteral x -> MayanLiteral
forall x. MayanLiteral -> Rep MayanLiteral x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MayanLiteral x -> MayanLiteral
$cfrom :: forall x. MayanLiteral -> Rep MayanLiteral x
Generic, Eq MayanLiteral
Eq MayanLiteral
-> (MayanLiteral -> MayanLiteral -> Ordering)
-> (MayanLiteral -> MayanLiteral -> Bool)
-> (MayanLiteral -> MayanLiteral -> Bool)
-> (MayanLiteral -> MayanLiteral -> Bool)
-> (MayanLiteral -> MayanLiteral -> Bool)
-> (MayanLiteral -> MayanLiteral -> MayanLiteral)
-> (MayanLiteral -> MayanLiteral -> MayanLiteral)
-> Ord MayanLiteral
MayanLiteral -> MayanLiteral -> Bool
MayanLiteral -> MayanLiteral -> Ordering
MayanLiteral -> MayanLiteral -> MayanLiteral
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MayanLiteral -> MayanLiteral -> MayanLiteral
$cmin :: MayanLiteral -> MayanLiteral -> MayanLiteral
max :: MayanLiteral -> MayanLiteral -> MayanLiteral
$cmax :: MayanLiteral -> MayanLiteral -> MayanLiteral
>= :: MayanLiteral -> MayanLiteral -> Bool
$c>= :: MayanLiteral -> MayanLiteral -> Bool
> :: MayanLiteral -> MayanLiteral -> Bool
$c> :: MayanLiteral -> MayanLiteral -> Bool
<= :: MayanLiteral -> MayanLiteral -> Bool
$c<= :: MayanLiteral -> MayanLiteral -> Bool
< :: MayanLiteral -> MayanLiteral -> Bool
$c< :: MayanLiteral -> MayanLiteral -> Bool
compare :: MayanLiteral -> MayanLiteral -> Ordering
$ccompare :: MayanLiteral -> MayanLiteral -> Ordering
$cp1Ord :: Eq MayanLiteral
Ord, ReadPrec [MayanLiteral]
ReadPrec MayanLiteral
Int -> ReadS MayanLiteral
ReadS [MayanLiteral]
(Int -> ReadS MayanLiteral)
-> ReadS [MayanLiteral]
-> ReadPrec MayanLiteral
-> ReadPrec [MayanLiteral]
-> Read MayanLiteral
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MayanLiteral]
$creadListPrec :: ReadPrec [MayanLiteral]
readPrec :: ReadPrec MayanLiteral
$creadPrec :: ReadPrec MayanLiteral
readList :: ReadS [MayanLiteral]
$creadList :: ReadS [MayanLiteral]
readsPrec :: Int -> ReadS MayanLiteral
$creadsPrec :: Int -> ReadS MayanLiteral
Read, Int -> MayanLiteral -> ShowS
[MayanLiteral] -> ShowS
MayanLiteral -> String
(Int -> MayanLiteral -> ShowS)
-> (MayanLiteral -> String)
-> ([MayanLiteral] -> ShowS)
-> Show MayanLiteral
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MayanLiteral] -> ShowS
$cshowList :: [MayanLiteral] -> ShowS
show :: MayanLiteral -> String
$cshow :: MayanLiteral -> String
showsPrec :: Int -> MayanLiteral -> ShowS
$cshowsPrec :: Int -> MayanLiteral -> ShowS
Show)

instance NFData MayanLiteral

_mayanOffset :: Int
_mayanOffset :: Int
_mayanOffset = Int
0x1d2e0

instance Arbitrary MayanLiteral where
  arbitrary :: Gen MayanLiteral
arbitrary = Gen MayanLiteral
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance Hashable MayanLiteral

instance UnicodeCharacter MayanLiteral where
    toUnicodeChar :: MayanLiteral -> Char
toUnicodeChar = Int -> MayanLiteral -> Char
forall a. Enum a => Int -> a -> Char
mapFromEnum Int
_mayanOffset
    fromUnicodeChar :: Char -> Maybe MayanLiteral
fromUnicodeChar = Int -> Char -> Maybe MayanLiteral
forall a. (Bounded a, Enum a) => Int -> Char -> Maybe a
mapToEnumSafe Int
_mayanOffset
    fromUnicodeChar' :: Char -> MayanLiteral
fromUnicodeChar' = Int -> Char -> MayanLiteral
forall a. Enum a => Int -> Char -> a
mapToEnum Int
_mayanOffset

instance UnicodeText MayanLiteral

-- | Convert the given 'Integral' number to a 'Text' object that writes the Mayan number to to bottom.
-- This function will return a 'Nothing' in case the number is negative (since it can not be presented
-- in Mayan).
toMayanVertical :: Integral i
  => i -- ^ The given number to convert to a /vertical/ 'String' object.
  -> Maybe Text  -- ^ A 'Text' that contains the Mayan number wrapped in a 'Just' if we can represent the number; 'Nothing' otherwise.
toMayanVertical :: i -> Maybe Text
toMayanVertical i
n
  | i
n i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
0 = Maybe Text
forall a. Maybe a
Nothing
  | Bool
otherwise = Text -> Maybe Text
forall a. a -> Maybe a
Just (i -> Text
forall i. Integral i => i -> Text
toMayanVertical' i
n)

-- | Convert the given 'Integral' number to a 'Text' object that writes the Mayan number to to bottom.
toMayanVertical' :: Integral i
  => i -- ^ The given number to convert to a /vertical/ 'String' object.
  -> Text  -- ^ A 'Text' that contains the Mayan number.
toMayanVertical' :: i -> Text
toMayanVertical' = String -> Text
pack (String -> Text) -> (i -> String) -> i -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> String
forall i. Integral i => i -> String
toMayanVertical''

-- | Convert the given 'Integral' number to a 'String' object that writes the Mayan number to to bottom.
toMayanVertical'' :: Integral i
  => i -- ^ The given number to convert to a /vertical/ 'String' object.
  -> String  -- ^ A 'String' that contains the Mayan number.
toMayanVertical'' :: i -> String
toMayanVertical'' = [String] -> String
unlines ([String] -> String) -> (i -> [String]) -> i -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> [String]) -> (i -> String) -> i -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> String
forall i. Integral i => i -> String
toMayan''

-- | Convert the given 'Integral' number to a 'Text' object that writes the Mayan number from left-to-right.
-- The object is wrapped in a 'Just' data constructor. If the number is negative, and thus can not be
-- represented, 'Nothing' is returned.
toMayan :: Integral i
  => i -- ^ The given number to convert to a /horizontal/ 'String' object.
  -> Maybe Text  -- ^ A 'Text' that contains the Mayan number wrapped in a 'Just' if we can represent the number; 'Nothing' otherwise.
toMayan :: i -> Maybe Text
toMayan i
n
  | i
n i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
0 = Maybe Text
forall a. Maybe a
Nothing
  | Bool
otherwise = Text -> Maybe Text
forall a. a -> Maybe a
Just (i -> Text
forall i. Integral i => i -> Text
toMayan' i
n)

-- | Convert the given 'Integral' number to a 'Text' object that writes the Mayan number from left-to-right.
toMayan' :: Integral i
  => i -- ^ The given number to convert to a /horizontal/ 'String' object.
  -> Text  -- ^ A 'Text' that contains the Mayan number.
toMayan' :: i -> Text
toMayan' = String -> Text
pack (String -> Text) -> (i -> String) -> i -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> String
forall i. Integral i => i -> String
toMayan''

-- | Convert the given 'Integral' number to a 'String' object that writes the Mayan number from left-to-right.
toMayan'' :: Integral i
  => i -- ^ The given number to convert to a /horizontal/ 'String' object.
  -> String  -- ^ A 'String' that contains the Mayan number.
toMayan'' :: i -> String
toMayan'' = String -> i -> String
forall t. Integral t => String -> t -> String
go []
  where go :: String -> t -> String
go String
xs t
n | t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
19 = t -> Char
ch t
nChar -> ShowS
forall a. a -> [a] -> [a]
: String
xs
                | Bool
otherwise = String -> t -> String
go (t -> Char
ch t
rChar -> ShowS
forall a. a -> [a] -> [a]
:String
xs) t
q
          where ~(t
q, t
r) = t
n t -> t -> (t, t)
forall a. Integral a => a -> a -> (a, a)
`quotRem` t
20
                ch :: t -> Char
ch = MayanLiteral -> Char
forall a. UnicodeCharacter a => a -> Char
toUnicodeChar (MayanLiteral -> Char) -> (t -> MayanLiteral) -> t -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Enum MayanLiteral => Int -> MayanLiteral
forall a. Enum a => Int -> a
toEnum @MayanLiteral (Int -> MayanLiteral) -> (t -> Int) -> t -> MayanLiteral
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral