module Integer.Natural
  ( -- * Type
    Natural,

    -- * Subtraction
    subtract,

    -- * Conversion

    -- ** Positive
    toPositive,
    fromPositive,

    -- ** Integer
    toInteger,
    fromInteger,

    -- ** Signed
    toSigned,
    fromSigned,

    -- ** Int
    toInt,
    fromInt,

    -- ** Word
    toWord,
    fromWord,

    -- * One (1)
    one,
    addOne,
    subtractOne,

    -- * List
    length,
  )
where

import Data.Int (Int)
import Data.List qualified as List
import Data.Ord qualified as Ord
import Data.Word (Word)
import Essentials
import Integer.Positive qualified as Positive
import Integer.Positive.Unsafe (Positive)
import Integer.Positive.Unsafe qualified as Positive.Unsafe
import Integer.Signed (Signed (..))
import Integer.Signed qualified as Signed
import Numeric.Natural (Natural)
import Prelude (Integer)
import Prelude qualified as Bounded (Bounded (..))
import Prelude qualified as Num (Integral (..), Num (..))

toPositive :: Natural -> Maybe Positive
toPositive :: Natural -> Maybe Positive
toPositive = Natural -> Maybe Positive
Positive.fromNatural

fromPositive :: Positive -> Natural
fromPositive :: Positive -> Natural
fromPositive = Positive -> Natural
Positive.toNatural

fromInteger :: Integer -> Maybe Natural
fromInteger :: Integer -> Maybe Natural
fromInteger Integer
x = if Integer
x forall a. Ord a => a -> a -> Bool
Ord.>= Integer
0 then forall a. a -> Maybe a
Just (forall a. Num a => Integer -> a
Num.fromInteger Integer
x) else forall a. Maybe a
Nothing

toInteger :: Natural -> Integer
toInteger :: Natural -> Integer
toInteger = forall a. Integral a => a -> Integer
Num.toInteger

toSigned :: Natural -> Signed
toSigned :: Natural -> Signed
toSigned = Natural -> Signed
Signed.fromNatural

fromSigned :: Signed -> Maybe Natural
fromSigned :: Signed -> Maybe Natural
fromSigned = Signed -> Maybe Natural
Signed.toNatural

toInt :: Natural -> Maybe Int
toInt :: Natural -> Maybe Int
toInt Natural
x = if Bool
ok then forall a. a -> Maybe a
Just (forall a. Num a => Integer -> a
Num.fromInteger Integer
x') else forall a. Maybe a
Nothing
  where
    ok :: Bool
ok = Integer
x' forall a. Ord a => a -> a -> Bool
Ord.<= forall a. Integral a => a -> Integer
Num.toInteger (forall a. Bounded a => a
Bounded.maxBound :: Int)
    x' :: Integer
x' = forall a. Integral a => a -> Integer
Num.toInteger Natural
x

fromInt :: Int -> Maybe Natural
fromInt :: Int -> Maybe Natural
fromInt Int
x = if Bool
ok then forall a. a -> Maybe a
Just (forall a. Num a => Integer -> a
Num.fromInteger Integer
x') else forall a. Maybe a
Nothing
  where
    ok :: Bool
ok = Int
x forall a. Ord a => a -> a -> Bool
Ord.>= Int
0
    x' :: Integer
x' = forall a. Integral a => a -> Integer
Num.toInteger Int
x

toWord :: Natural -> Maybe Word
toWord :: Natural -> Maybe Word
toWord Natural
x = if Bool
ok then forall a. a -> Maybe a
Just (forall a. Num a => Integer -> a
Num.fromInteger Integer
x') else forall a. Maybe a
Nothing
  where
    ok :: Bool
ok = Integer
x' forall a. Ord a => a -> a -> Bool
Ord.<= forall a. Integral a => a -> Integer
Num.toInteger (forall a. Bounded a => a
Bounded.maxBound :: Word)
    x' :: Integer
x' = forall a. Integral a => a -> Integer
Num.toInteger Natural
x

fromWord :: Word -> Natural
fromWord :: Word -> Natural
fromWord Word
x = forall a. Num a => Integer -> a
Num.fromInteger (forall a. Integral a => a -> Integer
Num.toInteger Word
x)

subtract :: Natural -> Natural -> Signed
subtract :: Natural -> Natural -> Signed
subtract Natural
a Natural
b = case forall a. Ord a => a -> a -> Ordering
Ord.compare Natural
a Natural
b of
  Ordering
Ord.EQ -> Signed
Zero
  Ordering
Ord.GT -> Positive -> Signed
Plus forall a b. (a -> b) -> a -> b
$ Natural -> Positive
Positive.Unsafe.fromNatural forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a -> a
(Num.-) Natural
a Natural
b
  Ordering
Ord.LT -> Positive -> Signed
Minus forall a b. (a -> b) -> a -> b
$ Natural -> Positive
Positive.Unsafe.fromNatural forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a -> a
(Num.-) Natural
b Natural
a

one :: Natural
one :: Natural
one = Natural
1

addOne :: Natural -> Positive
addOne :: Natural -> Positive
addOne Natural
x = Natural -> Positive
Positive.Unsafe.fromNatural (Natural
x forall a. Num a => a -> a -> a
Num.+ Natural
1)

subtractOne :: Natural -> Maybe Signed
subtractOne :: Natural -> Maybe Signed
subtractOne Natural
x = case Natural
x of
  Natural
0 -> forall a. Maybe a
Nothing
  Natural
p -> forall a. a -> Maybe a
Just (Natural -> Natural -> Signed
subtract Natural
p Natural
1)

length :: [a] -> Natural
length :: forall a. [a] -> Natural
length = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\Natural
x a
_ -> Natural
x forall a. Num a => a -> a -> a
Num.+ Natural
1) Natural
0