module Numeric.Data.Positive
(
Positive (MkPositive),
mkPositiveTH,
mkPositive,
Internal.unsafePositive,
(+!),
reallyUnsafePositive,
unPositive,
positiveToNonZero,
_MkPositive,
rmatching,
)
where
import GHC.Stack (HasCallStack)
import Language.Haskell.TH (Code, Q)
import Language.Haskell.TH.Syntax (Lift (liftTyped))
import Numeric.Algebra.Additive.AMonoid (AMonoid (zero))
import Numeric.Data.NonZero (NonZero, reallyUnsafeNonZero, rmatching)
import Numeric.Data.Positive.Internal (Positive (MkPositive, UnsafePositive))
import Numeric.Data.Positive.Internal qualified as Internal
import Optics.Core
( ReversedPrism',
ReversibleOptic (re),
prism,
)
mkPositiveTH :: (AMonoid a, Lift a, Ord a, Show a) => a -> Code Q (Positive a)
mkPositiveTH :: forall a.
(AMonoid a, Lift a, Ord a, Show a) =>
a -> Code Q (Positive a)
mkPositiveTH a
x = Code Q (Positive a)
-> (Positive a -> Code Q (Positive a))
-> Maybe (Positive a)
-> Code Q (Positive a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Code Q (Positive a)
forall a. HasCallStack => [Char] -> a
error [Char]
err) Positive a -> Code Q (Positive a)
forall t (m :: Type -> Type). (Lift t, Quote m) => t -> Code m t
forall (m :: Type -> Type).
Quote m =>
Positive a -> Code m (Positive a)
liftTyped (Maybe (Positive a) -> Code Q (Positive a))
-> Maybe (Positive a) -> Code Q (Positive a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe (Positive a)
forall a. (AMonoid a, Ord a) => a -> Maybe (Positive a)
mkPositive a
x
where
err :: [Char]
err = [Char] -> a -> [Char]
forall a. Show a => [Char] -> a -> [Char]
Internal.errMsg [Char]
"mkPositiveTH" a
x
{-# INLINEABLE mkPositiveTH #-}
mkPositive :: (AMonoid a, Ord a) => a -> Maybe (Positive a)
mkPositive :: forall a. (AMonoid a, Ord a) => a -> Maybe (Positive a)
mkPositive a
x
| a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
forall m. AMonoid m => m
zero = Positive a -> Maybe (Positive a)
forall a. a -> Maybe a
Just (a -> Positive a
forall a. a -> Positive a
UnsafePositive a
x)
| Bool
otherwise = Maybe (Positive a)
forall a. Maybe a
Nothing
{-# INLINEABLE mkPositive #-}
(+!) :: (AMonoid a, HasCallStack, Ord a, Show a) => a -> Positive a
+! :: forall a.
(AMonoid a, HasCallStack, Ord a, Show a) =>
a -> Positive a
(+!) = a -> Positive a
forall a.
(AMonoid a, HasCallStack, Ord a, Show a) =>
a -> Positive a
Internal.unsafePositive
{-# INLINE (+!) #-}
infixl 7 +!
reallyUnsafePositive :: a -> Positive a
reallyUnsafePositive :: forall a. a -> Positive a
reallyUnsafePositive = a -> Positive a
forall a. a -> Positive a
UnsafePositive
{-# INLINEABLE reallyUnsafePositive #-}
positiveToNonZero :: Positive a -> NonZero (Positive a)
positiveToNonZero :: forall a. Positive a -> NonZero (Positive a)
positiveToNonZero = Positive a -> NonZero (Positive a)
forall a. a -> NonZero a
reallyUnsafeNonZero
{-# INLINEABLE positiveToNonZero #-}
unPositive :: Positive a -> a
unPositive :: forall a. Positive a -> a
unPositive (UnsafePositive a
x) = a
x
{-# INLINE unPositive #-}
_MkPositive :: (AMonoid a, Ord a) => ReversedPrism' (Positive a) a
_MkPositive :: forall a. (AMonoid a, Ord a) => ReversedPrism' (Positive a) a
_MkPositive = Optic A_Prism NoIx a a (Positive a) (Positive a)
-> Optic (ReversedOptic A_Prism) NoIx (Positive a) (Positive a) a a
forall (is :: IxList) s t a b.
AcceptsEmptyIndices "re" is =>
Optic A_Prism is s t a b
-> Optic (ReversedOptic A_Prism) is b a t s
forall k (is :: IxList) s t a b.
(ReversibleOptic k, AcceptsEmptyIndices "re" is) =>
Optic k is s t a b -> Optic (ReversedOptic k) is b a t s
re ((Positive a -> a)
-> (a -> Either a (Positive a))
-> Optic A_Prism NoIx a a (Positive a) (Positive a)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism Positive a -> a
forall a. Positive a -> a
unPositive a -> Either a (Positive a)
forall {a}. (AMonoid a, Ord a) => a -> Either a (Positive a)
g)
where
g :: a -> Either a (Positive a)
g a
x = case a -> Maybe (Positive a)
forall a. (AMonoid a, Ord a) => a -> Maybe (Positive a)
mkPositive a
x of
Maybe (Positive a)
Nothing -> a -> Either a (Positive a)
forall a b. a -> Either a b
Left a
x
Just Positive a
x' -> Positive a -> Either a (Positive a)
forall a b. b -> Either a b
Right Positive a
x'
{-# INLINEABLE _MkPositive #-}