{-# language Unsafe, GeneralizedNewtypeDeriving #-}

module D10.Char.Unsafe (D10 (D10_Unsafe)) where

import qualified D10.Predicate as Predicate

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

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

-- | A 'Char' value between @'0'@ and @'9'@
newtype D10 =
    D10_Unsafe Char
      -- ^ 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 -> 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, 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)
    deriving newtype Eq D10
Eq D10 -> (Int -> D10 -> Int) -> (D10 -> Int) -> Hashable D10
Int -> D10 -> Int
D10 -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: D10 -> Int
$chash :: D10 -> Int
hashWithSalt :: Int -> D10 -> Int
$chashWithSalt :: Int -> D10 -> Int
$cp1Hashable :: Eq D10
Hashable

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

instance Bounded D10
  where
    minBound :: D10
minBound = Char -> D10
D10_Unsafe Char
'0'
    maxBound :: D10
maxBound = Char -> D10
D10_Unsafe Char
'9'

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

instance Enum D10
  where
    fromEnum :: D10 -> Int
    fromEnum :: D10 -> Int
fromEnum (D10_Unsafe Char
x) = Char -> Int
ord Char
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0'

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

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

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

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

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

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

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

showsChar :: D10 -> ShowS
showsChar :: D10 -> ShowS
showsChar (D10_Unsafe Char
x) = Char -> ShowS
showChar Char
x

showsStr :: [D10] -> ShowS
showsStr :: [D10] -> ShowS
showsStr = Endo [Char] -> ShowS
forall a. Endo a -> a -> a
appEndo (Endo [Char] -> ShowS) -> ([D10] -> Endo [Char]) -> [D10] -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D10 -> Endo [Char]) -> [D10] -> 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 -> ShowS) -> D10 -> Endo [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D10 -> ShowS
showsChar)