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

-- |
-- Module      : Data.Char.Number.Tally
-- Description : A module to print Tally numerals.
-- Maintainer  : hapytexeu+gh@gmail.com
-- Stability   : experimental
-- Portability : POSIX
--
-- This module aims to convert numbers to (Western) tally marks and vice versa.
module Data.Char.Number.Tally
  ( -- * Data types to represent tally marks
    TallyLiteral (I, V),

    -- * Convert a number to 'TallyLiteral's
    toLiterals,
    toLiterals',
    tallyNumber,
    tallyNumber',
  )
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.List (genericReplicate)
import Data.Text (Text, pack)
import GHC.Generics (Generic)
import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary), arbitraryBoundedEnum)

_tallyOffset :: Int
_tallyOffset :: Int
_tallyOffset = Int
0x1d377

-- | A tally literal that is either a one (𝍷), or five grouped together (𝍸).
data TallyLiteral
  = -- | The unicode character for the tally numeral /one/: 𝍷.
    I
  | -- | The unicode character for the tally numeral /five/: 𝍸.
    V
  deriving (TallyLiteral
forall a. a -> a -> Bounded a
maxBound :: TallyLiteral
$cmaxBound :: TallyLiteral
minBound :: TallyLiteral
$cminBound :: TallyLiteral
Bounded, Typeable TallyLiteral
TallyLiteral -> DataType
TallyLiteral -> Constr
(forall b. Data b => b -> b) -> TallyLiteral -> TallyLiteral
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) -> TallyLiteral -> u
forall u. (forall d. Data d => d -> u) -> TallyLiteral -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TallyLiteral -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TallyLiteral -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TallyLiteral -> m TallyLiteral
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TallyLiteral -> m TallyLiteral
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TallyLiteral
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TallyLiteral -> c TallyLiteral
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TallyLiteral)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TallyLiteral)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TallyLiteral -> m TallyLiteral
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TallyLiteral -> m TallyLiteral
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TallyLiteral -> m TallyLiteral
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TallyLiteral -> m TallyLiteral
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TallyLiteral -> m TallyLiteral
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TallyLiteral -> m TallyLiteral
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TallyLiteral -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TallyLiteral -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TallyLiteral -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TallyLiteral -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TallyLiteral -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TallyLiteral -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TallyLiteral -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TallyLiteral -> r
gmapT :: (forall b. Data b => b -> b) -> TallyLiteral -> TallyLiteral
$cgmapT :: (forall b. Data b => b -> b) -> TallyLiteral -> TallyLiteral
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TallyLiteral)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TallyLiteral)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TallyLiteral)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TallyLiteral)
dataTypeOf :: TallyLiteral -> DataType
$cdataTypeOf :: TallyLiteral -> DataType
toConstr :: TallyLiteral -> Constr
$ctoConstr :: TallyLiteral -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TallyLiteral
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TallyLiteral
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TallyLiteral -> c TallyLiteral
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TallyLiteral -> c TallyLiteral
Data, Int -> TallyLiteral
TallyLiteral -> Int
TallyLiteral -> [TallyLiteral]
TallyLiteral -> TallyLiteral
TallyLiteral -> TallyLiteral -> [TallyLiteral]
TallyLiteral -> TallyLiteral -> TallyLiteral -> [TallyLiteral]
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 :: TallyLiteral -> TallyLiteral -> TallyLiteral -> [TallyLiteral]
$cenumFromThenTo :: TallyLiteral -> TallyLiteral -> TallyLiteral -> [TallyLiteral]
enumFromTo :: TallyLiteral -> TallyLiteral -> [TallyLiteral]
$cenumFromTo :: TallyLiteral -> TallyLiteral -> [TallyLiteral]
enumFromThen :: TallyLiteral -> TallyLiteral -> [TallyLiteral]
$cenumFromThen :: TallyLiteral -> TallyLiteral -> [TallyLiteral]
enumFrom :: TallyLiteral -> [TallyLiteral]
$cenumFrom :: TallyLiteral -> [TallyLiteral]
fromEnum :: TallyLiteral -> Int
$cfromEnum :: TallyLiteral -> Int
toEnum :: Int -> TallyLiteral
$ctoEnum :: Int -> TallyLiteral
pred :: TallyLiteral -> TallyLiteral
$cpred :: TallyLiteral -> TallyLiteral
succ :: TallyLiteral -> TallyLiteral
$csucc :: TallyLiteral -> TallyLiteral
Enum, TallyLiteral -> TallyLiteral -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TallyLiteral -> TallyLiteral -> Bool
$c/= :: TallyLiteral -> TallyLiteral -> Bool
== :: TallyLiteral -> TallyLiteral -> Bool
$c== :: TallyLiteral -> TallyLiteral -> Bool
Eq, forall x. Rep TallyLiteral x -> TallyLiteral
forall x. TallyLiteral -> Rep TallyLiteral x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TallyLiteral x -> TallyLiteral
$cfrom :: forall x. TallyLiteral -> Rep TallyLiteral x
Generic, Int -> TallyLiteral -> ShowS
[TallyLiteral] -> ShowS
TallyLiteral -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TallyLiteral] -> ShowS
$cshowList :: [TallyLiteral] -> ShowS
show :: TallyLiteral -> String
$cshow :: TallyLiteral -> String
showsPrec :: Int -> TallyLiteral -> ShowS
$cshowsPrec :: Int -> TallyLiteral -> ShowS
Show, ReadPrec [TallyLiteral]
ReadPrec TallyLiteral
Int -> ReadS TallyLiteral
ReadS [TallyLiteral]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TallyLiteral]
$creadListPrec :: ReadPrec [TallyLiteral]
readPrec :: ReadPrec TallyLiteral
$creadPrec :: ReadPrec TallyLiteral
readList :: ReadS [TallyLiteral]
$creadList :: ReadS [TallyLiteral]
readsPrec :: Int -> ReadS TallyLiteral
$creadsPrec :: Int -> ReadS TallyLiteral
Read)

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

instance UnicodeCharacter TallyLiteral where
  toUnicodeChar :: TallyLiteral -> Char
toUnicodeChar = forall a. Enum a => Int -> a -> Char
mapFromEnum Int
_tallyOffset
  fromUnicodeChar :: Char -> Maybe TallyLiteral
fromUnicodeChar = forall a. (Bounded a, Enum a) => Int -> Char -> Maybe a
mapToEnumSafe Int
_tallyOffset
  fromUnicodeChar' :: Char -> TallyLiteral
fromUnicodeChar' = forall a. Enum a => Int -> Char -> a
mapToEnum Int
_tallyOffset
  isInCharRange :: Char -> Bool
isInCharRange Char
c = Char
'\x1d377' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x1d378'

instance UnicodeText TallyLiteral where
  isInTextRange :: Text -> Bool
isInTextRange = forall a. UnicodeCharacter a => Text -> Bool
generateIsInTextRange' @TallyLiteral

instance Hashable TallyLiteral

instance NFData TallyLiteral

-- | Convert a given /positive/ natural number to a sequence of 'TallyLiteral's.
toLiterals ::
  Integral i =>
  -- | The given number to convert.
  i ->
  -- | A list of 'TallyLiteral's if the given number can be specified with tally marks, 'Nothing' otherwise.
  Maybe [TallyLiteral]
toLiterals :: forall i. Integral i => i -> Maybe [TallyLiteral]
toLiterals i
k
  | i
k forall a. Ord a => a -> a -> Bool
> i
0 = forall a. a -> Maybe a
Just (forall i. Integral i => i -> [TallyLiteral]
toLiterals' i
k)
  | Bool
otherwise = forall a. Maybe a
Nothing

-- | Convert a given number to a sequence of 'TallyLiteral's, for negative numbers or zero, the behavior is unspecified.
toLiterals' ::
  Integral i =>
  -- | The given number to convert.
  i ->
  -- | A list of 'TallyLiteral's that denotes the given number.
  [TallyLiteral]
toLiterals' :: forall i. Integral i => i -> [TallyLiteral]
toLiterals' i
k = forall i a. Integral i => i -> a -> [a]
genericReplicate i
k0 TallyLiteral
V forall a. [a] -> [a] -> [a]
++ forall i a. Integral i => i -> a -> [a]
genericReplicate i
k1 TallyLiteral
I
  where
    ~(i
k0, i
k1) = i
k forall a. Integral a => a -> a -> (a, a)
`divMod` i
5

-- | Convert a given /positive/ natural number to a 'Text' object with the tally marks for that number.
tallyNumber ::
  Integral i =>
  -- | The given number to convert.
  i ->
  -- | A 'Text' with the tally marks wrapped in a 'Just' if the number can be represented with tally marks; 'Nothing' otherwise.
  Maybe Text
tallyNumber :: forall i. Integral i => i -> Maybe Text
tallyNumber i
k
  | i
k forall a. Ord a => a -> a -> Bool
> i
0 = forall a. a -> Maybe a
Just (forall i. Integral i => i -> Text
tallyNumber' i
k)
  | Bool
otherwise = forall a. Maybe a
Nothing

-- | Convert a given number to a 'Text' object with the tally marks for that number, for negative numbers or zero, the behavior is unspecified.
tallyNumber' ::
  Integral i =>
  -- | The given number to convert.
  i ->
  -- | The corresponding 'Text' that contains the number as /tally marks/.
  Text
tallyNumber' :: forall i. Integral i => i -> Text
tallyNumber' = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. UnicodeCharacter a => a -> Char
toUnicodeChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => i -> [TallyLiteral]
toLiterals'