{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE 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 (fromUnicodeChar, fromUnicodeChar', isInCharRange, toUnicodeChar), UnicodeText (isInTextRange), generateIsInTextRange', 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
  = -- | The unicode character for the Mayan numeral /zero/: 𝋠.
    Zero
  | -- | The unicode character for the Mayan numeral /one/: 𝋡.
    One
  | -- | The unicode character for the Mayan numeral /two/: 𝋢.
    Two
  | -- | The unicode character for the Mayan numeral /three/: 𝋣.
    Three
  | -- | The unicode character for the Mayan numeral /four/: 𝋤.
    Four
  | -- | The unicode character for the Mayan numeral /five/: 𝋥.
    Five
  | -- | The unicode character for the Mayan numeral /six/: 𝋦.
    Six
  | -- | The unicode character for the Mayan numeral /seven/: 𝋧.
    Seven
  | -- | The unicode character for the Mayan numeral /eight/: 𝋨.
    Eight
  | -- | The unicode character for the Mayan numeral /nine/: 𝋩.
    Nine
  | -- | The unicode character for the Mayan numeral /ten/: 𝋪.
    Ten
  | -- | The unicode character for the Mayan numeral /eleven/: 𝋫.
    Eleven
  | -- | The unicode character for the Mayan numeral /twelve/: 𝋬.
    Twelve
  | -- | The unicode character for the Mayan numeral /thirteen/: 𝋭.
    Thirteen
  | -- | The unicode character for the Mayan numeral /fourteen/: 𝋮.
    Fourteen
  | -- | The unicode character for the Mayan numeral /fifteen/: 𝋯.
    Fifteen
  | -- | The unicode character for the Mayan numeral /sixteen/: 𝋰.
    Sixteen
  | -- | The unicode character for the Mayan numeral /seventeen/: 𝋱.
    Seventeen
  | -- | The unicode character for the Mayan numeral /eighteen/: 𝋲.
    Eighteen
  | -- | The unicode character for the Mayan numeral /nineteen/: 𝋳.
    Nineteen
  deriving (MayanLiteral
forall a. a -> a -> Bounded a
maxBound :: MayanLiteral
$cmaxBound :: MayanLiteral
minBound :: MayanLiteral
$cminBound :: MayanLiteral
Bounded, Typeable MayanLiteral
MayanLiteral -> DataType
MayanLiteral -> Constr
(forall b. Data b => b -> b) -> MayanLiteral -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> MayanLiteral -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MayanLiteral -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> MayanLiteral -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MayanLiteral -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, Int -> MayanLiteral
MayanLiteral -> Int
MayanLiteral -> [MayanLiteral]
MayanLiteral -> MayanLiteral
MayanLiteral -> MayanLiteral -> [MayanLiteral]
MayanLiteral -> MayanLiteral -> MayanLiteral -> [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
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. 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
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
Ord, ReadPrec [MayanLiteral]
ReadPrec MayanLiteral
Int -> ReadS MayanLiteral
ReadS [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
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 = forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance Hashable MayanLiteral

instance UnicodeCharacter MayanLiteral where
  toUnicodeChar :: MayanLiteral -> Char
toUnicodeChar = forall a. Enum a => Int -> a -> Char
mapFromEnum Int
_mayanOffset
  fromUnicodeChar :: Char -> Maybe MayanLiteral
fromUnicodeChar = forall a. (Bounded a, Enum a) => Int -> Char -> Maybe a
mapToEnumSafe Int
_mayanOffset
  fromUnicodeChar' :: Char -> MayanLiteral
fromUnicodeChar' = forall a. Enum a => Int -> Char -> a
mapToEnum Int
_mayanOffset
  isInCharRange :: Char -> Bool
isInCharRange Char
c = Char
'\x1d2e0' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x1d2f3'

instance UnicodeText MayanLiteral where
  isInTextRange :: Text -> Bool
isInTextRange = forall a. UnicodeCharacter a => Text -> Bool
generateIsInTextRange' @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 =>
  -- | The given number to convert to a /vertical/ 'String' object.
  i ->
  -- | A 'Text' that contains the Mayan number wrapped in a 'Just' if we can represent the number; 'Nothing' otherwise.
  Maybe Text
toMayanVertical :: forall i. Integral i => i -> Maybe Text
toMayanVertical i
n
  | i
n forall a. Ord a => a -> a -> Bool
< i
0 = forall a. Maybe a
Nothing
  | Bool
otherwise = forall a. a -> Maybe a
Just (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 =>
  -- | The given number to convert to a /vertical/ 'String' object.
  i ->
  -- | A 'Text' that contains the Mayan number.
  Text
toMayanVertical' :: forall i. Integral i => i -> Text
toMayanVertical' = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =>
  -- | The given number to convert to a /vertical/ 'String' object.
  i ->
  -- | A 'String' that contains the Mayan number.
  String
toMayanVertical'' :: forall i. Integral i => i -> String
toMayanVertical'' = [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =>
  -- | The given number to convert to a /horizontal/ 'String' object.
  i ->
  -- | A 'Text' that contains the Mayan number wrapped in a 'Just' if we can represent the number; 'Nothing' otherwise.
  Maybe Text
toMayan :: forall i. Integral i => i -> Maybe Text
toMayan i
n
  | i
n forall a. Ord a => a -> a -> Bool
< i
0 = forall a. Maybe a
Nothing
  | Bool
otherwise = forall a. a -> Maybe a
Just (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 =>
  -- | The given number to convert to a /horizontal/ 'String' object.
  i ->
  -- | A 'Text' that contains the Mayan number.
  Text
toMayan' :: forall i. Integral i => i -> Text
toMayan' = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =>
  -- | The given number to convert to a /horizontal/ 'String' object.
  i ->
  -- | A 'String' that contains the Mayan number.
  String
toMayan'' :: forall i. Integral i => i -> String
toMayan'' = forall {t}. Integral t => String -> t -> String
go []
  where
    go :: String -> t -> String
go String
xs t
n
      | t
n forall a. Ord a => a -> a -> Bool
<= t
19 = t -> Char
ch t
n forall a. a -> [a] -> [a]
: String
xs
      | Bool
otherwise = String -> t -> String
go (t -> Char
ch t
r forall a. a -> [a] -> [a]
: String
xs) t
q
      where
        ~(t
q, t
r) = t
n forall a. Integral a => a -> a -> (a, a)
`quotRem` t
20
        ch :: t -> Char
ch = forall a. UnicodeCharacter a => a -> Char
toUnicodeChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum @MayanLiteral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral