| Safe Haskell | Safe-Inferred |
|---|---|
| Language | GHC2021 |
NumHask.Data.Positive
Description
A positive number type, defined as existing on [zero, +infinity)
Synopsis
- newtype Positive a = UnsafePositive {
- unPositive :: a
- positive :: (Additive a, MeetSemiLattice a) => a -> Positive a
- maybePositive :: (Additive a, MeetSemiLattice a) => a -> Maybe (Positive a)
- positive_ :: a -> Positive a
- class Monus a where
- (∸) :: a -> a -> a
- class Addus a where
- (∔) :: a -> a -> a
- type MonusSemiField a = (Monus a, Distributive a, Divisive a)
Documentation
A positive number is a number that is contained in [zero,+infinity).
>>>1 :: Positive IntUnsafePositive {unPositive = 1}
>>>-1 :: Positive Int... • No instance for ‘Subtractive (Positive Int)’ arising from a use of syntactic negation ...
zero is positive
>>>positive 0 == zeroTrue
The main constructors:
>>>positive (-1)UnsafePositive {unPositive = 0}
>>>maybePositive (-1)Nothing
>>>UnsafePositive (-1)UnsafePositive {unPositive = -1}
Constructors
| UnsafePositive | |
Fields
| |
Instances
positive :: (Additive a, MeetSemiLattice a) => a -> Positive a Source #
Constructor which returns zero for a negative number.
>>>positive (-1)UnsafePositive {unPositive = 0}
maybePositive :: (Additive a, MeetSemiLattice a) => a -> Maybe (Positive a) Source #
Constructor which returns Nothing if a negative number is supplied.
>>>maybePositive (-one)Nothing
positive_ :: a -> Positive a Source #
Unsafe constructor.
>>>positive_ (-one)UnsafePositive {unPositive = -1}
Monus or truncated subtraction.
>>>positive 4 ∸ positive 7UnsafePositive {unPositive = 0}
>>>4 ∸ 7 :: Positive IntUnsafePositive {unPositive = 0}
Since: 0.12
Minimal complete definition
Methods
(∸) :: a -> a -> a infixl 6 Source #
default (∸) :: (BoundedJoinSemiLattice a, MeetSemiLattice a, Subtractive a) => a -> a -> a Source #
Instances
| (Subtractive a, MeetSemiLattice a) => Monus (Positive a) Source # | |
Truncated addition
Since: 0.12
Minimal complete definition
Methods
(∔) :: a -> a -> a infixl 6 Source #
default (∔) :: (BoundedMeetSemiLattice a, JoinSemiLattice a, Additive a) => a -> a -> a Source #
type MonusSemiField a = (Monus a, Distributive a, Divisive a) Source #
A field but with truncated subtraction.