module Data.BAByNF.Util.Decimal
    ( Digit (..)
    , Seq (..)
    , val
    , toNum
    , fromVal
    , toChar
    ) where

data Digit = D0 
           | D1
           | D2
           | D3
           | D4
           | D5
           | D6
           | D7
           | D8
           | D9 
           deriving (Digit -> Digit -> Bool
(Digit -> Digit -> Bool) -> (Digit -> Digit -> Bool) -> Eq Digit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Digit -> Digit -> Bool
== :: Digit -> Digit -> Bool
$c/= :: Digit -> Digit -> Bool
/= :: Digit -> Digit -> Bool
Eq, Eq Digit
Eq Digit =>
(Digit -> Digit -> Ordering)
-> (Digit -> Digit -> Bool)
-> (Digit -> Digit -> Bool)
-> (Digit -> Digit -> Bool)
-> (Digit -> Digit -> Bool)
-> (Digit -> Digit -> Digit)
-> (Digit -> Digit -> Digit)
-> Ord Digit
Digit -> Digit -> Bool
Digit -> Digit -> Ordering
Digit -> Digit -> Digit
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
$ccompare :: Digit -> Digit -> Ordering
compare :: Digit -> Digit -> Ordering
$c< :: Digit -> Digit -> Bool
< :: Digit -> Digit -> Bool
$c<= :: Digit -> Digit -> Bool
<= :: Digit -> Digit -> Bool
$c> :: Digit -> Digit -> Bool
> :: Digit -> Digit -> Bool
$c>= :: Digit -> Digit -> Bool
>= :: Digit -> Digit -> Bool
$cmax :: Digit -> Digit -> Digit
max :: Digit -> Digit -> Digit
$cmin :: Digit -> Digit -> Digit
min :: Digit -> Digit -> Digit
Ord)
newtype Seq = Seq [Digit] deriving Seq -> Seq -> Bool
(Seq -> Seq -> Bool) -> (Seq -> Seq -> Bool) -> Eq Seq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Seq -> Seq -> Bool
== :: Seq -> Seq -> Bool
$c/= :: Seq -> Seq -> Bool
/= :: Seq -> Seq -> Bool
Eq

val :: Integral a => Digit -> a
val :: forall a. Integral a => Digit -> a
val Digit
D0 = a
0
val Digit
D1 = a
1
val Digit
D2 = a
2
val Digit
D3 = a
3
val Digit
D4 = a
4
val Digit
D5 = a
5
val Digit
D6 = a
6
val Digit
D7 = a
7
val Digit
D8 = a
8
val Digit
D9 = a
9

toNum :: Integral a => Seq -> a
toNum :: forall a. Integral a => Seq -> a
toNum (Seq [Digit]
digits) = [Digit] -> a -> a
forall {t}. Integral t => [Digit] -> t -> t
toNum' [Digit]
digits a
0
    where toNum' :: [Digit] -> t -> t
toNum' [] t
acc = t
acc
          toNum' (Digit
d : [Digit]
ds) t
acc = 
            let newAcc :: t
newAcc = (t
acc t -> t -> t
forall a. Num a => a -> a -> a
* t
10) t -> t -> t
forall a. Num a => a -> a -> a
+ Digit -> t
forall a. Integral a => Digit -> a
val Digit
d
             in [Digit] -> t -> t
toNum' [Digit]
ds t
newAcc

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

instance Show Seq where
  show :: Seq -> String
show (Seq [Digit]
x) = (Digit -> Char) -> [Digit] -> String
forall a b. (a -> b) -> [a] -> [b]
map Digit -> Char
toChar [Digit]
x

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