{-# 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
TallyLiteral -> TallyLiteral -> Bounded TallyLiteral
forall a. a -> a -> Bounded a
$cminBound :: TallyLiteral
minBound :: TallyLiteral
$cmaxBound :: TallyLiteral
maxBound :: TallyLiteral
Bounded, Typeable TallyLiteral
Typeable TallyLiteral
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> TallyLiteral -> c TallyLiteral)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TallyLiteral)
-> (TallyLiteral -> Constr)
-> (TallyLiteral -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> TallyLiteral -> TallyLiteral)
-> (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 u. (forall d. Data d => d -> u) -> TallyLiteral -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TallyLiteral -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TallyLiteral -> m TallyLiteral)
-> Data TallyLiteral
TallyLiteral -> Constr
TallyLiteral -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TallyLiteral -> c TallyLiteral
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TallyLiteral -> c TallyLiteral
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TallyLiteral
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TallyLiteral
$ctoConstr :: TallyLiteral -> Constr
toConstr :: TallyLiteral -> Constr
$cdataTypeOf :: TallyLiteral -> DataType
dataTypeOf :: TallyLiteral -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TallyLiteral)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TallyLiteral)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TallyLiteral)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TallyLiteral)
$cgmapT :: (forall b. Data b => b -> b) -> TallyLiteral -> TallyLiteral
gmapT :: (forall b. Data b => b -> b) -> TallyLiteral -> TallyLiteral
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TallyLiteral -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TallyLiteral -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TallyLiteral -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TallyLiteral -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TallyLiteral -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TallyLiteral -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TallyLiteral -> m TallyLiteral
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TallyLiteral -> m TallyLiteral
Data, Int -> TallyLiteral
TallyLiteral -> Int
TallyLiteral -> [TallyLiteral]
TallyLiteral -> TallyLiteral
TallyLiteral -> TallyLiteral -> [TallyLiteral]
TallyLiteral -> TallyLiteral -> TallyLiteral -> [TallyLiteral]
(TallyLiteral -> TallyLiteral)
-> (TallyLiteral -> TallyLiteral)
-> (Int -> TallyLiteral)
-> (TallyLiteral -> Int)
-> (TallyLiteral -> [TallyLiteral])
-> (TallyLiteral -> TallyLiteral -> [TallyLiteral])
-> (TallyLiteral -> TallyLiteral -> [TallyLiteral])
-> (TallyLiteral -> TallyLiteral -> TallyLiteral -> [TallyLiteral])
-> Enum 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
$csucc :: TallyLiteral -> TallyLiteral
succ :: TallyLiteral -> TallyLiteral
$cpred :: TallyLiteral -> TallyLiteral
pred :: TallyLiteral -> TallyLiteral
$ctoEnum :: Int -> TallyLiteral
toEnum :: Int -> TallyLiteral
$cfromEnum :: TallyLiteral -> Int
fromEnum :: TallyLiteral -> Int
$cenumFrom :: TallyLiteral -> [TallyLiteral]
enumFrom :: TallyLiteral -> [TallyLiteral]
$cenumFromThen :: TallyLiteral -> TallyLiteral -> [TallyLiteral]
enumFromThen :: TallyLiteral -> TallyLiteral -> [TallyLiteral]
$cenumFromTo :: TallyLiteral -> TallyLiteral -> [TallyLiteral]
enumFromTo :: TallyLiteral -> TallyLiteral -> [TallyLiteral]
$cenumFromThenTo :: TallyLiteral -> TallyLiteral -> TallyLiteral -> [TallyLiteral]
enumFromThenTo :: TallyLiteral -> TallyLiteral -> TallyLiteral -> [TallyLiteral]
Enum, TallyLiteral -> TallyLiteral -> Bool
(TallyLiteral -> TallyLiteral -> Bool)
-> (TallyLiteral -> TallyLiteral -> Bool) -> Eq TallyLiteral
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TallyLiteral -> TallyLiteral -> Bool
== :: TallyLiteral -> TallyLiteral -> Bool
$c/= :: TallyLiteral -> TallyLiteral -> Bool
/= :: TallyLiteral -> TallyLiteral -> Bool
Eq, (forall x. TallyLiteral -> Rep TallyLiteral x)
-> (forall x. Rep TallyLiteral x -> TallyLiteral)
-> Generic TallyLiteral
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
$cfrom :: forall x. TallyLiteral -> Rep TallyLiteral x
from :: forall x. TallyLiteral -> Rep TallyLiteral x
$cto :: forall x. Rep TallyLiteral x -> TallyLiteral
to :: forall x. Rep TallyLiteral x -> TallyLiteral
Generic, Int -> TallyLiteral -> ShowS
[TallyLiteral] -> ShowS
TallyLiteral -> String
(Int -> TallyLiteral -> ShowS)
-> (TallyLiteral -> String)
-> ([TallyLiteral] -> ShowS)
-> Show TallyLiteral
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TallyLiteral -> ShowS
showsPrec :: Int -> TallyLiteral -> ShowS
$cshow :: TallyLiteral -> String
show :: TallyLiteral -> String
$cshowList :: [TallyLiteral] -> ShowS
showList :: [TallyLiteral] -> ShowS
Show, ReadPrec [TallyLiteral]
ReadPrec TallyLiteral
Int -> ReadS TallyLiteral
ReadS [TallyLiteral]
(Int -> ReadS TallyLiteral)
-> ReadS [TallyLiteral]
-> ReadPrec TallyLiteral
-> ReadPrec [TallyLiteral]
-> Read TallyLiteral
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TallyLiteral
readsPrec :: Int -> ReadS TallyLiteral
$creadList :: ReadS [TallyLiteral]
readList :: ReadS [TallyLiteral]
$creadPrec :: ReadPrec TallyLiteral
readPrec :: ReadPrec TallyLiteral
$creadListPrec :: ReadPrec [TallyLiteral]
readListPrec :: ReadPrec [TallyLiteral]
Read)

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

instance UnicodeCharacter TallyLiteral where
  toUnicodeChar :: TallyLiteral -> Char
toUnicodeChar = Int -> TallyLiteral -> Char
forall a. Enum a => Int -> a -> Char
mapFromEnum Int
_tallyOffset
  fromUnicodeChar :: Char -> Maybe TallyLiteral
fromUnicodeChar = Int -> Char -> Maybe TallyLiteral
forall a. (Bounded a, Enum a) => Int -> Char -> Maybe a
mapToEnumSafe Int
_tallyOffset
  fromUnicodeChar' :: Char -> TallyLiteral
fromUnicodeChar' = Int -> Char -> TallyLiteral
forall a. Enum a => Int -> Char -> a
mapToEnum Int
_tallyOffset
  isInCharRange :: Char -> Bool
isInCharRange Char
c = Char
'\x1d377' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
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 i -> i -> Bool
forall a. Ord a => a -> a -> Bool
> i
0 = [TallyLiteral] -> Maybe [TallyLiteral]
forall a. a -> Maybe a
Just (i -> [TallyLiteral]
forall i. Integral i => i -> [TallyLiteral]
toLiterals' i
k)
  | Bool
otherwise = Maybe [TallyLiteral]
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 = i -> TallyLiteral -> [TallyLiteral]
forall i a. Integral i => i -> a -> [a]
genericReplicate i
k0 TallyLiteral
V [TallyLiteral] -> [TallyLiteral] -> [TallyLiteral]
forall a. [a] -> [a] -> [a]
++ i -> TallyLiteral -> [TallyLiteral]
forall i a. Integral i => i -> a -> [a]
genericReplicate i
k1 TallyLiteral
I
  where
    ~(i
k0, i
k1) = i
k i -> i -> (i, i)
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 i -> i -> Bool
forall a. Ord a => a -> a -> Bool
> i
0 = Text -> Maybe Text
forall a. a -> Maybe a
Just (i -> Text
forall i. Integral i => i -> Text
tallyNumber' i
k)
  | Bool
otherwise = Maybe Text
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 (String -> Text) -> (i -> String) -> i -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TallyLiteral -> Char) -> [TallyLiteral] -> String
forall a b. (a -> b) -> [a] -> [b]
map TallyLiteral -> Char
forall a. UnicodeCharacter a => a -> Char
toUnicodeChar ([TallyLiteral] -> String) -> (i -> [TallyLiteral]) -> i -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> [TallyLiteral]
forall i. Integral i => i -> [TallyLiteral]
toLiterals'