module Integer.Signed
  ( -- * Type
    Signed (Zero, NonZero, Plus, Minus, NotPlus, NotMinus),

    -- * Conversion

    -- ** Integer
    toInteger,
    fromInteger,

    -- ** Natural
    toNatural,
    fromNatural,

    -- ** Positive
    toPositive,
    fromPositive,

    -- ** Int
    toInt,
    fromInt,

    -- ** Word
    toWord,
    fromWord,

    -- * Arithmetic

    -- ** Increase
    increase,
    strictlyIncrease,

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

import Control.DeepSeq qualified as DeepSeq
import Data.Hashable (Hashable (hashWithSalt))
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.Unsafe (Positive)
import Integer.Positive.Unsafe qualified as Positive.Unsafe
import Integer.Sign (Sign (..))
import Integer.Sign qualified as Sign
import Numeric.Natural (Natural)
import Text.Show qualified as Show
import Prelude (Integer, Integral, Num, Real, seq)
import Prelude qualified as Bounded (Bounded (..))
import Prelude qualified as Enum (Enum (..))
import Prelude qualified as Num (Integral (..), Num (..), Real (..))

data Signed = Zero | NonZero Sign Positive
  deriving stock (Signed -> Signed -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Signed -> Signed -> Bool
$c/= :: Signed -> Signed -> Bool
== :: Signed -> Signed -> Bool
$c== :: Signed -> Signed -> Bool
Eq)

instance Ord Signed where
  compare :: Signed -> Signed -> Ordering
compare Signed
Zero Signed
Zero = Ordering
Ord.EQ
  compare Signed
Zero (Minus Positive
_) = Ordering
Ord.GT
  compare Signed
Zero (Plus Positive
_) = Ordering
Ord.LT
  compare (Minus Positive
_) Signed
Zero = Ordering
Ord.LT
  compare (Plus Positive
_) Signed
Zero = Ordering
Ord.GT
  compare (Plus Positive
_) (Minus Positive
_) = Ordering
Ord.GT
  compare (Minus Positive
_) (Plus Positive
_) = Ordering
Ord.LT
  compare (Plus Positive
a) (Plus Positive
b) = forall a. Ord a => a -> a -> Ordering
Ord.compare Positive
a Positive
b
  compare (Minus Positive
a) (Minus Positive
b) = forall a. Ord a => a -> a -> Ordering
Ord.compare Positive
b Positive
a

instance DeepSeq.NFData Signed where
  rnf :: Signed -> ()
rnf Signed
Zero = ()
  rnf (NonZero Sign
a Positive
b) = Sign
a seq :: forall a b. a -> b -> b
`seq` Positive
b seq :: forall a b. a -> b -> b
`seq` ()

instance Hashable Signed where
  hashWithSalt :: Int -> Signed -> Int
hashWithSalt Int
s Signed
Zero = Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
0 :: Int)
  hashWithSalt Int
s (Plus Positive
x) = Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
1 :: Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Positive
x
  hashWithSalt Int
s (Minus Positive
x) = Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (-Int
1 :: Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Positive
x

pattern Minus :: Positive -> Signed
pattern $bMinus :: Positive -> Signed
$mMinus :: forall {r}. Signed -> (Positive -> r) -> ((# #) -> r) -> r
Minus x = NonZero MinusSign x

pattern Plus :: Positive -> Signed
pattern $bPlus :: Positive -> Signed
$mPlus :: forall {r}. Signed -> (Positive -> r) -> ((# #) -> r) -> r
Plus x = NonZero PlusSign x

-- | A 'Signed' that is either zero or positive
pattern NotMinus :: Natural -> Signed
pattern $bNotMinus :: Natural -> Signed
$mNotMinus :: forall {r}. Signed -> (Natural -> r) -> ((# #) -> r) -> r
NotMinus x <- (toNatural -> Just x)
  where
    NotMinus = Natural -> Signed
fromNatural

-- | A 'Signed' that is either zero or negative;
-- the 'Natural' gives the magnitude of the negative
pattern NotPlus :: Natural -> Signed
pattern $bNotPlus :: Natural -> Signed
$mNotPlus :: forall {r}. Signed -> (Natural -> r) -> ((# #) -> r) -> r
NotPlus x <- ((toNatural . negate) -> Just x)
  where
    NotPlus = Signed -> Signed
negate forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Natural -> Signed
fromNatural

{-# COMPLETE Zero, Minus, Plus #-}

{-# COMPLETE Plus, NotPlus #-}

{-# COMPLETE Minus, NotMinus #-}

fromPositive :: Positive -> Signed
fromPositive :: Positive -> Signed
fromPositive = Positive -> Signed
Plus

toPositive :: Signed -> Maybe Positive
toPositive :: Signed -> Maybe Positive
toPositive (Plus Positive
x) = forall a. a -> Maybe a
Just Positive
x
toPositive Signed
_ = forall a. Maybe a
Nothing

fromNatural :: Natural -> Signed
fromNatural :: Natural -> Signed
fromNatural Natural
0 = Signed
Zero
fromNatural Natural
x = Positive -> Signed
Plus forall a b. (a -> b) -> a -> b
$ Natural -> Positive
Positive.Unsafe.fromNatural Natural
x

toNatural :: Signed -> Maybe Natural
toNatural :: Signed -> Maybe Natural
toNatural (Minus Positive
_) = forall a. Maybe a
Nothing
toNatural Signed
Zero = forall a. a -> Maybe a
Just Natural
0
toNatural (Plus Positive
x) = forall a. a -> Maybe a
Just (Positive -> Natural
Positive.Unsafe.toNatural Positive
x)

one :: Signed
one :: Signed
one = Positive -> Signed
Plus Positive
Positive.Unsafe.one

addOne :: Signed -> Signed
addOne :: Signed -> Signed
addOne Signed
Zero = Signed
one
addOne (Minus Positive
1) = Signed
Zero
addOne (Minus Positive
n) = Positive -> Signed
Minus (Positive -> Positive
Positive.Unsafe.subtractOne Positive
n)
addOne (Plus Positive
n) = Positive -> Signed
Plus (Positive -> Positive
Positive.Unsafe.addOne Positive
n)

subtractOne :: Signed -> Signed
subtractOne :: Signed -> Signed
subtractOne Signed
Zero = Positive -> Signed
Minus Positive
1
subtractOne (Plus Positive
1) = Signed
Zero
subtractOne (Plus Positive
n) = Positive -> Signed
Plus (Positive -> Positive
Positive.Unsafe.subtractOne Positive
n)
subtractOne (Minus Positive
n) = Positive -> Signed
Minus (Positive -> Positive
Positive.Unsafe.addOne Positive
n)

increase :: Natural -> Signed -> Signed
increase :: Natural -> Signed -> Signed
increase Natural
0 Signed
x = Signed
x
increase Natural
n Signed
x = Positive -> Signed -> Signed
strictlyIncrease (Natural -> Positive
Positive.Unsafe.fromNatural Natural
n) Signed
x

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

add :: Signed -> Signed -> Signed
add :: Signed -> Signed -> Signed
add Signed
Zero Signed
x = Signed
x
add Signed
x Signed
Zero = Signed
x
add (NonZero Sign
sa Positive
a) (NonZero Sign
sb Positive
b) = case (Sign
sa, Sign
sb) of
  (Sign
PlusSign, Sign
PlusSign) -> Positive -> Signed
Plus forall a b. (a -> b) -> a -> b
$ Positive
a forall a. Num a => a -> a -> a
Num.+ Positive
b
  (Sign
MinusSign, Sign
MinusSign) -> Positive -> Signed
Minus forall a b. (a -> b) -> a -> b
$ Positive
a forall a. Num a => a -> a -> a
Num.+ Positive
b
  (Sign
MinusSign, Sign
PlusSign) -> case forall a. Ord a => a -> a -> Ordering
Ord.compare Positive
a Positive
b of
    Ordering
Ord.EQ -> Signed
Zero
    Ordering
Ord.LT -> Positive -> Signed
Plus forall a b. (a -> b) -> a -> b
$ Positive -> Positive -> Positive
Positive.Unsafe.subtract Positive
b Positive
a
    Ordering
Ord.GT -> Positive -> Signed
Minus forall a b. (a -> b) -> a -> b
$ Positive -> Positive -> Positive
Positive.Unsafe.subtract Positive
a Positive
b
  (Sign
PlusSign, Sign
MinusSign) -> case forall a. Ord a => a -> a -> Ordering
Ord.compare Positive
a Positive
b of
    Ordering
Ord.EQ -> Signed
Zero
    Ordering
Ord.LT -> Positive -> Signed
Minus forall a b. (a -> b) -> a -> b
$ Positive -> Positive -> Positive
Positive.Unsafe.subtract Positive
b Positive
a
    Ordering
Ord.GT -> Positive -> Signed
Plus forall a b. (a -> b) -> a -> b
$ Positive -> Positive -> Positive
Positive.Unsafe.subtract Positive
a Positive
b

negate :: Signed -> Signed
negate :: Signed -> Signed
negate Signed
Zero = Signed
Zero
negate (NonZero Sign
s Positive
x) = Sign -> Positive -> Signed
NonZero (Sign -> Sign
Sign.negate Sign
s) Positive
x

multiply :: Signed -> Signed -> Signed
multiply :: Signed -> Signed -> Signed
multiply Signed
Zero Signed
_ = Signed
Zero
multiply Signed
_ Signed
Zero = Signed
Zero
multiply (NonZero Sign
sa Positive
a) (NonZero Sign
sb Positive
b) =
  Sign -> Positive -> Signed
NonZero (Sign -> Sign -> Sign
Sign.multiply Sign
sa Sign
sb) (Positive
a forall a. Num a => a -> a -> a
Num.* Positive
b)

abs :: Signed -> Signed
abs :: Signed -> Signed
abs Signed
Zero = Signed
Zero
abs x :: Signed
x@(NonZero Sign
s Positive
p) = case Sign
s of
  Sign
PlusSign -> Signed
x
  Sign
MinusSign -> Sign -> Positive -> Signed
NonZero Sign
PlusSign Positive
p

signum :: Signed -> Signed
signum :: Signed -> Signed
signum Signed
Zero = Signed
Zero
signum (NonZero Sign
s Positive
_) = Sign -> Positive -> Signed
NonZero Sign
s Positive
Positive.Unsafe.one

fromInteger :: Integer -> Signed
fromInteger :: Integer -> Signed
fromInteger Integer
x = case forall a. Ord a => a -> a -> Ordering
Ord.compare Integer
x Integer
0 of
  Ordering
Ord.EQ -> Signed
Zero
  Ordering
Ord.LT -> Positive -> Signed
Minus forall a b. (a -> b) -> a -> b
$ Integer -> Positive
Positive.Unsafe.fromInteger forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
Num.abs Integer
x
  Ordering
Ord.GT -> Positive -> Signed
Plus forall a b. (a -> b) -> a -> b
$ Integer -> Positive
Positive.Unsafe.fromInteger Integer
x

toInteger :: Signed -> Integer
toInteger :: Signed -> Integer
toInteger Signed
Zero = Integer
0
toInteger (Plus Positive
x) = Positive -> Integer
Positive.Unsafe.toInteger Positive
x
toInteger (Minus Positive
x) = forall a. Num a => a -> a
Num.negate forall a b. (a -> b) -> a -> b
$ Positive -> Integer
Positive.Unsafe.toInteger Positive
x

toInt :: Signed -> Maybe Int
toInt :: Signed -> Maybe Int
toInt Signed
x = case Signed
x of
  Signed
Zero -> forall a. a -> Maybe a
Just Int
0
  Plus Positive
p -> if Bool
ok then forall a. a -> Maybe a
Just (forall a. Num a => Integer -> a
Num.fromInteger Integer
i) else forall a. Maybe a
Nothing
    where
      ok :: Bool
ok = Integer
i forall a. Ord a => a -> a -> Bool
Ord.<= forall a. Integral a => a -> Integer
Num.toInteger (forall a. Bounded a => a
Bounded.maxBound :: Int)
      i :: Integer
i = Positive -> Integer
Positive.Unsafe.toInteger Positive
p
  Minus Positive
p -> if Bool
ok then forall a. a -> Maybe a
Just (forall a. Num a => Integer -> a
Num.fromInteger Integer
i) else forall a. Maybe a
Nothing
    where
      ok :: Bool
ok = Integer
i forall a. Ord a => a -> a -> Bool
Ord.>= forall a. Integral a => a -> Integer
Num.toInteger (forall a. Bounded a => a
Bounded.minBound :: Int)
      i :: Integer
i = forall a. Num a => a -> a
Num.negate (Positive -> Integer
Positive.Unsafe.toInteger Positive
p)

fromInt :: Int -> Signed
fromInt :: Int -> Signed
fromInt Int
x = case forall a. Ord a => a -> a -> Ordering
Ord.compare Int
x Int
0 of
  Ordering
Ord.EQ -> Signed
Zero
  Ordering
Ord.GT -> Positive -> Signed
Plus forall a b. (a -> b) -> a -> b
$ Int -> Positive
Positive.Unsafe.fromInt Int
x
  Ordering
Ord.LT -> Positive -> Signed
Minus forall a b. (a -> b) -> a -> b
$ Integer -> Positive
Positive.Unsafe.fromInteger forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
Num.negate forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Integer
Num.toInteger Int
x

toWord :: Signed -> Maybe Word
toWord :: Signed -> Maybe Word
toWord Signed
x = case Signed
x of
  Signed
Zero -> forall a. a -> Maybe a
Just Word
0
  Plus Positive
p -> if Bool
ok then forall a. a -> Maybe a
Just (forall a. Num a => Integer -> a
Num.fromInteger Integer
i) else forall a. Maybe a
Nothing
    where
      ok :: Bool
ok = Integer
i forall a. Ord a => a -> a -> Bool
Ord.<= forall a. Integral a => a -> Integer
Num.toInteger (forall a. Bounded a => a
Bounded.maxBound :: Word)
      i :: Integer
i = Positive -> Integer
Positive.Unsafe.toInteger Positive
p
  Minus Positive
_ -> forall a. Maybe a
Nothing

fromWord :: Word -> Signed
fromWord :: Word -> Signed
fromWord Word
x = case Word
x of
  Word
0 -> Signed
Zero
  Word
_ -> Positive -> Signed
Plus forall a b. (a -> b) -> a -> b
$ Integer -> Positive
Positive.Unsafe.fromInteger (forall a. Integral a => a -> Integer
Num.toInteger Word
x)

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

divisionOp :: Div Integer -> Div Signed
divisionOp :: Div Integer -> Div Signed
divisionOp Div Integer
o Signed
a Signed
b =
  let (Integer
q, Integer
r) = Div Integer
o (Signed -> Integer
toInteger Signed
a) (Signed -> Integer
toInteger Signed
b)
   in (Integer -> Signed
fromInteger Integer
q, Integer -> Signed
fromInteger Integer
r)

instance Num Signed where
  + :: Signed -> Signed -> Signed
(+) = Signed -> Signed -> Signed
add
  * :: Signed -> Signed -> Signed
(*) = Signed -> Signed -> Signed
multiply
  negate :: Signed -> Signed
negate = Signed -> Signed
negate
  abs :: Signed -> Signed
abs = Signed -> Signed
abs
  signum :: Signed -> Signed
signum = Signed -> Signed
signum
  fromInteger :: Integer -> Signed
fromInteger = Integer -> Signed
fromInteger

instance Enum Signed where
  pred :: Signed -> Signed
pred = Integer -> Signed
fromInteger 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.pred forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Signed -> Integer
toInteger
  succ :: Signed -> Signed
succ = Integer -> Signed
fromInteger 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.succ forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Signed -> Integer
toInteger

  toEnum :: Int -> Signed
toEnum = Integer -> Signed
fromInteger 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 => Int -> a
Enum.toEnum
  fromEnum :: Signed -> Int
fromEnum = forall a. Enum a => a -> Int
Enum.fromEnum forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Signed -> Integer
toInteger

  enumFrom :: Signed -> [Signed]
enumFrom Signed
a = forall a b. (a -> b) -> [a] -> [b]
List.map Integer -> Signed
fromInteger forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> [a]
Enum.enumFrom (Signed -> Integer
toInteger Signed
a)
  enumFromTo :: Signed -> Signed -> [Signed]
enumFromTo Signed
a Signed
b = forall a b. (a -> b) -> [a] -> [b]
List.map Integer -> Signed
fromInteger forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a -> [a]
Enum.enumFromTo (Signed -> Integer
toInteger Signed
a) (Signed -> Integer
toInteger Signed
b)
  enumFromThen :: Signed -> Signed -> [Signed]
enumFromThen Signed
a Signed
b = forall a b. (a -> b) -> [a] -> [b]
List.map Integer -> Signed
fromInteger forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a -> [a]
Enum.enumFromThen (Signed -> Integer
toInteger Signed
a) (Signed -> Integer
toInteger Signed
b)
  enumFromThenTo :: Signed -> Signed -> Signed -> [Signed]
enumFromThenTo Signed
a Signed
b Signed
c = forall a b. (a -> b) -> [a] -> [b]
List.map Integer -> Signed
fromInteger forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a -> a -> [a]
Enum.enumFromThenTo (Signed -> Integer
toInteger Signed
a) (Signed -> Integer
toInteger Signed
b) (Signed -> Integer
toInteger Signed
c)

instance Real Signed where
  toRational :: Signed -> 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
. Signed -> Integer
toInteger

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

instance Show Signed where
  show :: Signed -> 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
. forall a. Integral a => a -> Integer
Num.toInteger
  showsPrec :: Int -> Signed -> 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
. forall a. Integral a => a -> Integer
Num.toInteger