module Integer.Natural
(
Natural,
subtract,
toPositive,
fromPositive,
toInteger,
fromInteger,
toSigned,
fromSigned,
toInt,
fromInt,
toWord,
fromWord,
one,
addOne,
subtractOne,
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