{-# LANGUAGE UndecidableInstances #-}
module Numeric.Data.Positive.Internal
(
Positive (MkPositive, UnsafePositive),
unsafePositive,
errMsg,
)
where
import Control.DeepSeq (NFData)
import Data.Bifunctor (Bifunctor (bimap))
import Data.Bounds (UpperBounded (upperBound), UpperBoundless)
import Data.Kind (Type)
import Data.Text.Display (Display, ShowInstance (ShowInstance))
import GHC.Generics (Generic)
import GHC.Records (HasField (getField))
import GHC.Stack (HasCallStack)
import Language.Haskell.TH.Syntax (Lift)
import Numeric.Algebra.Additive.ASemigroup (ASemigroup ((.+.)))
import Numeric.Algebra.Multiplicative.MEuclidean (MEuclidean (mdivMod))
import Numeric.Algebra.Multiplicative.MGroup (MGroup ((.%.)))
import Numeric.Algebra.Multiplicative.MMonoid (MMonoid (one))
import Numeric.Algebra.Multiplicative.MSemigroup (MSemigroup ((.*.)))
import Numeric.Algebra.Normed (Normed (norm))
import Numeric.Class.Division (Division (divide))
import Numeric.Literal.Integer (FromInteger (afromInteger))
import Numeric.Literal.Rational (FromRational (afromRational))
import Optics.Core (A_Getter, LabelOptic (labelOptic), to)
type Positive :: Type -> Type
newtype Positive a = UnsafePositive 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,
(forall x. Positive a -> Rep (Positive a) x)
-> (forall x. Rep (Positive a) x -> Positive a)
-> Generic (Positive a)
forall x. Rep (Positive a) x -> Positive a
forall x. Positive a -> Rep (Positive a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Positive a) x -> Positive a
forall a x. Positive a -> Rep (Positive a) x
$cfrom :: forall a x. Positive a -> Rep (Positive a) x
from :: forall x. Positive a -> Rep (Positive a) x
$cto :: forall a x. Rep (Positive a) x -> Positive a
to :: forall x. Rep (Positive a) x -> Positive a
Generic,
(forall (m :: Type -> Type). Quote m => Positive a -> m Exp)
-> (forall (m :: Type -> Type).
Quote m =>
Positive a -> Code m (Positive a))
-> Lift (Positive a)
forall a (m :: Type -> Type).
(Lift a, Quote m) =>
Positive a -> m Exp
forall a (m :: Type -> Type).
(Lift a, Quote m) =>
Positive a -> Code m (Positive a)
forall t.
(forall (m :: Type -> Type). Quote m => t -> m Exp)
-> (forall (m :: Type -> Type). Quote m => t -> Code m t) -> Lift t
forall (m :: Type -> Type). Quote m => Positive a -> m Exp
forall (m :: Type -> Type).
Quote m =>
Positive a -> Code m (Positive a)
$clift :: forall a (m :: Type -> Type).
(Lift a, Quote m) =>
Positive a -> m Exp
lift :: forall (m :: Type -> Type). Quote m => Positive a -> m Exp
$cliftTyped :: forall a (m :: Type -> Type).
(Lift a, Quote m) =>
Positive a -> Code m (Positive a)
liftTyped :: forall (m :: Type -> Type).
Quote m =>
Positive a -> Code m (Positive a)
Lift,
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 anyclass
(
Positive a -> ()
(Positive a -> ()) -> NFData (Positive a)
forall a. NFData a => Positive a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => Positive a -> ()
rnf :: Positive a -> ()
NFData,
UpperBoundless (Positive a)
forall a. UpperBoundless a
UpperBoundless
)
deriving
(
Int -> Positive a -> Builder
[Positive a] -> Builder
Positive a -> Builder
(Positive a -> Builder)
-> ([Positive a] -> Builder)
-> (Int -> Positive a -> Builder)
-> Display (Positive a)
forall a. Show a => Int -> Positive a -> Builder
forall a. Show a => [Positive a] -> Builder
forall a. Show a => Positive a -> Builder
forall a.
(a -> Builder)
-> ([a] -> Builder) -> (Int -> a -> Builder) -> Display a
$cdisplayBuilder :: forall a. Show a => Positive a -> Builder
displayBuilder :: Positive a -> Builder
$cdisplayList :: forall a. Show a => [Positive a] -> Builder
displayList :: [Positive a] -> Builder
$cdisplayPrec :: forall a. Show a => Int -> Positive a -> Builder
displayPrec :: Int -> Positive a -> Builder
Display
)
via (ShowInstance a)
instance HasField "unPositive" (Positive a) a where
getField :: Positive a -> a
getField (UnsafePositive a
x) = a
x
instance
( k ~ A_Getter,
x ~ a,
y ~ a
) =>
LabelOptic "unPositive" k (Positive a) (Positive a) x y
where
labelOptic :: Optic k NoIx (Positive a) (Positive a) x y
labelOptic = (Positive a -> x) -> Getter (Positive a) x
forall s a. (s -> a) -> Getter s a
to (\(UnsafePositive a
x) -> x
a
x)
{-# INLINE labelOptic #-}
pattern MkPositive :: a -> Positive a
pattern $mMkPositive :: forall {r} {a}. Positive a -> (a -> r) -> ((# #) -> r) -> r
MkPositive x <- UnsafePositive x
{-# COMPLETE MkPositive #-}
instance (Bounded a) => UpperBounded (Positive a) where
upperBound :: Positive a
upperBound = a -> Positive a
forall a. a -> Positive a
UnsafePositive a
forall a. Bounded a => a
maxBound
{-# INLINEABLE upperBound #-}
instance (Num a) => ASemigroup (Positive a) where
UnsafePositive a
x .+. :: Positive a -> Positive a -> Positive a
.+. UnsafePositive a
y = a -> Positive a
forall a. a -> Positive a
UnsafePositive (a -> Positive a) -> a -> Positive a
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
y
{-# INLINEABLE (.+.) #-}
instance (Num a) => MSemigroup (Positive a) where
UnsafePositive a
x .*. :: Positive a -> Positive a -> Positive a
.*. UnsafePositive a
y = a -> Positive a
forall a. a -> Positive a
UnsafePositive (a -> Positive a) -> a -> Positive a
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
y
{-# INLINEABLE (.*.) #-}
instance (Num a) => MMonoid (Positive a) where
one :: Positive a
one = a -> Positive a
forall a. a -> Positive a
UnsafePositive a
1
{-# INLINEABLE one #-}
instance (Division a, Num a) => MGroup (Positive a) where
UnsafePositive a
x .%. :: Positive a -> Positive a -> Positive a
.%. (UnsafePositive a
d) = a -> Positive a
forall a. a -> Positive a
UnsafePositive (a -> Positive a) -> a -> Positive a
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> a
forall a. Division a => a -> a -> a
`divide` a
d
{-# INLINEABLE (.%.) #-}
instance (Division a, Integral a) => MEuclidean (Positive a) where
UnsafePositive a
x mdivMod :: Positive a -> Positive a -> (Positive a, Positive a)
`mdivMod` (UnsafePositive a
d) =
(a -> Positive a)
-> (a -> Positive a) -> (a, a) -> (Positive a, Positive a)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: Type -> Type -> Type) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> Positive a
forall a. a -> Positive a
UnsafePositive a -> Positive a
forall a. a -> Positive a
UnsafePositive ((a, a) -> (Positive a, Positive a))
-> (a, a) -> (Positive a, Positive a)
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`divMod` a
d
{-# INLINEABLE mdivMod #-}
instance Normed (Positive a) where
norm :: Positive a -> Positive a
norm = Positive a -> Positive a
forall a. a -> a
id
{-# INLINEABLE norm #-}
instance (Num a, Ord a, Show a) => FromInteger (Positive a) where
afromInteger :: HasCallStack => Integer -> Positive a
afromInteger = a -> Positive a
forall a. (HasCallStack, Num a, Ord a, Show a) => a -> Positive a
unsafePositive (a -> Positive a) -> (Integer -> a) -> Integer -> Positive a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger
{-# INLINEABLE afromInteger #-}
instance (Fractional a, Ord a, Show a) => FromRational (Positive a) where
afromRational :: HasCallStack => Rational -> Positive a
afromRational = a -> Positive a
forall a. (HasCallStack, Num a, Ord a, Show a) => a -> Positive a
unsafePositive (a -> Positive a) -> (Rational -> a) -> Rational -> Positive a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
fromRational
{-# INLINEABLE afromRational #-}
unsafePositive :: (HasCallStack, Num a, Ord a, Show a) => a -> Positive a
unsafePositive :: forall a. (HasCallStack, Num a, Ord a, Show a) => a -> Positive a
unsafePositive a
x
| a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 = a -> Positive a
forall a. a -> Positive a
UnsafePositive a
x
| Bool
otherwise =
String -> Positive a
forall a. HasCallStack => String -> a
error (String -> Positive a) -> String -> Positive a
forall a b. (a -> b) -> a -> b
$
String -> a -> String
forall a. Show a => String -> a -> String
errMsg String
"unsafePositive" a
x
{-# INLINEABLE unsafePositive #-}
errMsg :: (Show a) => String -> a -> String
errMsg :: forall a. Show a => String -> a -> String
errMsg String
fn a
x =
[String] -> String
forall a. Monoid a => [a] -> a
mconcat
[ String
"Numeric.Data.Positive.",
String
fn,
String
": Received value <= zero: ",
a -> String
forall a. Show a => a -> String
show a
x
]