{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DerivingStrategies, DeriveAnyClass, GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module DSV.Numbers
  ( fromIntegerMaybe
  , Natural
  , ArithException (..)
  , Positive (..), natPositive, positiveNat, positiveInt
  ) where

import DSV.IO
import DSV.Prelude

-- base
import Control.Exception (ArithException (..))
import Numeric.Natural (Natural)

fromIntegerMaybe ::
    forall n .
    (Bounded n, Integral n)
    => Integer -> Maybe n

fromIntegerMaybe :: Integer -> Maybe n
fromIntegerMaybe Integer
i
    | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< n -> Integer
forall a. Integral a => a -> Integer
toInteger (Bounded n => n
forall a. Bounded a => a
minBound @n) = Maybe n
forall a. Maybe a
Nothing
    | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> n -> Integer
forall a. Integral a => a -> Integer
toInteger (Bounded n => n
forall a. Bounded a => a
maxBound @n) = Maybe n
forall a. Maybe a
Nothing
    | Bool
otherwise                   = n -> Maybe n
forall a. a -> Maybe a
Just (Integer -> n
forall a. Num a => Integer -> a
fromInteger @n Integer
i)

newtype Positive = Positive Natural
  deriving newtype (Positive -> Positive -> Bool
(Positive -> Positive -> Bool)
-> (Positive -> Positive -> Bool) -> Eq Positive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Positive -> Positive -> Bool
$c/= :: Positive -> Positive -> Bool
== :: Positive -> Positive -> Bool
$c== :: Positive -> Positive -> Bool
Eq, Eq Positive
Eq Positive
-> (Positive -> Positive -> Ordering)
-> (Positive -> Positive -> Bool)
-> (Positive -> Positive -> Bool)
-> (Positive -> Positive -> Bool)
-> (Positive -> Positive -> Bool)
-> (Positive -> Positive -> Positive)
-> (Positive -> Positive -> Positive)
-> Ord Positive
Positive -> Positive -> Bool
Positive -> Positive -> Ordering
Positive -> Positive -> Positive
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 :: Positive -> Positive -> Positive
$cmin :: Positive -> Positive -> Positive
max :: Positive -> Positive -> Positive
$cmax :: Positive -> Positive -> Positive
>= :: Positive -> Positive -> Bool
$c>= :: Positive -> Positive -> Bool
> :: Positive -> Positive -> Bool
$c> :: Positive -> Positive -> Bool
<= :: Positive -> Positive -> Bool
$c<= :: Positive -> Positive -> Bool
< :: Positive -> Positive -> Bool
$c< :: Positive -> Positive -> Bool
compare :: Positive -> Positive -> Ordering
$ccompare :: Positive -> Positive -> Ordering
$cp1Ord :: Eq Positive
Ord, Int -> Positive -> ShowS
[Positive] -> ShowS
Positive -> String
(Int -> Positive -> ShowS)
-> (Positive -> String) -> ([Positive] -> ShowS) -> Show Positive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Positive] -> ShowS
$cshowList :: [Positive] -> ShowS
show :: Positive -> String
$cshow :: Positive -> String
showsPrec :: Int -> Positive -> ShowS
$cshowsPrec :: Int -> Positive -> ShowS
Show)

natPositive :: Natural -> Positive
natPositive :: Natural -> Positive
natPositive =
  \case
    Natural
0 -> ArithException -> Positive
forall a e. Exception e => e -> a
throw ArithException
Underflow
    Natural
n -> Natural -> Positive
Positive Natural
n

positiveNat :: Positive -> Natural
positiveNat :: Positive -> Natural
positiveNat (Positive Natural
n) = Natural
n

positiveInt :: Positive -> Int
positiveInt :: Positive -> Int
positiveInt (Positive Natural
n) = Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n

instance Num Positive
  where
    fromInteger :: Integer -> Positive
fromInteger Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
1 = ArithException -> Positive
forall a e. Exception e => e -> a
throw ArithException
Underflow
                  | Bool
True  = Natural -> Positive
Positive (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
n)

    Positive Natural
x + :: Positive -> Positive -> Positive
+ Positive Natural
y = Natural -> Positive
Positive    (Natural
x Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
y)
    Positive Natural
x - :: Positive -> Positive -> Positive
- Positive Natural
y = Natural -> Positive
natPositive (Natural
x Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
y)
    Positive Natural
x * :: Positive -> Positive -> Positive
* Positive Natural
y = Natural -> Positive
Positive    (Natural
x Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
y)

    negate :: Positive -> Positive
negate Positive
_ = ArithException -> Positive
forall a e. Exception e => e -> a
throw ArithException
Underflow
    abs :: Positive -> Positive
abs = Positive -> Positive
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
    signum :: Positive -> Positive
signum Positive
_ = Positive
1