{- | This module is unsafe not merely in the sense that it contains partial
functions, but moreover than it is capable of constructing the invalid
'Positive' value @'FromNatural' 0@ representing zero, which is not positive.
When a function has "checked" in its name, this indicates that it is partial but
will never construct an invalid 'Positive'. -}

module Integer.Positive.Unsafe
  (
    {- * Type -} Positive (FromNatural),
    {- * Conversion -}
    {- ** Natural -} toNatural, fromNatural, fromNaturalChecked,
    {- ** Integer -} toInteger, fromInteger, fromIntegerChecked,
    {- ** Int -} toInt, fromInt, fromIntChecked,
    {- * Arithmetic -} subtract, subtractChecked,
    {- * One (1) -} one, addOne, subtractOne, subtractOneChecked,
  )
  where

import Essentials ( ($), Enum, Eq, Ord, Show, (.), id )

import Integer.BoundedBelow (BoundedBelow)
import Numeric.Natural (Natural)
import Prelude (Int, Integer, Integral, Num, Real)

import qualified Control.DeepSeq as DeepSeq
import qualified Control.Exception as Exception
import qualified Data.Bits as Bits
import qualified Data.List as List
import qualified Data.Maybe as Maybe
import qualified Data.Ord as Ord
import qualified Integer.BoundedBelow as BoundedBelow
import qualified Prelude as Enum (Enum (..))
import qualified Prelude as Num (Integral (..), Num (..), Real (..),
                                 fromIntegral)
import qualified Text.Show as Show

newtype Positive = FromNatural{ Positive -> Natural
toNatural :: Natural } deriving (Positive -> Positive -> Bool
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
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
Ord)

instance DeepSeq.NFData Positive where rnf :: Positive -> ()
rnf (FromNatural Natural
x) = forall a. NFData a => a -> ()
DeepSeq.rnf Natural
x

fromNatural :: Natural -> Positive
fromNatural :: Natural -> Positive
fromNatural = Natural -> Positive
FromNatural

fromNaturalChecked :: Natural -> Positive
fromNaturalChecked :: Natural -> Positive
fromNaturalChecked Natural
x = case Natural
x of Natural
0 -> forall a e. Exception e => e -> a
Exception.throw ArithException
Exception.Underflow; Natural
_ -> Natural -> Positive
fromNatural Natural
x

toInteger :: Positive -> Integer
toInteger :: Positive -> Integer
toInteger = forall a. Integral a => a -> Integer
Num.toInteger forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Positive -> Natural
toNatural

fromInteger :: Integer -> Positive
fromInteger :: Integer -> Positive
fromInteger = Natural -> Positive
fromNatural forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Num a => Integer -> a
Num.fromInteger

fromIntegerChecked :: Integer -> Positive
fromIntegerChecked :: Integer -> Positive
fromIntegerChecked Integer
x = if Integer
x forall a. Ord a => a -> a -> Bool
Ord.>= Integer
1 then Integer -> Positive
fromInteger Integer
x else forall a e. Exception e => e -> a
Exception.throw ArithException
Exception.Underflow

add :: Positive -> Positive -> Positive
add :: Positive -> Positive -> Positive
add Positive
a Positive
b = Natural -> Positive
fromNatural (Positive -> Natural
toNatural Positive
a forall a. Num a => a -> a -> a
Num.+ Positive -> Natural
toNatural Positive
b)

subtract :: Positive -> Positive -> Positive
subtract :: Positive -> Positive -> Positive
subtract Positive
a Positive
b = Natural -> Positive
fromNatural (Positive -> Natural
toNatural Positive
a forall a. Num a => a -> a -> a
Num.- Positive -> Natural
toNatural Positive
b)

subtractChecked :: Positive -> Positive -> Positive
subtractChecked :: Positive -> Positive -> Positive
subtractChecked Positive
a Positive
b = if Positive
a forall a. Ord a => a -> a -> Bool
Ord.> Positive
b then Positive -> Positive -> Positive
subtract Positive
a Positive
b else forall a e. Exception e => e -> a
Exception.throw ArithException
Exception.Underflow

multiply :: Positive -> Positive -> Positive
multiply :: Positive -> Positive -> Positive
multiply Positive
a Positive
b = Natural -> Positive
fromNatural (Positive -> Natural
toNatural Positive
a forall a. Num a => a -> a -> a
Num.* Positive -> Natural
toNatural Positive
b)

one :: Positive
one :: Positive
one = Natural -> Positive
fromNatural Natural
1

addOne :: Positive -> Positive
addOne :: Positive -> Positive
addOne = Natural -> Positive
fromNatural forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall a. Num a => a -> a -> a
Num.+ Natural
1) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Positive -> Natural
toNatural

subtractOne :: Positive -> Positive
subtractOne :: Positive -> Positive
subtractOne = Natural -> Positive
fromNatural forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall a. Num a => a -> a -> a
Num.- Natural
1) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Positive -> Natural
toNatural

subtractOneChecked :: Positive -> Positive
subtractOneChecked :: Positive -> Positive
subtractOneChecked Positive
x = case Positive
x of { Positive
1 -> forall a e. Exception e => e -> a
Exception.throw ArithException
Exception.Underflow; Positive
_ -> Positive -> Positive
subtractOne Positive
x }

toInt :: Positive -> Int
toInt :: Positive -> Int
toInt = forall a b. (Integral a, Num b) => a -> b
Num.fromIntegral forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Positive -> Natural
toNatural

toIntChecked :: Positive -> Int
toIntChecked :: Positive -> Int
toIntChecked = forall a. a -> Maybe a -> a
Maybe.fromMaybe (forall a e. Exception e => e -> a
Exception.throw ArithException
Exception.Overflow) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Positive -> Natural
toNatural

fromInt :: Int -> Positive
fromInt :: Int -> Positive
fromInt = Natural -> Positive
fromNatural forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
Num.fromIntegral

fromIntChecked :: Int -> Positive
fromIntChecked :: Int -> Positive
fromIntChecked Int
x = case forall a. Num a => a -> a
Num.signum Int
x of { Int
1 -> Int -> Positive
fromInt Int
x; Int
_ -> forall a e. Exception e => e -> a
Exception.throw ArithException
Exception.Underflow }

enumFrom :: Positive -> [Positive]
enumFrom :: Positive -> [Positive]
enumFrom = forall a b. (a -> b) -> [a] -> [b]
List.map Natural -> Positive
fromNatural forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Enum a => a -> [a]
Enum.enumFrom forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Positive -> Natural
toNatural

enumFromTo :: Positive -> Positive -> [Positive]
enumFromTo :: Positive -> Positive -> [Positive]
enumFromTo Positive
a Positive
b = forall a b. (a -> b) -> [a] -> [b]
List.map Natural -> Positive
fromNatural forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a -> [a]
Enum.enumFromTo (Positive -> Natural
toNatural Positive
a) (Positive -> Natural
toNatural Positive
b)

enumFromThen :: Positive -> Positive -> [Positive]
enumFromThen :: Positive -> Positive -> [Positive]
enumFromThen Positive
a Positive
b = if Positive
a forall a. Ord a => a -> a -> Bool
Ord.< Positive
b then [Positive]
ascending else [Positive]
descending
  where
    ascending :: [Positive]
ascending = forall a b. (a -> b) -> [a] -> [b]
List.map Natural -> Positive
fromNatural forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a -> [a]
Enum.enumFromThen (Positive -> Natural
toNatural Positive
a) (Positive -> Natural
toNatural Positive
b)
    descending :: [Positive]
descending = forall a b. (a -> b) -> [a] -> [b]
List.map Integer -> Positive
fromInteger forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
List.takeWhile (forall a. Ord a => a -> a -> Bool
Ord.>= Integer
1) forall a b. (a -> b) -> a -> b
$
        forall a. Enum a => a -> a -> [a]
Enum.enumFromThen (Positive -> Integer
toInteger Positive
a) (Positive -> Integer
toInteger Positive
b)

enumFromThenTo :: Positive -> Positive -> Positive -> [Positive]
enumFromThenTo :: Positive -> Positive -> Positive -> [Positive]
enumFromThenTo Positive
a Positive
b Positive
c = if Positive
a forall a. Ord a => a -> a -> Bool
Ord.< Positive
b then [Positive]
ascending else [Positive]
descending
  where
    ascending :: [Positive]
ascending = forall a b. (a -> b) -> [a] -> [b]
List.map Natural -> Positive
fromNatural forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a -> a -> [a]
Enum.enumFromThenTo (Positive -> Natural
toNatural Positive
a) (Positive -> Natural
toNatural Positive
b) (Positive -> Natural
toNatural Positive
c)
    descending :: [Positive]
descending = forall a b. (a -> b) -> [a] -> [b]
List.map Integer -> Positive
fromInteger forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
List.takeWhile (forall a. Ord a => a -> a -> Bool
Ord.>= Integer
1) forall a b. (a -> b) -> a -> b
$
        forall a. Enum a => a -> a -> a -> [a]
Enum.enumFromThenTo (Positive -> Integer
toInteger Positive
a) (Positive -> Integer
toInteger Positive
b) (Positive -> Integer
toInteger Positive
c)

type Div a = a -> a -> (a, a)

divisionOp :: Div Natural -> Div Positive
divisionOp :: Div Natural -> Div Positive
divisionOp Div Natural
o Positive
a Positive
b =
    let (Natural
q, Natural
r) = Div Natural
o (Positive -> Natural
toNatural Positive
a) (Positive -> Natural
toNatural Positive
b)
    in (Natural -> Positive
fromNaturalChecked Natural
q, Natural -> Positive
fromNaturalChecked Natural
r)

instance BoundedBelow Positive
  where
    minBound :: Positive
minBound = Positive
1

instance Num Positive
  where
    abs :: Positive -> Positive
abs = forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
    negate :: Positive -> Positive
negate = \Positive
_ -> forall a e. Exception e => e -> a
Exception.throw ArithException
Exception.Underflow
    signum :: Positive -> Positive
signum = \Positive
_ -> Natural -> Positive
fromNatural Natural
1
    fromInteger :: Integer -> Positive
fromInteger = Integer -> Positive
fromIntegerChecked
    + :: Positive -> Positive -> Positive
(+) = Positive -> Positive -> Positive
add
    * :: Positive -> Positive -> Positive
(*) = Positive -> Positive -> Positive
multiply
    (-) = Positive -> Positive -> Positive
subtractChecked

instance Enum Positive
  where
    succ :: Positive -> Positive
succ = Positive -> Positive
addOne
    pred :: Positive -> Positive
pred = Positive -> Positive
subtractOneChecked

    fromEnum :: Positive -> Int
fromEnum = Positive -> Int
toIntChecked
    toEnum :: Int -> Positive
toEnum = Int -> Positive
fromIntChecked

    enumFrom :: Positive -> [Positive]
enumFrom = Positive -> [Positive]
enumFrom
    enumFromTo :: Positive -> Positive -> [Positive]
enumFromTo = Positive -> Positive -> [Positive]
enumFromTo
    enumFromThen :: Positive -> Positive -> [Positive]
enumFromThen = Positive -> Positive -> [Positive]
enumFromThen
    enumFromThenTo :: Positive -> Positive -> Positive -> [Positive]
enumFromThenTo = Positive -> Positive -> Positive -> [Positive]
enumFromThenTo

instance Real Positive
  where
    toRational :: Positive -> Rational
toRational = forall a. Real a => a -> Rational
Num.toRational forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Positive -> Integer
toInteger

instance Integral Positive
  where
    toInteger :: Positive -> Integer
toInteger = Positive -> Integer
toInteger
    quotRem :: Div Positive
quotRem = Div Natural -> Div Positive
divisionOp forall a. Integral a => a -> a -> (a, a)
Num.quotRem
    divMod :: Div Positive
divMod = Div Natural -> Div Positive
divisionOp forall a. Integral a => a -> a -> (a, a)
Num.divMod

instance Show Positive
  where
    show :: Positive -> String
show = forall a. Show a => a -> String
Show.show forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Positive -> Natural
toNatural
    showsPrec :: Int -> Positive -> ShowS
showsPrec Int
i = forall a. Show a => Int -> a -> ShowS
Show.showsPrec Int
i forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Positive -> Natural
toNatural