{-# language Unsafe, GeneralizedNewtypeDeriving #-}

module D10.Num.Unsafe (D10 (..)) where

import qualified D10.Predicate as Predicate

import Data.Char (chr, ord)
import Data.Monoid (Endo (..))

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

-- | A value of some numeric type @a@ between
-- @'fromInteger' 0@ and @'fromInteger' 9@.
newtype D10 a =
    D10_Unsafe a
      -- ^ The constructor's name include the word "unsafe" as a reminder
      --   that you should generally avoid using it directly, because it
      --   allows constructing invalid 'D10' values.
    deriving (D10 a -> D10 a -> Bool
(D10 a -> D10 a -> Bool) -> (D10 a -> D10 a -> Bool) -> Eq (D10 a)
forall a. Eq a => D10 a -> D10 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: D10 a -> D10 a -> Bool
$c/= :: forall a. Eq a => D10 a -> D10 a -> Bool
== :: D10 a -> D10 a -> Bool
$c== :: forall a. Eq a => D10 a -> D10 a -> Bool
Eq, Eq (D10 a)
Eq (D10 a)
-> (D10 a -> D10 a -> Ordering)
-> (D10 a -> D10 a -> Bool)
-> (D10 a -> D10 a -> Bool)
-> (D10 a -> D10 a -> Bool)
-> (D10 a -> D10 a -> Bool)
-> (D10 a -> D10 a -> D10 a)
-> (D10 a -> D10 a -> D10 a)
-> Ord (D10 a)
D10 a -> D10 a -> Bool
D10 a -> D10 a -> Ordering
D10 a -> D10 a -> D10 a
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
forall a. Ord a => Eq (D10 a)
forall a. Ord a => D10 a -> D10 a -> Bool
forall a. Ord a => D10 a -> D10 a -> Ordering
forall a. Ord a => D10 a -> D10 a -> D10 a
min :: D10 a -> D10 a -> D10 a
$cmin :: forall a. Ord a => D10 a -> D10 a -> D10 a
max :: D10 a -> D10 a -> D10 a
$cmax :: forall a. Ord a => D10 a -> D10 a -> D10 a
>= :: D10 a -> D10 a -> Bool
$c>= :: forall a. Ord a => D10 a -> D10 a -> Bool
> :: D10 a -> D10 a -> Bool
$c> :: forall a. Ord a => D10 a -> D10 a -> Bool
<= :: D10 a -> D10 a -> Bool
$c<= :: forall a. Ord a => D10 a -> D10 a -> Bool
< :: D10 a -> D10 a -> Bool
$c< :: forall a. Ord a => D10 a -> D10 a -> Bool
compare :: D10 a -> D10 a -> Ordering
$ccompare :: forall a. Ord a => D10 a -> D10 a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (D10 a)
Ord)

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

instance Num a => Bounded (D10 a)
  where
    minBound :: D10 a
minBound = a -> D10 a
forall a. a -> D10 a
D10_Unsafe a
0
    maxBound :: D10 a
maxBound = a -> D10 a
forall a. a -> D10 a
D10_Unsafe a
9

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

instance Integral a => Enum (D10 a)
  where
    fromEnum :: D10 a -> Int
    fromEnum :: D10 a -> Int
fromEnum (D10_Unsafe a
x) = a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x

    toEnum :: Int -> D10 a
    toEnum :: Int -> D10 a
toEnum Int
x | Int -> Bool
Predicate.isD10Int Int
x = a -> D10 a
forall a. a -> D10 a
D10_Unsafe (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
             | Bool
otherwise = [Char] -> D10 a
forall a. HasCallStack => [Char] -> a
error [Char]
"d10 must be between 0 and 9"

    enumFrom :: D10 a -> [D10 a]
    enumFrom :: D10 a -> [D10 a]
enumFrom D10 a
x = D10 a -> D10 a -> [D10 a]
forall a. Enum a => a -> a -> [a]
enumFromTo D10 a
x D10 a
forall a. Bounded a => a
maxBound

    enumFromThen :: D10 a -> D10 a -> [D10 a]
    enumFromThen :: D10 a -> D10 a -> [D10 a]
enumFromThen D10 a
x D10 a
y = D10 a -> D10 a -> D10 a -> [D10 a]
forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo D10 a
x D10 a
y D10 a
bound
      where
        bound :: D10 a
bound | D10 a -> Int
forall a. Enum a => a -> Int
fromEnum D10 a
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= D10 a -> Int
forall a. Enum a => a -> Int
fromEnum D10 a
x = D10 a
forall a. Bounded a => a
maxBound
              | Bool
otherwise                = D10 a
forall a. Bounded a => a
minBound

    succ :: D10 a -> D10 a
succ (D10_Unsafe a
9) = [Char] -> D10 a
forall a. HasCallStack => [Char] -> a
error [Char]
"D10 overflow"
    succ (D10_Unsafe a
x) = a -> D10 a
forall a. a -> D10 a
D10_Unsafe (a -> a
forall a. Enum a => a -> a
succ a
x)

    pred :: D10 a -> D10 a
pred (D10_Unsafe a
0) = [Char] -> D10 a
forall a. HasCallStack => [Char] -> a
error [Char]
"D10 underflow"
    pred (D10_Unsafe a
x) = a -> D10 a
forall a. a -> D10 a
D10_Unsafe (a -> a
forall a. Enum a => a -> a
pred a
x)

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

instance Integral a => Show (D10 a) where
    showsPrec :: Int -> D10 a -> ShowS
showsPrec Int
_ D10 a
x = [Char] -> ShowS
showString [Char]
"[d10|"     ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D10 a -> ShowS
forall a. Integral a => D10 a -> ShowS
showsChar D10 a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"|]"
    showList :: [D10 a] -> ShowS
showList [D10 a]
xs   = [Char] -> ShowS
showString [Char]
"[d10list|" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [D10 a] -> ShowS
forall a. Integral a => [D10 a] -> ShowS
showsStr [D10 a]
xs ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"|]"

showsChar :: Integral a => D10 a -> ShowS
showsChar :: D10 a -> ShowS
showsChar (D10_Unsafe a
x) = Char -> ShowS
showChar (Char -> ShowS) -> Char -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr (Char -> Int
ord Char
'0' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x)

showsStr :: Integral a => [D10 a] -> ShowS
showsStr :: [D10 a] -> ShowS
showsStr = Endo [Char] -> ShowS
forall a. Endo a -> a -> a
appEndo (Endo [Char] -> ShowS)
-> ([D10 a] -> Endo [Char]) -> [D10 a] -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D10 a -> Endo [Char]) -> [D10 a] -> Endo [Char]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ShowS -> Endo [Char]
forall a. (a -> a) -> Endo a
Endo (ShowS -> Endo [Char]) -> (D10 a -> ShowS) -> D10 a -> Endo [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D10 a -> ShowS
forall a. Integral a => D10 a -> ShowS
showsChar)