{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- |  A positive number type, defined as existing on [zero, +infinity)
module NumHask.Data.Positive
  ( Positive (..),
    positive,
    maybePositive,
    positive_,
    Monus (..),
    Addus (..),
    MonusSemiField,
  )
where

import Control.Category ((>>>))
import Data.Bool (bool)
import Data.Maybe
import NumHask.Algebra.Action
import NumHask.Algebra.Additive
import NumHask.Algebra.Field
import NumHask.Algebra.Lattice
import NumHask.Algebra.Metric
import NumHask.Algebra.Multiplicative
import NumHask.Algebra.Ring
import NumHask.Data.Integral
import NumHask.Data.Rational
import NumHask.Data.Wrapped
import Numeric.Natural (Natural, minusNaturalMaybe)
import Prelude (Eq, Ord, Show)
import Prelude qualified as P

-- $setup
--
-- >>> :m -Prelude
-- >>> :set -XRebindableSyntax
-- >>> import NumHask.Prelude
-- >>> import NumHask.Data.Positive

-- | A positive number is a number that is contained in [zero,+infinity).
--
-- >>> 1 :: Positive Int
-- UnsafePositive {unPositive = 1}
--
--
-- >>> -1 :: Positive Int
-- ...
--     • No instance for ‘Subtractive (Positive Int)’
--         arising from a use of syntactic negation
-- ...
--
-- zero is positive
--
-- >>> positive 0 == zero
-- True
--
-- The main constructors:
--
-- >>> positive (-1)
-- UnsafePositive {unPositive = 0}
--
-- >>> maybePositive (-1)
-- Nothing
--
-- >>> UnsafePositive (-1)
-- UnsafePositive {unPositive = -1}
newtype Positive a = UnsafePositive {forall a. Positive a -> a
unPositive :: a}
  deriving stock
    (Positive a -> Positive a -> Bool
(Positive a -> Positive a -> Bool)
-> (Positive a -> Positive a -> Bool) -> Eq (Positive a)
forall a. Eq a => Positive a -> Positive a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Positive a -> Positive a -> Bool
== :: Positive a -> Positive a -> Bool
$c/= :: forall a. Eq a => Positive a -> Positive a -> Bool
/= :: Positive a -> Positive a -> Bool
Eq, Eq (Positive a)
Eq (Positive a) =>
(Positive a -> Positive a -> Ordering)
-> (Positive a -> Positive a -> Bool)
-> (Positive a -> Positive a -> Bool)
-> (Positive a -> Positive a -> Bool)
-> (Positive a -> Positive a -> Bool)
-> (Positive a -> Positive a -> Positive a)
-> (Positive a -> Positive a -> Positive a)
-> Ord (Positive a)
Positive a -> Positive a -> Bool
Positive a -> Positive a -> Ordering
Positive a -> Positive a -> Positive a
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
forall a. Ord a => Eq (Positive a)
forall a. Ord a => Positive a -> Positive a -> Bool
forall a. Ord a => Positive a -> Positive a -> Ordering
forall a. Ord a => Positive a -> Positive a -> Positive a
$ccompare :: forall a. Ord a => Positive a -> Positive a -> Ordering
compare :: Positive a -> Positive a -> Ordering
$c< :: forall a. Ord a => Positive a -> Positive a -> Bool
< :: Positive a -> Positive a -> Bool
$c<= :: forall a. Ord a => Positive a -> Positive a -> Bool
<= :: Positive a -> Positive a -> Bool
$c> :: forall a. Ord a => Positive a -> Positive a -> Bool
> :: Positive a -> Positive a -> Bool
$c>= :: forall a. Ord a => Positive a -> Positive a -> Bool
>= :: Positive a -> Positive a -> Bool
$cmax :: forall a. Ord a => Positive a -> Positive a -> Positive a
max :: Positive a -> Positive a -> Positive a
$cmin :: forall a. Ord a => Positive a -> Positive a -> Positive a
min :: Positive a -> Positive a -> Positive a
Ord, Int -> Positive a -> ShowS
[Positive a] -> ShowS
Positive a -> String
(Int -> Positive a -> ShowS)
-> (Positive a -> String)
-> ([Positive a] -> ShowS)
-> Show (Positive a)
forall a. Show a => Int -> Positive a -> ShowS
forall a. Show a => [Positive a] -> ShowS
forall a. Show a => Positive a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Positive a -> ShowS
showsPrec :: Int -> Positive a -> ShowS
$cshow :: forall a. Show a => Positive a -> String
show :: Positive a -> String
$cshowList :: forall a. Show a => [Positive a] -> ShowS
showList :: [Positive a] -> ShowS
Show)
  deriving
    ( Positive a
Positive a -> Positive a -> Positive a
(Positive a -> Positive a -> Positive a)
-> Positive a -> Additive (Positive a)
forall a. Additive a => Positive a
forall a. Additive a => Positive a -> Positive a -> Positive a
forall a. (a -> a -> a) -> a -> Additive a
$c+ :: forall a. Additive a => Positive a -> Positive a -> Positive a
+ :: Positive a -> Positive a -> Positive a
$czero :: forall a. Additive a => Positive a
zero :: Positive a
Additive,
      Positive a
Positive a -> Positive a -> Positive a
(Positive a -> Positive a -> Positive a)
-> Positive a -> Multiplicative (Positive a)
forall a. Multiplicative a => Positive a
forall a.
Multiplicative a =>
Positive a -> Positive a -> Positive a
forall a. (a -> a -> a) -> a -> Multiplicative a
$c* :: forall a.
Multiplicative a =>
Positive a -> Positive a -> Positive a
* :: Positive a -> Positive a -> Positive a
$cone :: forall a. Multiplicative a => Positive a
one :: Positive a
Multiplicative,
      Multiplicative (Positive a)
Multiplicative (Positive a) =>
(Positive a -> Positive a)
-> (Positive a -> Positive a -> Positive a)
-> Divisive (Positive a)
Positive a -> Positive a
Positive a -> Positive a -> Positive a
forall a. Divisive a => Multiplicative (Positive a)
forall a. Divisive a => Positive a -> Positive a
forall a. Divisive a => Positive a -> Positive a -> Positive a
forall a.
Multiplicative a =>
(a -> a) -> (a -> a -> a) -> Divisive a
$crecip :: forall a. Divisive a => Positive a -> Positive a
recip :: Positive a -> Positive a
$c/ :: forall a. Divisive a => Positive a -> Positive a -> Positive a
/ :: Positive a -> Positive a -> Positive a
Divisive,
      Distributive (Positive a)
Distributive (Positive a) =>
(Positive a -> Positive a -> Positive a)
-> (Positive a -> Positive a -> Positive a)
-> (Positive a -> Positive a -> DivMod (Positive a))
-> (Positive a -> Positive a -> Positive a)
-> (Positive a -> Positive a -> Positive a)
-> (Positive a -> Positive a -> QuotRem (Positive a))
-> Integral (Positive a)
Positive a -> Positive a -> DivMod (Positive a)
Positive a -> Positive a -> QuotRem (Positive a)
Positive a -> Positive a -> Positive a
forall a.
Distributive a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> DivMod a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> QuotRem a)
-> Integral a
forall a. Integral a => Distributive (Positive a)
forall a.
Integral a =>
Positive a -> Positive a -> DivMod (Positive a)
forall a.
Integral a =>
Positive a -> Positive a -> QuotRem (Positive a)
forall a. Integral a => Positive a -> Positive a -> Positive a
$cdiv :: forall a. Integral a => Positive a -> Positive a -> Positive a
div :: Positive a -> Positive a -> Positive a
$cmod :: forall a. Integral a => Positive a -> Positive a -> Positive a
mod :: Positive a -> Positive a -> Positive a
$cdivMod :: forall a.
Integral a =>
Positive a -> Positive a -> DivMod (Positive a)
divMod :: Positive a -> Positive a -> DivMod (Positive a)
$cquot :: forall a. Integral a => Positive a -> Positive a -> Positive a
quot :: Positive a -> Positive a -> Positive a
$crem :: forall a. Integral a => Positive a -> Positive a -> Positive a
rem :: Positive a -> Positive a -> Positive a
$cquotRem :: forall a.
Integral a =>
Positive a -> Positive a -> QuotRem (Positive a)
quotRem :: Positive a -> Positive a -> QuotRem (Positive a)
Integral,
      Integer -> Positive a
(Integer -> Positive a) -> FromInteger (Positive a)
forall a. FromInteger a => Integer -> Positive a
forall a. (Integer -> a) -> FromInteger a
$cfromInteger :: forall a. FromInteger a => Integer -> Positive a
fromInteger :: Integer -> Positive a
FromInteger,
      Rational -> Positive a
(Rational -> Positive a) -> FromRational (Positive a)
forall a. FromRational a => Rational -> Positive a
forall a. (Rational -> a) -> FromRational a
$cfromRational :: forall a. FromRational a => Rational -> Positive a
fromRational :: Rational -> Positive a
FromRational,
      Distributive (Mag (Positive a))
Distributive (Mag (Positive a)) =>
(Positive a -> Mag (Positive a))
-> (Positive a -> Base (Positive a)) -> Basis (Positive a)
Positive a -> Base (Positive a)
Positive a -> Mag (Positive a)
forall a.
Distributive (Mag a) =>
(a -> Mag a) -> (a -> Base a) -> Basis a
forall a. Basis a => Distributive (Mag (Positive a))
forall a. Basis a => Positive a -> Base (Positive a)
forall a. Basis a => Positive a -> Mag (Positive a)
$cmagnitude :: forall a. Basis a => Positive a -> Mag (Positive a)
magnitude :: Positive a -> Mag (Positive a)
$cbasis :: forall a. Basis a => Positive a -> Base (Positive a)
basis :: Positive a -> Base (Positive a)
Basis,
      Distributive (Dir (Positive a))
Distributive (Positive a)
(Distributive (Positive a), Distributive (Dir (Positive a))) =>
(Positive a -> Dir (Positive a))
-> (Dir (Positive a) -> Positive a) -> Direction (Positive a)
Dir (Positive a) -> Positive a
Positive a -> Dir (Positive a)
forall coord.
(Distributive coord, Distributive (Dir coord)) =>
(coord -> Dir coord) -> (Dir coord -> coord) -> Direction coord
forall a. Direction a => Distributive (Dir (Positive a))
forall a. Direction a => Distributive (Positive a)
forall a. Direction a => Dir (Positive a) -> Positive a
forall a. Direction a => Positive a -> Dir (Positive a)
$cangle :: forall a. Direction a => Positive a -> Dir (Positive a)
angle :: Positive a -> Dir (Positive a)
$cray :: forall a. Direction a => Dir (Positive a) -> Positive a
ray :: Dir (Positive a) -> Positive a
Direction,
      Eq (Positive a)
Additive (Positive a)
Positive a
(Eq (Positive a), Additive (Positive a)) =>
Positive a -> Epsilon (Positive a)
forall a. (Eq a, Additive a) => a -> Epsilon a
forall a. Epsilon a => Eq (Positive a)
forall a. Epsilon a => Additive (Positive a)
forall a. Epsilon a => Positive a
$cepsilon :: forall a. Epsilon a => Positive a
epsilon :: Positive a
Epsilon,
      Additive (AdditiveScalar (Positive a))
Additive (AdditiveScalar (Positive a)) =>
(Positive a -> AdditiveScalar (Positive a) -> Positive a)
-> AdditiveAction (Positive a)
Positive a -> AdditiveScalar (Positive a) -> Positive a
forall m.
Additive (AdditiveScalar m) =>
(m -> AdditiveScalar m -> m) -> AdditiveAction m
forall a.
AdditiveAction a =>
Additive (AdditiveScalar (Positive a))
forall a.
AdditiveAction a =>
Positive a -> AdditiveScalar (Positive a) -> Positive a
$c|+ :: forall a.
AdditiveAction a =>
Positive a -> AdditiveScalar (Positive a) -> Positive a
|+ :: Positive a -> AdditiveScalar (Positive a) -> Positive a
AdditiveAction,
      Subtractive (AdditiveScalar (Positive a))
AdditiveAction (Positive a)
(AdditiveAction (Positive a),
 Subtractive (AdditiveScalar (Positive a))) =>
(Positive a -> AdditiveScalar (Positive a) -> Positive a)
-> SubtractiveAction (Positive a)
Positive a -> AdditiveScalar (Positive a) -> Positive a
forall m.
(AdditiveAction m, Subtractive (AdditiveScalar m)) =>
(m -> AdditiveScalar m -> m) -> SubtractiveAction m
forall a.
SubtractiveAction a =>
Subtractive (AdditiveScalar (Positive a))
forall a. SubtractiveAction a => AdditiveAction (Positive a)
forall a.
SubtractiveAction a =>
Positive a -> AdditiveScalar (Positive a) -> Positive a
$c|- :: forall a.
SubtractiveAction a =>
Positive a -> AdditiveScalar (Positive a) -> Positive a
|- :: Positive a -> AdditiveScalar (Positive a) -> Positive a
SubtractiveAction,
      Multiplicative (Scalar (Positive a))
Multiplicative (Scalar (Positive a)) =>
(Positive a -> Scalar (Positive a) -> Positive a)
-> MultiplicativeAction (Positive a)
Positive a -> Scalar (Positive a) -> Positive a
forall m.
Multiplicative (Scalar m) =>
(m -> Scalar m -> m) -> MultiplicativeAction m
forall a.
MultiplicativeAction a =>
Multiplicative (Scalar (Positive a))
forall a.
MultiplicativeAction a =>
Positive a -> Scalar (Positive a) -> Positive a
$c|* :: forall a.
MultiplicativeAction a =>
Positive a -> Scalar (Positive a) -> Positive a
|* :: Positive a -> Scalar (Positive a) -> Positive a
MultiplicativeAction,
      Divisive (Scalar (Positive a))
MultiplicativeAction (Positive a)
(Divisive (Scalar (Positive a)),
 MultiplicativeAction (Positive a)) =>
(Positive a -> Scalar (Positive a) -> Positive a)
-> DivisiveAction (Positive a)
Positive a -> Scalar (Positive a) -> Positive a
forall m.
(Divisive (Scalar m), MultiplicativeAction m) =>
(m -> Scalar m -> m) -> DivisiveAction m
forall a. DivisiveAction a => Divisive (Scalar (Positive a))
forall a. DivisiveAction a => MultiplicativeAction (Positive a)
forall a.
DivisiveAction a =>
Positive a -> Scalar (Positive a) -> Positive a
$c|/ :: forall a.
DivisiveAction a =>
Positive a -> Scalar (Positive a) -> Positive a
|/ :: Positive a -> Scalar (Positive a) -> Positive a
DivisiveAction,
      Eq (Positive a)
Eq (Positive a) =>
(Positive a -> Positive a -> Positive a)
-> JoinSemiLattice (Positive a)
Positive a -> Positive a -> Positive a
forall a. Eq a => (a -> a -> a) -> JoinSemiLattice a
forall a. JoinSemiLattice a => Eq (Positive a)
forall a.
JoinSemiLattice a =>
Positive a -> Positive a -> Positive a
$c\/ :: forall a.
JoinSemiLattice a =>
Positive a -> Positive a -> Positive a
\/ :: Positive a -> Positive a -> Positive a
JoinSemiLattice,
      Eq (Positive a)
Eq (Positive a) =>
(Positive a -> Positive a -> Positive a)
-> MeetSemiLattice (Positive a)
Positive a -> Positive a -> Positive a
forall a. Eq a => (a -> a -> a) -> MeetSemiLattice a
forall a. MeetSemiLattice a => Eq (Positive a)
forall a.
MeetSemiLattice a =>
Positive a -> Positive a -> Positive a
$c/\ :: forall a.
MeetSemiLattice a =>
Positive a -> Positive a -> Positive a
/\ :: Positive a -> Positive a -> Positive a
MeetSemiLattice,
      MeetSemiLattice (Positive a)
Positive a
MeetSemiLattice (Positive a) =>
Positive a -> UpperBounded (Positive a)
forall a. MeetSemiLattice a => a -> UpperBounded a
forall a. UpperBounded a => MeetSemiLattice (Positive a)
forall a. UpperBounded a => Positive a
$ctop :: forall a. UpperBounded a => Positive a
top :: Positive a
UpperBounded
    )
    via (Wrapped a)

instance (JoinSemiLattice a, Integral a) => FromIntegral (Positive a) a where
  fromIntegral :: a -> Positive a
fromIntegral a
a = a -> Positive a
forall a. (Additive a, JoinSemiLattice a) => a -> Positive a
positive a
a

instance (FromIntegral a b) => FromIntegral (Positive a) b where
  fromIntegral :: b -> Positive a
fromIntegral b
a = a -> Positive a
forall a. a -> Positive a
UnsafePositive (b -> a
forall a b. FromIntegral a b => b -> a
fromIntegral b
a)

instance (ToIntegral a b) => ToIntegral (Positive a) b where
  toIntegral :: Positive a -> b
toIntegral (UnsafePositive a
a) = a -> b
forall a b. ToIntegral a b => a -> b
toIntegral a
a

instance (FromRatio a b) => FromRatio (Positive a) b where
  fromRatio :: Ratio b -> Positive a
fromRatio Ratio b
a = a -> Positive a
forall a. a -> Positive a
UnsafePositive (Ratio b -> a
forall a b. FromRatio a b => Ratio b -> a
fromRatio Ratio b
a)

instance (ToRatio a b) => ToRatio (Positive a) b where
  toRatio :: Positive a -> Ratio b
toRatio (UnsafePositive a
a) = a -> Ratio b
forall a b. ToRatio a b => a -> Ratio b
toRatio a
a

instance (Additive a, JoinSemiLattice a) => LowerBounded (Positive a) where
  bottom :: Positive a
bottom = a -> Positive a
forall a. a -> Positive a
UnsafePositive a
forall a. Additive a => a
zero

instance QuotientField (Positive P.Double) where
  type Whole (Positive P.Double) = Positive P.Int
  properFraction :: Positive Double
-> Quotient (Whole (Positive Double)) (Positive Double)
properFraction (UnsafePositive Double
a) = let (Int
n, Double
r) = Double -> (Int, Double)
forall b. Integral b => Double -> (b, Double)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
P.properFraction Double
a in Positive Int
-> Positive Double -> Quotient (Positive Int) (Positive Double)
forall w a. w -> a -> Quotient w a
Quotient (Int -> Positive Int
forall a. a -> Positive a
UnsafePositive Int
n) (Double -> Positive Double
forall a. a -> Positive a
UnsafePositive Double
r)
  fromWhole :: Whole (Positive Double) -> Positive Double
fromWhole (UnsafePositive Int
n) = Double -> Positive Double
forall a. a -> Positive a
UnsafePositive (Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral Int
n)
  ceiling :: Positive Double -> Whole (Positive Double)
ceiling = Positive Double
-> Quotient (Whole (Positive Double)) (Positive Double)
Positive Double -> Quotient (Positive Int) (Positive Double)
forall a. QuotientField a => a -> Quotient (Whole a) a
properFraction (Positive Double -> Quotient (Positive Int) (Positive Double))
-> (Quotient (Positive Int) (Positive Double) -> Positive Int)
-> Positive Double
-> Positive Int
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Quotient (Positive Int) (Positive Double) -> Positive Int
forall w a. Quotient w a -> w
whole (Quotient (Positive Int) (Positive Double) -> Positive Int)
-> (Positive Int -> Positive Int)
-> Quotient (Positive Int) (Positive Double)
-> Positive Int
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Positive Int -> Positive Int -> Positive Int
forall a. Additive a => a -> a -> a
+ Positive Int
forall a. Multiplicative a => a
one)
  floor :: Positive Double -> Whole (Positive Double)
floor = Positive Double
-> Quotient (Whole (Positive Double)) (Positive Double)
Positive Double -> Quotient (Positive Int) (Positive Double)
forall a. QuotientField a => a -> Quotient (Whole a) a
properFraction (Positive Double -> Quotient (Positive Int) (Positive Double))
-> (Quotient (Positive Int) (Positive Double) -> Positive Int)
-> Positive Double
-> Positive Int
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Quotient (Positive Int) (Positive Double) -> Positive Int
forall w a. Quotient w a -> w
whole
  truncate :: Positive Double -> Whole (Positive Double)
truncate = Positive Double -> Whole (Positive Double)
forall a. QuotientField a => a -> Whole a
floor
  round :: Positive Double -> Whole (Positive Double)
round Positive Double
x = case Positive Double
-> Quotient (Whole (Positive Double)) (Positive Double)
forall a. QuotientField a => a -> Quotient (Whole a) a
properFraction Positive Double
x of
    Quotient Whole (Positive Double)
n Positive Double
r ->
      let half_up :: Positive Double
half_up = Positive Double
r Positive Double -> Positive Double -> Positive Double
forall a. Additive a => a -> a -> a
+ Positive Double
forall a. (Additive a, Divisive a) => a
half
       in case Positive Double -> Positive Double -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare Positive Double
half_up Positive Double
forall a. Multiplicative a => a
one of
            Ordering
P.LT -> Whole (Positive Double)
n
            Ordering
P.EQ -> Positive Int -> Positive Int -> Bool -> Positive Int
forall a. a -> a -> Bool -> a
bool (Whole (Positive Double)
Positive Int
n Positive Int -> Positive Int -> Positive Int
forall a. Additive a => a -> a -> a
+ Positive Int
forall a. Multiplicative a => a
one) Whole (Positive Double)
Positive Int
n (Positive Int -> Bool
forall a. (Eq a, Integral a) => a -> Bool
even Whole (Positive Double)
Positive Int
n)
            Ordering
P.GT -> Whole (Positive Double)
Positive Int
n Positive Int -> Positive Int -> Positive Int
forall a. Additive a => a -> a -> a
+ Positive Int
forall a. Multiplicative a => a
one

-- | Constructor which returns zero for a negative number.
--
-- >>> positive (-1)
-- UnsafePositive {unPositive = 0}
positive :: (Additive a, JoinSemiLattice a) => a -> Positive a
positive :: forall a. (Additive a, JoinSemiLattice a) => a -> Positive a
positive a
a = a -> Positive a
forall a. a -> Positive a
UnsafePositive (a
a a -> a -> a
forall a. JoinSemiLattice a => a -> a -> a
\/ a
forall a. Additive a => a
zero)

-- | Unsafe constructor.
--
-- >>> positive_ (-one)
-- UnsafePositive {unPositive = -1}
positive_ :: a -> Positive a
positive_ :: forall a. a -> Positive a
positive_ = a -> Positive a
forall a. a -> Positive a
UnsafePositive

-- | Constructor which returns Nothing if a negative number is supplied.
--
-- >>> maybePositive (-one)
-- Nothing
maybePositive :: (Additive a, MeetSemiLattice a) => a -> Maybe (Positive a)
maybePositive :: forall a.
(Additive a, MeetSemiLattice a) =>
a -> Maybe (Positive a)
maybePositive a
a = Maybe (Positive a)
-> Maybe (Positive a) -> Bool -> Maybe (Positive a)
forall a. a -> a -> Bool -> a
bool Maybe (Positive a)
forall a. Maybe a
Nothing (Positive a -> Maybe (Positive a)
forall a. a -> Maybe a
Just (a -> Positive a
forall a. a -> Positive a
UnsafePositive a
a)) (a
forall a. Additive a => a
zero a -> a -> Bool
forall a. MeetSemiLattice a => a -> a -> Bool
`meetLeq` a
a)

instance (Subtractive a, JoinSemiLattice a) => Monus (Positive a) where
  (UnsafePositive a
a) ∸ :: Positive a -> Positive a -> Positive a
∸ (UnsafePositive a
b) = a -> Positive a
forall a. (Additive a, JoinSemiLattice a) => a -> Positive a
positive (a
a a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
b)

-- | A field but with truncated subtraction.
type MonusSemiField a = (Monus a, Distributive a, Divisive a)

-- | <https://en.wikipedia.org/wiki/Monus Monus> or truncated subtraction.
--
-- @since 0.12
--
-- >>> positive 4 ∸ positive 7
-- UnsafePositive {unPositive = 0}
--
-- >>> 4 ∸ 7 :: Positive Int
-- UnsafePositive {unPositive = 0}
class Monus a where
  {-# MINIMAL (∸) #-}

  infixl 6 ∸
  (∸) :: a -> a -> a
  default (∸) :: (LowerBounded a, Subtractive a) => a -> a -> a
  a
a ∸ a
b = a
forall a. LowerBounded a => a
bottom a -> a -> a
forall a. JoinSemiLattice a => a -> a -> a
\/ (a
a a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
b)

-- | A newtype wrapper intended for defining Monus instances by:
-- "x ∸ y = if x < y then zero else x - y"
newtype MonusFromOrd a = MonusFromOrd a
  deriving (MonusFromOrd a -> MonusFromOrd a -> Bool
(MonusFromOrd a -> MonusFromOrd a -> Bool)
-> (MonusFromOrd a -> MonusFromOrd a -> Bool)
-> Eq (MonusFromOrd a)
forall a. Eq a => MonusFromOrd a -> MonusFromOrd a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => MonusFromOrd a -> MonusFromOrd a -> Bool
== :: MonusFromOrd a -> MonusFromOrd a -> Bool
$c/= :: forall a. Eq a => MonusFromOrd a -> MonusFromOrd a -> Bool
/= :: MonusFromOrd a -> MonusFromOrd a -> Bool
Eq, Eq (MonusFromOrd a)
Eq (MonusFromOrd a) =>
(MonusFromOrd a -> MonusFromOrd a -> Ordering)
-> (MonusFromOrd a -> MonusFromOrd a -> Bool)
-> (MonusFromOrd a -> MonusFromOrd a -> Bool)
-> (MonusFromOrd a -> MonusFromOrd a -> Bool)
-> (MonusFromOrd a -> MonusFromOrd a -> Bool)
-> (MonusFromOrd a -> MonusFromOrd a -> MonusFromOrd a)
-> (MonusFromOrd a -> MonusFromOrd a -> MonusFromOrd a)
-> Ord (MonusFromOrd a)
MonusFromOrd a -> MonusFromOrd a -> Bool
MonusFromOrd a -> MonusFromOrd a -> Ordering
MonusFromOrd a -> MonusFromOrd a -> MonusFromOrd a
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
forall a. Ord a => Eq (MonusFromOrd a)
forall a. Ord a => MonusFromOrd a -> MonusFromOrd a -> Bool
forall a. Ord a => MonusFromOrd a -> MonusFromOrd a -> Ordering
forall a.
Ord a =>
MonusFromOrd a -> MonusFromOrd a -> MonusFromOrd a
$ccompare :: forall a. Ord a => MonusFromOrd a -> MonusFromOrd a -> Ordering
compare :: MonusFromOrd a -> MonusFromOrd a -> Ordering
$c< :: forall a. Ord a => MonusFromOrd a -> MonusFromOrd a -> Bool
< :: MonusFromOrd a -> MonusFromOrd a -> Bool
$c<= :: forall a. Ord a => MonusFromOrd a -> MonusFromOrd a -> Bool
<= :: MonusFromOrd a -> MonusFromOrd a -> Bool
$c> :: forall a. Ord a => MonusFromOrd a -> MonusFromOrd a -> Bool
> :: MonusFromOrd a -> MonusFromOrd a -> Bool
$c>= :: forall a. Ord a => MonusFromOrd a -> MonusFromOrd a -> Bool
>= :: MonusFromOrd a -> MonusFromOrd a -> Bool
$cmax :: forall a.
Ord a =>
MonusFromOrd a -> MonusFromOrd a -> MonusFromOrd a
max :: MonusFromOrd a -> MonusFromOrd a -> MonusFromOrd a
$cmin :: forall a.
Ord a =>
MonusFromOrd a -> MonusFromOrd a -> MonusFromOrd a
min :: MonusFromOrd a -> MonusFromOrd a -> MonusFromOrd a
Ord, MonusFromOrd a
MonusFromOrd a -> MonusFromOrd a -> MonusFromOrd a
(MonusFromOrd a -> MonusFromOrd a -> MonusFromOrd a)
-> MonusFromOrd a -> Additive (MonusFromOrd a)
forall a. Additive a => MonusFromOrd a
forall a.
Additive a =>
MonusFromOrd a -> MonusFromOrd a -> MonusFromOrd a
forall a. (a -> a -> a) -> a -> Additive a
$c+ :: forall a.
Additive a =>
MonusFromOrd a -> MonusFromOrd a -> MonusFromOrd a
+ :: MonusFromOrd a -> MonusFromOrd a -> MonusFromOrd a
$czero :: forall a. Additive a => MonusFromOrd a
zero :: MonusFromOrd a
Additive, Additive (MonusFromOrd a)
Additive (MonusFromOrd a) =>
(MonusFromOrd a -> MonusFromOrd a)
-> (MonusFromOrd a -> MonusFromOrd a -> MonusFromOrd a)
-> Subtractive (MonusFromOrd a)
MonusFromOrd a -> MonusFromOrd a
MonusFromOrd a -> MonusFromOrd a -> MonusFromOrd a
forall a. Additive a => (a -> a) -> (a -> a -> a) -> Subtractive a
forall a. Subtractive a => Additive (MonusFromOrd a)
forall a. Subtractive a => MonusFromOrd a -> MonusFromOrd a
forall a.
Subtractive a =>
MonusFromOrd a -> MonusFromOrd a -> MonusFromOrd a
$cnegate :: forall a. Subtractive a => MonusFromOrd a -> MonusFromOrd a
negate :: MonusFromOrd a -> MonusFromOrd a
$c- :: forall a.
Subtractive a =>
MonusFromOrd a -> MonusFromOrd a -> MonusFromOrd a
- :: MonusFromOrd a -> MonusFromOrd a -> MonusFromOrd a
Subtractive)

instance (Ord a, Subtractive a) => Monus (MonusFromOrd a) where
  MonusFromOrd a
x ∸ :: MonusFromOrd a -> MonusFromOrd a -> MonusFromOrd a
∸ MonusFromOrd a
y
    | MonusFromOrd a
x MonusFromOrd a -> MonusFromOrd a -> Bool
forall a. Ord a => a -> a -> Bool
P.< MonusFromOrd a
y = MonusFromOrd a
forall a. Additive a => a
zero
    | Bool
P.otherwise = MonusFromOrd a
x MonusFromOrd a -> MonusFromOrd a -> MonusFromOrd a
forall a. Subtractive a => a -> a -> a
- MonusFromOrd a
y

-- | It appears that Haskell doesn't have any built in truncated
-- subtraction operation for Word
deriving via MonusFromOrd P.Word instance Monus P.Word

instance Monus Natural where
  Natural
x ∸ :: Natural -> Natural -> Natural
∸ Natural
y = Natural -> Maybe Natural -> Natural
forall a. a -> Maybe a -> a
fromMaybe Natural
0 (Natural -> Natural -> Maybe Natural
minusNaturalMaybe Natural
x Natural
y)

-- | Truncated addition
--
-- @since 0.12
class Addus a where
  {-# MINIMAL (∔) #-}
  infixl 6 ∔
  (∔) :: a -> a -> a
  default (∔) :: (UpperBounded a, JoinSemiLattice a, Additive a) => a -> a -> a
  a
a ∔ a
b = a
forall a. UpperBounded a => a
top a -> a -> a
forall a. JoinSemiLattice a => a -> a -> a
\/ (a
a a -> a -> a
forall a. Additive a => a -> a -> a
+ a
b)