-- | Defines a 'D10' type as
-- @'D0' | 'D1' | 'D2' | 'D3' | 'D4' | 'D5' | 'D6' | 'D7' | 'D8' | 'D9'@.
--
-- The following modules define @D10@ types in different ways
-- but are otherwise very similar to this one:
--
-- * "Data.D10.Char"
-- * "Data.D10.Num"
--
-- This module is called "safe" because, in contrast with the
-- alternative representations of a digit defined in the other
-- modules, this 'D10' type does not include any possibility
-- of representing an invalid non-digit value.

module Data.D10.Safe
    (
    -- * Type
      D10 (..)
    -- $bounded
    -- $enum

    -- * Quasi-quoters
    , d10list

    -- * Splice expressions
    , d10ListExp

    -- * Splice patterns
    , d10ListPat

    -- * Converting between D10 and Char
    , d10Char
    , charD10Maybe
    , charD10Either
    , charD10Fail

    -- * Converting between D10 and String
    , d10Str
    , strD10Maybe
    , strD10Either
    , strD10Fail

    -- * Converting between [D10] and String
    , strD10ListMaybe
    , strD10ListEither
    , strD10ListFail

    -- * Converting between D10 and Natural
    , d10Nat
    , natD10Maybe
    , natD10Either
    , natD10Fail
    , natMod10

    -- * Converting between D10 and Integer
    , d10Integer
    , integerD10Maybe
    , integerD10Either
    , integerD10Fail
    , integerMod10

    -- * Converting between D10 and Int
    , d10Int
    , intD10Maybe
    , intD10Either
    , intD10Fail
    , intMod10

    -- * Converting between D10 and general numeric types
    , d10Num
    , integralD10Maybe
    , integralD10Either
    , integralD10Fail
    , integralMod10

    -- * Modular arithmetic
    , (+), (-), (*)

    ) where

-- base
import Control.Monad      ((>=>))
import Control.Monad.Fail (MonadFail (fail))
import Data.Data          (Data)
import GHC.Generics       (Generic)
import Numeric.Natural    (Natural)
import Prelude            hiding (fail, (+), (-), (*))

import qualified Prelude as P

-- template-haskell
import Language.Haskell.TH.Quote  (QuasiQuoter (..))
import Language.Haskell.TH.Syntax (Exp (..), Lift, Pat (..), Q, dataToPatQ)

---------------------------------------------------

-- | A whole number between /0/ and /9/.

data D10
    = D0  -- ^ Zero
    | D1  -- ^ One
    | D2  -- ^ Two
    | D3  -- ^ Three
    | D4  -- ^ Four
    | D5  -- ^ Five
    | D6  -- ^ Six
    | D7  -- ^ Seven
    | D8  -- ^ Eight
    | D9  -- ^ Nine
    deriving (D10
D10 -> D10 -> Bounded D10
forall a. a -> a -> Bounded a
maxBound :: D10
$cmaxBound :: D10
minBound :: D10
$cminBound :: D10
Bounded, Int -> D10
D10 -> Int
D10 -> [D10]
D10 -> D10
D10 -> D10 -> [D10]
D10 -> D10 -> D10 -> [D10]
(D10 -> D10)
-> (D10 -> D10)
-> (Int -> D10)
-> (D10 -> Int)
-> (D10 -> [D10])
-> (D10 -> D10 -> [D10])
-> (D10 -> D10 -> [D10])
-> (D10 -> D10 -> D10 -> [D10])
-> Enum D10
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 :: D10 -> D10 -> D10 -> [D10]
$cenumFromThenTo :: D10 -> D10 -> D10 -> [D10]
enumFromTo :: D10 -> D10 -> [D10]
$cenumFromTo :: D10 -> D10 -> [D10]
enumFromThen :: D10 -> D10 -> [D10]
$cenumFromThen :: D10 -> D10 -> [D10]
enumFrom :: D10 -> [D10]
$cenumFrom :: D10 -> [D10]
fromEnum :: D10 -> Int
$cfromEnum :: D10 -> Int
toEnum :: Int -> D10
$ctoEnum :: Int -> D10
pred :: D10 -> D10
$cpred :: D10 -> D10
succ :: D10 -> D10
$csucc :: D10 -> D10
Enum, D10 -> D10 -> Bool
(D10 -> D10 -> Bool) -> (D10 -> D10 -> Bool) -> Eq D10
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: D10 -> D10 -> Bool
$c/= :: D10 -> D10 -> Bool
== :: D10 -> D10 -> Bool
$c== :: D10 -> D10 -> Bool
Eq, D10 -> Q Exp
D10 -> Q (TExp D10)
(D10 -> Q Exp) -> (D10 -> Q (TExp D10)) -> Lift D10
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: D10 -> Q (TExp D10)
$cliftTyped :: D10 -> Q (TExp D10)
lift :: D10 -> Q Exp
$clift :: D10 -> Q Exp
Lift, Eq D10
Eq D10
-> (D10 -> D10 -> Ordering)
-> (D10 -> D10 -> Bool)
-> (D10 -> D10 -> Bool)
-> (D10 -> D10 -> Bool)
-> (D10 -> D10 -> Bool)
-> (D10 -> D10 -> D10)
-> (D10 -> D10 -> D10)
-> Ord D10
D10 -> D10 -> Bool
D10 -> D10 -> Ordering
D10 -> D10 -> D10
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 :: D10 -> D10 -> D10
$cmin :: D10 -> D10 -> D10
max :: D10 -> D10 -> D10
$cmax :: D10 -> D10 -> D10
>= :: D10 -> D10 -> Bool
$c>= :: D10 -> D10 -> Bool
> :: D10 -> D10 -> Bool
$c> :: D10 -> D10 -> Bool
<= :: D10 -> D10 -> Bool
$c<= :: D10 -> D10 -> Bool
< :: D10 -> D10 -> Bool
$c< :: D10 -> D10 -> Bool
compare :: D10 -> D10 -> Ordering
$ccompare :: D10 -> D10 -> Ordering
$cp1Ord :: Eq D10
Ord, Int -> D10 -> ShowS
[D10] -> ShowS
D10 -> String
(Int -> D10 -> ShowS)
-> (D10 -> String) -> ([D10] -> ShowS) -> Show D10
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [D10] -> ShowS
$cshowList :: [D10] -> ShowS
show :: D10 -> String
$cshow :: D10 -> String
showsPrec :: Int -> D10 -> ShowS
$cshowsPrec :: Int -> D10 -> ShowS
Show, Typeable D10
DataType
Constr
Typeable D10
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> D10 -> c D10)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c D10)
-> (D10 -> Constr)
-> (D10 -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c D10))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c D10))
-> ((forall b. Data b => b -> b) -> D10 -> D10)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> D10 -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> D10 -> r)
-> (forall u. (forall d. Data d => d -> u) -> D10 -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> D10 -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> D10 -> m D10)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> D10 -> m D10)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> D10 -> m D10)
-> Data D10
D10 -> DataType
D10 -> Constr
(forall b. Data b => b -> b) -> D10 -> D10
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> D10 -> c D10
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c D10
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) -> D10 -> u
forall u. (forall d. Data d => d -> u) -> D10 -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> D10 -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> D10 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> D10 -> m D10
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> D10 -> m D10
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c D10
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> D10 -> c D10
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c D10)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c D10)
$cD9 :: Constr
$cD8 :: Constr
$cD7 :: Constr
$cD6 :: Constr
$cD5 :: Constr
$cD4 :: Constr
$cD3 :: Constr
$cD2 :: Constr
$cD1 :: Constr
$cD0 :: Constr
$tD10 :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> D10 -> m D10
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> D10 -> m D10
gmapMp :: (forall d. Data d => d -> m d) -> D10 -> m D10
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> D10 -> m D10
gmapM :: (forall d. Data d => d -> m d) -> D10 -> m D10
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> D10 -> m D10
gmapQi :: Int -> (forall d. Data d => d -> u) -> D10 -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> D10 -> u
gmapQ :: (forall d. Data d => d -> u) -> D10 -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> D10 -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> D10 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> D10 -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> D10 -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> D10 -> r
gmapT :: (forall b. Data b => b -> b) -> D10 -> D10
$cgmapT :: (forall b. Data b => b -> b) -> D10 -> D10
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c D10)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c D10)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c D10)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c D10)
dataTypeOf :: D10 -> DataType
$cdataTypeOf :: D10 -> DataType
toConstr :: D10 -> Constr
$ctoConstr :: D10 -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c D10
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c D10
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> D10 -> c D10
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> D10 -> c D10
$cp1Data :: Typeable D10
Data, (forall x. D10 -> Rep D10 x)
-> (forall x. Rep D10 x -> D10) -> Generic D10
forall x. Rep D10 x -> D10
forall x. D10 -> Rep D10 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep D10 x -> D10
$cfrom :: forall x. D10 -> Rep D10 x
Generic)

-- $bounded
-- ==== Bounded
--
-- >>> minBound :: D10
-- D0
--
-- >>> maxBound :: D10
-- D9

-- $enum
-- ==== Enum
--
-- >>> [ D5 .. ]
-- [D5,D6,D7,D8,D9]
--
-- >>> [ D4 .. D7 ]
-- [D4,D5,D6,D7]
--
-- >>> [ D5, D4 .. ]
-- [D5,D4,D3,D2,D1,D0]
--
-- >>> [ D1, D3 .. ]
-- [D1,D3,D5,D7,D9]
--
-- >>> [ minBound .. maxBound ] :: [D10]
-- [D0,D1,D2,D3,D4,D5,D6,D7,D8,D9]

---------------------------------------------------

-- | Convert a 'D10' to its underlying 'Char' representation.
--
-- >>> d10Char D7
-- '7'

d10Char :: D10 -> Char
d10Char :: D10 -> Char
d10Char D10
x =
    case D10
x of
        D10
D0 -> Char
'0'
        D10
D1 -> Char
'1'
        D10
D2 -> Char
'2'
        D10
D3 -> Char
'3'
        D10
D4 -> Char
'4'
        D10
D5 -> Char
'5'
        D10
D6 -> Char
'6'
        D10
D7 -> Char
'7'
        D10
D8 -> Char
'8'
        D10
D9 -> Char
'9'

-- | Convert a 'D10' to a 'String'.
--
-- @'d10Str' x = ['d10Char' x]@
--
-- >>> d10Str D7
-- "7"

d10Str :: D10 -> String
d10Str :: D10 -> String
d10Str D10
x = [D10 -> Char
d10Char D10
x]

-- | Convert a 'D10' to a 'Natural'.
--
-- 'd10Num' is a more general version of this function.
--
-- >>> d10Nat D7
-- 7

d10Nat :: D10 -> Natural
d10Nat :: D10 -> Natural
d10Nat = D10 -> Natural
forall a. Num a => D10 -> a
d10Num

-- | Convert a 'D10' to an 'Integer'.
--
-- 'd10Num' is a more general version of this function.
--
-- >>> d10Integer D7
-- 7

d10Integer :: D10 -> Integer
d10Integer :: D10 -> Integer
d10Integer = D10 -> Integer
forall a. Num a => D10 -> a
d10Num

-- | Convert a 'D10' to an 'Int'.
--
-- 'd10Num' is a more general version of this function.
--
-- >>> d10Int D7
-- 7

d10Int :: D10 -> Int
d10Int :: D10 -> Int
d10Int = D10 -> Int
forall a. Num a => D10 -> a
d10Num

-- | Convert a 'D10' to any kind of number with a 'Num' instance.
--
-- Specialized versions of this function include 'd10Nat',
-- 'd10Integer', and 'd10Int'.
--
-- >>> d10Num D7 :: Integer
-- 7

d10Num :: Num a => D10 -> a
d10Num :: D10 -> a
d10Num D10
x =
    case D10
x of
        D10
D0 -> a
0
        D10
D1 -> a
1
        D10
D2 -> a
2
        D10
D3 -> a
3
        D10
D4 -> a
4
        D10
D5 -> a
5
        D10
D6 -> a
6
        D10
D7 -> a
7
        D10
D8 -> a
8
        D10
D9 -> a
9

---------------------------------------------------

-- | The 'D10' which is uniquely congruent modulo 10 to the given 'Natural'.
--
-- 'integralMod10' is a more general version of this function.
--
-- >>> natMod10 56
-- D6

natMod10 :: Natural -> D10
natMod10 :: Natural -> D10
natMod10 = Natural -> D10
forall a. Integral a => a -> D10
integralMod10

-- | The 'D10' which is uniquely congruent modulo 10 to the given 'Integer'.
--
-- 'integralMod10' is a more general version of this function.
--
-- >>> integerMod10 56
-- D6
--
-- >>> integerMod10 (-56)
-- D4

integerMod10 :: Integer -> D10
integerMod10 :: Integer -> D10
integerMod10 = Integer -> D10
forall a. Integral a => a -> D10
integralMod10

-- | The 'D10' which is uniquely congruent modulo 10 to the given 'Int'.
--
-- 'integralMod10' is a more general version of this function.
--
-- >>> intMod10 56
-- D6
--
-- >>> intMod10 (-56)
-- D4

intMod10 :: Int -> D10
intMod10 :: Int -> D10
intMod10 = Int -> D10
forall a. Integral a => a -> D10
integralMod10

-- | The 'D10' which is uniquely congruent modulo 10 to the given number
-- (whose type must have an instance of the 'Integral' class).
--
-- Specialized versions of this function include 'natMod10',
-- 'integerMod10', and 'intMod10'.
--
-- >>> integralMod10 (56 :: Integer)
-- D6
--
-- >>> integralMod10 ((-56) :: Integer)
-- D4

integralMod10 :: Integral a => a -> D10
integralMod10 :: a -> D10
integralMod10 a
x =
    case (a
x a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
10) of
        a
0 -> D10
D0
        a
1 -> D10
D1
        a
2 -> D10
D2
        a
3 -> D10
D3
        a
4 -> D10
D4
        a
5 -> D10
D5
        a
6 -> D10
D6
        a
7 -> D10
D7
        a
8 -> D10
D8
        a
9 -> D10
D9
        a
_ -> String -> D10
forall a. HasCallStack => String -> a
error String
"x `mod` 10 is not between 0 and 9"

---------------------------------------------------

-- | Convert a 'Char' to a 'D10' if it is within the range
-- @'0'@ to @'9'@, or produce 'Nothing' otherwise.
--
-- @'Data.D10.Predicate.isD10Char' x = 'Data.Maybe.isJust' ('charD10Maybe' x)@
--
-- 'charD10Fail' is a more general version of this function.
--
-- >>> charD10Maybe '5'
-- Just D5
--
-- >>> charD10Maybe 'a'
-- Nothing

charD10Maybe :: Char -> Maybe D10
charD10Maybe :: Char -> Maybe D10
charD10Maybe Char
x =
    case Char
x of
        Char
'0' -> D10 -> Maybe D10
forall a. a -> Maybe a
Just D10
D0
        Char
'1' -> D10 -> Maybe D10
forall a. a -> Maybe a
Just D10
D1
        Char
'2' -> D10 -> Maybe D10
forall a. a -> Maybe a
Just D10
D2
        Char
'3' -> D10 -> Maybe D10
forall a. a -> Maybe a
Just D10
D3
        Char
'4' -> D10 -> Maybe D10
forall a. a -> Maybe a
Just D10
D4
        Char
'5' -> D10 -> Maybe D10
forall a. a -> Maybe a
Just D10
D5
        Char
'6' -> D10 -> Maybe D10
forall a. a -> Maybe a
Just D10
D6
        Char
'7' -> D10 -> Maybe D10
forall a. a -> Maybe a
Just D10
D7
        Char
'8' -> D10 -> Maybe D10
forall a. a -> Maybe a
Just D10
D8
        Char
'9' -> D10 -> Maybe D10
forall a. a -> Maybe a
Just D10
D9
        Char
_   -> Maybe D10
forall a. Maybe a
Nothing

-- | Convert a 'String' to a 'D10' if it consists of exactly one
-- character and that character is within the range @'0'@ to @'9'@,
-- or produce 'Nothing' otherwise.
--
-- @'Data.D10.Predicate.isD10Str' x = 'Data.Maybe.isJust' ('strD10Maybe' x)@
--
-- 'strD10Fail' is a more general version of this function.
--
-- >>> strD10Maybe "5"
-- Just D5
--
-- >>> strD10Maybe "a"
-- Nothing
--
-- >>> strD10Maybe "58"
-- Nothing

strD10Maybe :: String -> Maybe D10
strD10Maybe :: String -> Maybe D10
strD10Maybe [Char
x] = Char -> Maybe D10
charD10Maybe Char
x
strD10Maybe String
_   = Maybe D10
forall a. Maybe a
Nothing

-- | Convert a 'String' to a list of 'D10' if all of the characters
-- in the string are within the range @'0'@ to @'9'@, or produce
-- 'Nothing' otherwise.
--
-- @'Data.D10.Predicate.isD10ListStr' x = 'Data.Maybe.isJust' ('strD10ListMaybe' x)@
--
-- 'strD10ListFail' is a more general version of this function.
--
-- >>> strD10ListMaybe "5"
-- Just [D5]
--
-- >>> strD10ListMaybe "a"
-- Nothing
--
-- >>> strD10ListMaybe "58"
-- Just [D5,D8]

strD10ListMaybe :: String -> Maybe [D10]
strD10ListMaybe :: String -> Maybe [D10]
strD10ListMaybe = (Char -> Maybe D10) -> String -> Maybe [D10]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Char -> Maybe D10
charD10Maybe

-- | Convert a 'Natural' to a 'D10' if it is less than 10,
-- or produce 'Nothing' otherwise.
--
-- @'Data.D10.Predicate.isD10Nat' x = 'Data.Maybe.isJust' ('natD10Maybe' x)@
--
-- 'integralD10Maybe', 'natD10Fail', and 'integralD10Fail'
-- are more general versions of this function.
--
-- >>> natD10Maybe 5
-- Just D5
--
-- >>> natD10Maybe 12
-- Nothing

natD10Maybe :: Natural -> Maybe D10
natD10Maybe :: Natural -> Maybe D10
natD10Maybe = Natural -> Maybe D10
forall a. Integral a => a -> Maybe D10
integralD10Maybe

-- | Convert an 'Integer' to a 'D10' if it is within the range 0 to 9,
-- or produce 'Nothing' otherwise.
--
-- @'Data.D10.Predicate.isD10Integer' x = 'Data.Maybe.isJust' ('integerD10Maybe' x)@
--
-- 'integralD10Maybe', 'integerD10Fail', and 'integralD10Fail'
-- are more general versions of this function.
--
-- >>> integerD10Maybe 5
-- Just D5
--
-- >>> integerD10Maybe 12
-- Nothing
--
-- >>> integerD10Maybe (-5)
-- Nothing

integerD10Maybe :: Integer -> Maybe D10
integerD10Maybe :: Integer -> Maybe D10
integerD10Maybe = Integer -> Maybe D10
forall a. Integral a => a -> Maybe D10
integralD10Maybe

-- | Convert an 'Int' to a 'D10' if it is within the range 0 to 9,
-- or produce 'Nothing' otherwise.
--
-- @'Data.D10.Predicate.isD10Int' x = 'Data.Maybe.isJust' ('intD10Maybe' x)@
--
-- 'integralD10Maybe', 'intD10Fail', and 'integralD10Fail'
-- are more general versions of this function.
--
-- >>> intD10Maybe 5
-- Just D5
--
-- >>> intD10Maybe 12
-- Nothing
--
-- >>> intD10Maybe (-5)
-- Nothing

intD10Maybe :: Int -> Maybe D10
intD10Maybe :: Int -> Maybe D10
intD10Maybe = Int -> Maybe D10
forall a. Integral a => a -> Maybe D10
integralD10Maybe

-- | Construct a 'D10' from any kind of number with an 'Integral'
-- instance, or produce 'Nothing' if the number falls outside the
-- range 0 to 9.
--
-- @'Data.D10.Predicate.isD10Integral' x = 'Data.Maybe.isJust' ('integralD10Maybe' x)@
--
-- Specialized versions of this function include 'natD10Maybe',
-- 'integerD10Maybe', and 'intD10Maybe'.
--
-- 'integralD10Fail' is a more general version of this function.
--
-- >>> integralD10Maybe (5 :: Integer)
-- Just D5
--
-- >>> integralD10Maybe (12 :: Integer)
-- Nothing
--
-- >>> integralD10Maybe ((-5) :: Integer)
-- Nothing

integralD10Maybe :: Integral a => a -> Maybe D10
integralD10Maybe :: a -> Maybe D10
integralD10Maybe a
x =
    case a
x of
        a
0 -> D10 -> Maybe D10
forall a. a -> Maybe a
Just D10
D0
        a
1 -> D10 -> Maybe D10
forall a. a -> Maybe a
Just D10
D1
        a
2 -> D10 -> Maybe D10
forall a. a -> Maybe a
Just D10
D2
        a
3 -> D10 -> Maybe D10
forall a. a -> Maybe a
Just D10
D3
        a
4 -> D10 -> Maybe D10
forall a. a -> Maybe a
Just D10
D4
        a
5 -> D10 -> Maybe D10
forall a. a -> Maybe a
Just D10
D5
        a
6 -> D10 -> Maybe D10
forall a. a -> Maybe a
Just D10
D6
        a
7 -> D10 -> Maybe D10
forall a. a -> Maybe a
Just D10
D7
        a
8 -> D10 -> Maybe D10
forall a. a -> Maybe a
Just D10
D8
        a
9 -> D10 -> Maybe D10
forall a. a -> Maybe a
Just D10
D9
        a
_ -> Maybe D10
forall a. Maybe a
Nothing

---------------------------------------------------

-- | Convert a 'Char' to a 'D10' if it is within the range
-- @'0'@ to @'9'@, or 'Left' with an error message otherwise.
--
-- >>> charD10Either '5'
-- Right D5
--
-- >>> charD10Either 'a'
-- Left "d10 must be between 0 and 9"

charD10Either :: Char -> Either String D10
charD10Either :: Char -> Either String D10
charD10Either Char
x =
    case Char
x of
        Char
'0' -> D10 -> Either String D10
forall a b. b -> Either a b
Right D10
D0
        Char
'1' -> D10 -> Either String D10
forall a b. b -> Either a b
Right D10
D1
        Char
'2' -> D10 -> Either String D10
forall a b. b -> Either a b
Right D10
D2
        Char
'3' -> D10 -> Either String D10
forall a b. b -> Either a b
Right D10
D3
        Char
'4' -> D10 -> Either String D10
forall a b. b -> Either a b
Right D10
D4
        Char
'5' -> D10 -> Either String D10
forall a b. b -> Either a b
Right D10
D5
        Char
'6' -> D10 -> Either String D10
forall a b. b -> Either a b
Right D10
D6
        Char
'7' -> D10 -> Either String D10
forall a b. b -> Either a b
Right D10
D7
        Char
'8' -> D10 -> Either String D10
forall a b. b -> Either a b
Right D10
D8
        Char
'9' -> D10 -> Either String D10
forall a b. b -> Either a b
Right D10
D9
        Char
_   -> String -> Either String D10
forall a b. a -> Either a b
Left String
"d10 must be between 0 and 9"

-- | Convert a 'String' to a 'D10' if it consists of a single
-- character and that character is within the range @'0'@ to
-- @'9'@, or 'Left' with an error message otherwise.
--
-- >>> strD10Either "5"
-- Right D5
--
-- >>> strD10Either "a"
-- Left "d10 must be between 0 and 9"
--
-- >>> strD10Either "58"
-- Left "d10 must be a single character"

strD10Either :: String -> Either String D10
strD10Either :: String -> Either String D10
strD10Either [Char
x] = Char -> Either String D10
charD10Either Char
x
strD10Either String
_   = String -> Either String D10
forall a b. a -> Either a b
Left String
"d10 must be a single character"

-- | Convert a 'String' to a 'D10' if all of the characters in
-- the string fall within the range @'0'@ to @'9'@, or 'Left'
-- with an error message otherwise.
--
-- >>> strD10ListEither "5"
-- Right [D5]
--
-- >>> strD10ListEither "a"
-- Left "d10 must be between 0 and 9"
--
-- >>> strD10ListEither "58"
-- Right [D5,D8]

strD10ListEither :: String -> Either String [D10]
strD10ListEither :: String -> Either String [D10]
strD10ListEither = (Char -> Either String D10) -> String -> Either String [D10]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Char -> Either String D10
charD10Either

-- | Convert a 'Natural' to a 'D10' if it is less than 10,
-- or 'Left' with an error message otherwise.
--
-- >>> natD10Either 5
-- Right D5
--
-- >>> natD10Either 12
-- Left "d10 must be less than 10"

natD10Either :: Natural -> Either String D10
natD10Either :: Natural -> Either String D10
natD10Either Natural
x =
    case Natural
x of
        Natural
0 -> D10 -> Either String D10
forall a b. b -> Either a b
Right D10
D0
        Natural
1 -> D10 -> Either String D10
forall a b. b -> Either a b
Right D10
D1
        Natural
2 -> D10 -> Either String D10
forall a b. b -> Either a b
Right D10
D2
        Natural
3 -> D10 -> Either String D10
forall a b. b -> Either a b
Right D10
D3
        Natural
4 -> D10 -> Either String D10
forall a b. b -> Either a b
Right D10
D4
        Natural
5 -> D10 -> Either String D10
forall a b. b -> Either a b
Right D10
D5
        Natural
6 -> D10 -> Either String D10
forall a b. b -> Either a b
Right D10
D6
        Natural
7 -> D10 -> Either String D10
forall a b. b -> Either a b
Right D10
D7
        Natural
8 -> D10 -> Either String D10
forall a b. b -> Either a b
Right D10
D8
        Natural
9 -> D10 -> Either String D10
forall a b. b -> Either a b
Right D10
D9
        Natural
_ -> String -> Either String D10
forall a b. a -> Either a b
Left String
"d10 must be less than 10"

-- | Convert an 'Integer' to a 'D10' if it is within the
-- range 0 to 9, or 'Left' with an error message otherwise.
--
-- >>> integerD10Either 5
-- Right D5
--
-- >>> integerD10Either 12
-- Left "d10 must be between 0 and 9"
--
-- >>> integerD10Either (-5)
-- Left "d10 must be between 0 and 9"

integerD10Either :: Integer -> Either String D10
integerD10Either :: Integer -> Either String D10
integerD10Either = Integer -> Either String D10
forall a. Integral a => a -> Either String D10
integralD10Either

-- | Convert an 'Int' to a 'D10' if it is within the range
-- 0 to 9, or 'Left' with an error message otherwise.
--
-- >>> intD10Either 5
-- Right D5
--
-- >>> intD10Either 12
-- Left "d10 must be between 0 and 9"
--
-- >>> intD10Either (-5)
-- Left "d10 must be between 0 and 9"

intD10Either :: Int -> Either String D10
intD10Either :: Int -> Either String D10
intD10Either = Int -> Either String D10
forall a. Integral a => a -> Either String D10
integralD10Either

-- | Convert a number of a type that has an 'Integral' instance
-- to a 'D10' if it falls within the range 0 to 9, or 'Left'
-- with an error message otherwise.
--
-- >>> integralD10Either (5 :: Integer)
-- Right D5
--
-- >>> integralD10Either (12 :: Integer)
-- Left "d10 must be between 0 and 9"
--
-- >>> integralD10Either ((-5) :: Integer)
-- Left "d10 must be between 0 and 9"

integralD10Either :: Integral a => a -> Either String D10
integralD10Either :: a -> Either String D10
integralD10Either a
x =
    case (a -> Maybe D10
forall a. Integral a => a -> Maybe D10
integralD10Maybe a
x) of
        Just D10
y  -> D10 -> Either String D10
forall a b. b -> Either a b
Right D10
y
        Maybe D10
Nothing -> String -> Either String D10
forall a b. a -> Either a b
Left String
"d10 must be between 0 and 9"

---------------------------------------------------

-- | Convert a 'Char' to a 'D10' if it is within the range
-- @'0'@ to @'9'@, or 'fail' with an error message otherwise.
--
-- 'charD10Maybe' is a specialized version of this function.
--
-- >>> charD10Fail '5' :: IO D10
-- D5
--
-- >>> charD10Fail 'a' :: IO D10
-- *** Exception: user error (d10 must be between 0 and 9)

charD10Fail :: MonadFail m => Char -> m D10
charD10Fail :: Char -> m D10
charD10Fail Char
x =
    case Char
x of
        Char
'0' -> D10 -> m D10
forall (m :: * -> *) a. Monad m => a -> m a
return D10
D0
        Char
'1' -> D10 -> m D10
forall (m :: * -> *) a. Monad m => a -> m a
return D10
D1
        Char
'2' -> D10 -> m D10
forall (m :: * -> *) a. Monad m => a -> m a
return D10
D2
        Char
'3' -> D10 -> m D10
forall (m :: * -> *) a. Monad m => a -> m a
return D10
D3
        Char
'4' -> D10 -> m D10
forall (m :: * -> *) a. Monad m => a -> m a
return D10
D4
        Char
'5' -> D10 -> m D10
forall (m :: * -> *) a. Monad m => a -> m a
return D10
D5
        Char
'6' -> D10 -> m D10
forall (m :: * -> *) a. Monad m => a -> m a
return D10
D6
        Char
'7' -> D10 -> m D10
forall (m :: * -> *) a. Monad m => a -> m a
return D10
D7
        Char
'8' -> D10 -> m D10
forall (m :: * -> *) a. Monad m => a -> m a
return D10
D8
        Char
'9' -> D10 -> m D10
forall (m :: * -> *) a. Monad m => a -> m a
return D10
D9
        Char
_   -> String -> m D10
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"d10 must be between 0 and 9"

-- | Convert a 'String' to a 'D10' if it consists of a single
-- character and that character is within the range @'0'@ to
-- @'9'@, or 'fail' with an error message otherwise.
--
-- 'strD10Maybe' is a specialized version of this function.
--
-- >>> strD10Fail "5" :: IO D10
-- D5
--
-- >>> strD10Fail "a" :: IO D10
-- *** Exception: user error (d10 must be between 0 and 9)
--
-- >>> strD10Fail "58" :: IO D10
-- *** Exception: user error (d10 must be a single character)

strD10Fail :: MonadFail m => String -> m D10
strD10Fail :: String -> m D10
strD10Fail [Char
x] = Char -> m D10
forall (m :: * -> *). MonadFail m => Char -> m D10
charD10Fail Char
x
strD10Fail String
_   = String -> m D10
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"d10 must be a single character"

-- | Convert a 'String' to a 'D10' if all of the characters in
-- the string fall within the range @'0'@ to @'9'@, or 'fail'
-- with an error message otherwise.
--
-- 'strD10ListMaybe' is a specialized version of this function.
--
-- >>> strD10ListFail "5" :: IO [D10]
-- [D5]
--
-- >>> strD10ListFail "a" :: IO [D10]
-- *** Exception: user error (d10 must be between 0 and 9)
--
-- >>> strD10ListFail "58" :: IO [D10]
-- [D5,D8]

strD10ListFail :: MonadFail m => String -> m [D10]
strD10ListFail :: String -> m [D10]
strD10ListFail = (Char -> m D10) -> String -> m [D10]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Char -> m D10
forall (m :: * -> *). MonadFail m => Char -> m D10
charD10Fail

-- | Convert a 'Natural' to a 'D10' if it is less than 10,
-- or 'fail' with an error message otherwise.
--
-- 'natD10Maybe' is a specialized version of this function.
--
-- 'integralD10Fail' is a more general version of this function.
--
-- >>> natD10Fail 5 :: IO D10
-- D5
--
-- >>> natD10Fail 12 :: IO D10
-- *** Exception: user error (d10 must be less than 10)

natD10Fail :: MonadFail m => Natural -> m D10
natD10Fail :: Natural -> m D10
natD10Fail Natural
x =
    case Natural
x of
        Natural
0 -> D10 -> m D10
forall (m :: * -> *) a. Monad m => a -> m a
return D10
D0
        Natural
1 -> D10 -> m D10
forall (m :: * -> *) a. Monad m => a -> m a
return D10
D1
        Natural
2 -> D10 -> m D10
forall (m :: * -> *) a. Monad m => a -> m a
return D10
D2
        Natural
3 -> D10 -> m D10
forall (m :: * -> *) a. Monad m => a -> m a
return D10
D3
        Natural
4 -> D10 -> m D10
forall (m :: * -> *) a. Monad m => a -> m a
return D10
D4
        Natural
5 -> D10 -> m D10
forall (m :: * -> *) a. Monad m => a -> m a
return D10
D5
        Natural
6 -> D10 -> m D10
forall (m :: * -> *) a. Monad m => a -> m a
return D10
D6
        Natural
7 -> D10 -> m D10
forall (m :: * -> *) a. Monad m => a -> m a
return D10
D7
        Natural
8 -> D10 -> m D10
forall (m :: * -> *) a. Monad m => a -> m a
return D10
D8
        Natural
9 -> D10 -> m D10
forall (m :: * -> *) a. Monad m => a -> m a
return D10
D9
        Natural
_ -> String -> m D10
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"d10 must be less than 10"

-- | Convert an 'Integer' to a 'D10' if it is within the
-- range 0 to 9, or 'fail' with an error message otherwise.
--
-- 'integerD10Maybe' is a specialized version of this function.
--
-- 'integralD10Fail' is a more general version of this function.
--
-- >>> integerD10Fail 5 :: IO D10
-- D5
--
-- >>> integerD10Fail 12 :: IO D10
-- *** Exception: user error (d10 must be between 0 and 9)
--
-- >>> integerD10Fail (-5) :: IO D10
-- *** Exception: user error (d10 must be between 0 and 9)

integerD10Fail :: MonadFail m => Integer -> m D10
integerD10Fail :: Integer -> m D10
integerD10Fail = Integer -> m D10
forall a (m :: * -> *). (Integral a, MonadFail m) => a -> m D10
integralD10Fail

-- | Convert an 'Int' to a 'D10' if it is within the range
-- 0 to 9, or 'fail' with an error message otherwise.
--
-- 'intD10Maybe' is a specialized version of this function.
--
-- 'integralD10Fail' is a more general version of this function.
--
-- >>> intD10Fail 5 :: IO D10
-- D5
--
-- >>> intD10Fail 12 :: IO D10
-- *** Exception: user error (d10 must be between 0 and 9)
--
-- >>> intD10Fail (-5) :: IO D10
-- *** Exception: user error (d10 must be between 0 and 9)

intD10Fail :: MonadFail m => Int -> m D10
intD10Fail :: Int -> m D10
intD10Fail = Int -> m D10
forall a (m :: * -> *). (Integral a, MonadFail m) => a -> m D10
integralD10Fail

-- | Convert a number of a type that has an 'Integral' instance
-- to a 'D10' if it falls within the range 0 to 9, or 'fail'
-- with an error message otherwise.
--
-- 'natD10Maybe', 'integerD10Maybe', 'intD10Maybe',
-- 'integralD10Maybe', 'natD10Fail', 'integerD10Fail', and
-- 'intD10Fail' are all specialized versions of this function.
--
-- >>> integralD10Fail (5 :: Integer) :: IO D10
-- D5
--
-- >>> integralD10Fail (12 :: Integer) :: IO D10
-- *** Exception: user error (d10 must be between 0 and 9)
--
-- >>> integralD10Fail ((-5) :: Integer) :: IO D10
-- *** Exception: user error (d10 must be between 0 and 9)

integralD10Fail :: (Integral a, MonadFail m) => a -> m D10
integralD10Fail :: a -> m D10
integralD10Fail a
x =
    case (a -> Maybe D10
forall a. Integral a => a -> Maybe D10
integralD10Maybe a
x) of
        Just D10
y  -> D10 -> m D10
forall (m :: * -> *) a. Monad m => a -> m a
return D10
y
        Maybe D10
Nothing -> String -> m D10
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"d10 must be between 0 and 9"

---------------------------------------------------

-- | Produces an expression of type @['D10']@ that can be used
-- in a Template Haskell splice.
--
-- >>> $(d10ListExp "")
-- []
--
-- >>> $(d10ListExp "5")
-- [D5]
--
-- >>> $(d10ListExp "58")
-- [D5,D8]
--
-- >>> $(d10ListExp "a")
-- ...
-- ... d10 must be between 0 and 9
-- ...
--
-- You may also be interested in 'd10list', a quasi-quoter which
-- does something similar.

d10ListExp :: String -> Q Exp
d10ListExp :: String -> Q Exp
d10ListExp = String -> Q [D10]
forall (m :: * -> *). MonadFail m => String -> m [D10]
strD10ListFail (String -> Q [D10]) -> ([D10] -> Q Exp) -> String -> Q Exp
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [D10] -> Q Exp
d10ListExp'

d10ListExp' :: [D10] -> Q Exp
d10ListExp' :: [D10] -> Q Exp
d10ListExp' [D10]
x = [| x |]

---------------------------------------------------

d10Pat :: D10 -> Q Pat
d10Pat :: D10 -> Q Pat
d10Pat = (forall b. Data b => b -> Maybe (Q Pat)) -> D10 -> Q Pat
forall a.
Data a =>
(forall b. Data b => b -> Maybe (Q Pat)) -> a -> Q Pat
dataToPatQ (Maybe (Q Pat) -> b -> Maybe (Q Pat)
forall a b. a -> b -> a
const Maybe (Q Pat)
forall a. Maybe a
Nothing)

-- | Produces a pattern that can be used in a splice
-- to match a particular list of 'D10' values.
--
-- >>> :{
--       case [D5, D6] of
--         $(d10ListPat "42") -> "A"
--         $(d10ListPat "56") -> "B"
--         _                  -> "C"
-- >>> :}
-- "B"
--
-- You may also be interested in 'd10list', a quasi-quoter which
-- does something similar.

d10ListPat :: String -> Q Pat
d10ListPat :: String -> Q Pat
d10ListPat = String -> Q [D10]
forall (m :: * -> *). MonadFail m => String -> m [D10]
strD10ListFail (String -> Q [D10]) -> ([D10] -> Q Pat) -> String -> Q Pat
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \[D10]
xs ->
  do
    [Pat]
pats <- (D10 -> Q Pat) -> [D10] -> Q [Pat]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse D10 -> Q Pat
d10Pat [D10]
xs
    Pat -> Q Pat
forall (m :: * -> *) a. Monad m => a -> m a
return ([Pat] -> Pat
ListP [Pat]
pats)

d10ListPat' :: [D10] -> Q Pat
d10ListPat' :: [D10] -> Q Pat
d10ListPat' [D10]
xs =
  do
    [Pat]
pats <- (D10 -> Q Pat) -> [D10] -> Q [Pat]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse D10 -> Q Pat
d10Pat [D10]
xs
    Pat -> Q Pat
forall (m :: * -> *) a. Monad m => a -> m a
return ([Pat] -> Pat
ListP [Pat]
pats)

---------------------------------------------------

-- | A list of base-10 digits.
--
-- This quasi-quoter, when used as an expression, produces a
-- value of type @['D10']@.
--
-- >>> [d10list||]
-- []
--
-- >>> [d10list|5|]
-- [D5]
--
-- >>> [d10list|58|]
-- [D5,D8]
--
-- >>> [d10list|a|]
-- ...
-- ... d10 must be between 0 and 9
-- ...
--
-- This quasi-quoter can also be used as a pattern.
--
-- >>> :{
--       case [D5, D6] of
--         [d10list|41|] -> "A"
--         [d10list|56|] -> "B"
--         _             -> "C"
-- >>> :}
-- "B"
--
-- >>> :{
--       case [D5, D6] of
--         [d10list|4x|] -> "A"
--         [d10list|56|] -> "B"
--         _             -> "C"
-- >>> :}
-- ...
-- ... d10 must be between 0 and 9
-- ...

d10list :: QuasiQuoter
d10list :: QuasiQuoter
d10list = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp  = String -> Q [D10]
forall (m :: * -> *). MonadFail m => String -> m [D10]
strD10ListFail (String -> Q [D10]) -> ([D10] -> Q Exp) -> String -> Q Exp
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [D10] -> Q Exp
d10ListExp'
    , quotePat :: String -> Q Pat
quotePat  = String -> Q [D10]
forall (m :: * -> *). MonadFail m => String -> m [D10]
strD10ListFail (String -> Q [D10]) -> ([D10] -> Q Pat) -> String -> Q Pat
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [D10] -> Q Pat
d10ListPat'
    , quoteType :: String -> Q Type
quoteType = \String
_ -> String -> Q Type
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"d10list cannot be used in a type context"
    , quoteDec :: String -> Q [Dec]
quoteDec  = \String
_ -> String -> Q [Dec]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"d10list cannot be used in a declaration context"
    }

---------------------------------------------------

-- | Addition modulo 10.
--
-- >>> D2 + D3
-- D5
--
-- >>> D6 + D7
-- D3

(+) :: D10 -> D10 -> D10
D10
x + :: D10 -> D10 -> D10
+ D10
y = Int -> D10
intMod10 (D10 -> Int
d10Int D10
x Int -> Int -> Int
forall a. Num a => a -> a -> a
P.+ D10 -> Int
d10Int D10
y)

-- | Subtraction modulo 10.
--
-- >>> D7 - D5
-- D2
--
-- >>> D3 - D7
-- D6

(-) :: D10 -> D10 -> D10
D10
x - :: D10 -> D10 -> D10
- D10
y = Int -> D10
intMod10 (D10 -> Int
d10Int D10
x Int -> Int -> Int
forall a. Num a => a -> a -> a
P.- D10 -> Int
d10Int D10
y)

-- | Multiplication modulo 10.
--
-- >>> D2 * D4
-- D8
-- >>> D7 * D8
-- D6

(*) :: D10 -> D10 -> D10
D10
x * :: D10 -> D10 -> D10
* D10
y = Int -> D10
intMod10 (D10 -> Int
d10Int D10
x Int -> Int -> Int
forall a. Num a => a -> a -> a
P.* D10 -> Int
d10Int D10
y)