module Numeric.Data.Positive
(
Positive (MkPositive),
mkPositiveTH,
mkPositive,
Internal.unsafePositive,
(+!),
reallyUnsafePositive,
unPositive,
positiveToNonZero,
_MkPositive,
rmatching,
)
where
import Data.Bifunctor (Bifunctor (first))
import GHC.Stack (HasCallStack)
import Language.Haskell.TH (Code, Q)
import Language.Haskell.TH.Syntax (Lift)
import Numeric.Algebra.Additive.AMonoid (AMonoid (zero))
import Numeric.Data.Internal.Utils qualified as Utils
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 = Either String (Positive a) -> Code Q (Positive a)
forall a. Lift a => Either String a -> Code Q a
Utils.liftErrorTH (Either String (Positive a) -> Code Q (Positive a))
-> (a -> Either String (Positive a)) -> a -> Code Q (Positive a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either String (Positive a)
forall a.
(AMonoid a, Ord a, Show a) =>
a -> Either String (Positive a)
mkPositive
{-# INLINEABLE mkPositiveTH #-}
mkPositive :: (AMonoid a, Ord a, Show a) => a -> Either String (Positive a)
mkPositive :: forall a.
(AMonoid a, Ord a, Show a) =>
a -> Either String (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 -> Either String (Positive a)
forall a b. b -> Either a b
Right (a -> Positive a
forall a. a -> Positive a
UnsafePositive a
x)
| Bool
otherwise = String -> Either String (Positive a)
forall a b. a -> Either a b
Left (String -> Either String (Positive a))
-> String -> Either String (Positive a)
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
Internal.errMsg a
x
{-# 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, Show a) => ReversedPrism' (Positive a) a
_MkPositive :: forall a.
(AMonoid a, Ord a, Show 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 {b}.
(AMonoid b, Ord b, Show b) =>
b -> Either b (Positive b)
g)
where
g :: b -> Either b (Positive b)
g b
x = (String -> b)
-> Either String (Positive b) -> Either b (Positive b)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (b -> String -> b
forall a b. a -> b -> a
const b
x) (Either String (Positive b) -> Either b (Positive b))
-> (b -> Either String (Positive b)) -> b -> Either b (Positive b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either String (Positive b)
forall a.
(AMonoid a, Ord a, Show a) =>
a -> Either String (Positive a)
mkPositive (b -> Either b (Positive b)) -> b -> Either b (Positive b)
forall a b. (a -> b) -> a -> b
$ b
x
{-# INLINEABLE _MkPositive #-}