module Numeric.Data.NonNegative
(
NonNegative (MkNonNegative),
mkNonNegativeTH,
mkNonNegative,
Internal.unsafeNonNegative,
(*!),
reallyUnsafeNonNegative,
unNonNegative,
_MkNonNegative,
rmatching,
)
where
import GHC.Stack (HasCallStack)
import Language.Haskell.TH (Code, Q)
import Language.Haskell.TH.Syntax (Lift (liftTyped))
import Numeric.Data.Internal.Utils (rmatching)
import Numeric.Data.NonNegative.Internal
( NonNegative
( MkNonNegative,
UnsafeNonNegative
),
)
import Numeric.Data.NonNegative.Internal qualified as Internal
import Optics.Core (ReversedPrism', ReversibleOptic (re), prism)
mkNonNegativeTH :: (Integral a, Lift a, Show a) => a -> Code Q (NonNegative a)
mkNonNegativeTH :: forall a.
(Integral a, Lift a, Show a) =>
a -> Code Q (NonNegative a)
mkNonNegativeTH a
x = Code Q (NonNegative a)
-> (NonNegative a -> Code Q (NonNegative a))
-> Maybe (NonNegative a)
-> Code Q (NonNegative a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Code Q (NonNegative a)
forall a. HasCallStack => [Char] -> a
error [Char]
err) NonNegative a -> Code Q (NonNegative a)
forall t (m :: Type -> Type). (Lift t, Quote m) => t -> Code m t
forall (m :: Type -> Type).
Quote m =>
NonNegative a -> Code m (NonNegative a)
liftTyped (Maybe (NonNegative a) -> Code Q (NonNegative a))
-> Maybe (NonNegative a) -> Code Q (NonNegative a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe (NonNegative a)
forall a. (Num a, Ord a) => a -> Maybe (NonNegative a)
mkNonNegative a
x
where
err :: [Char]
err = [Char] -> a -> [Char]
forall a. Show a => [Char] -> a -> [Char]
Internal.errMsg [Char]
"mkNonNegativeTH" a
x
{-# INLINEABLE mkNonNegativeTH #-}
mkNonNegative :: (Num a, Ord a) => a -> Maybe (NonNegative a)
mkNonNegative :: forall a. (Num a, Ord a) => a -> Maybe (NonNegative a)
mkNonNegative a
x
| a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0 = NonNegative a -> Maybe (NonNegative a)
forall a. a -> Maybe a
Just (a -> NonNegative a
forall a. a -> NonNegative a
UnsafeNonNegative a
x)
| Bool
otherwise = Maybe (NonNegative a)
forall a. Maybe a
Nothing
{-# INLINEABLE mkNonNegative #-}
(*!) :: (HasCallStack, Num a, Ord a, Show a) => a -> NonNegative a
*! :: forall a.
(HasCallStack, Num a, Ord a, Show a) =>
a -> NonNegative a
(*!) = a -> NonNegative a
forall a.
(HasCallStack, Num a, Ord a, Show a) =>
a -> NonNegative a
Internal.unsafeNonNegative
{-# INLINE (*!) #-}
infixl 7 *!
reallyUnsafeNonNegative :: a -> NonNegative a
reallyUnsafeNonNegative :: forall a. a -> NonNegative a
reallyUnsafeNonNegative = a -> NonNegative a
forall a. a -> NonNegative a
UnsafeNonNegative
{-# INLINEABLE reallyUnsafeNonNegative #-}
unNonNegative :: NonNegative a -> a
unNonNegative :: forall a. NonNegative a -> a
unNonNegative (UnsafeNonNegative a
x) = a
x
{-# INLINE unNonNegative #-}
_MkNonNegative :: (Num a, Ord a) => ReversedPrism' (NonNegative a) a
_MkNonNegative :: forall a. (Num a, Ord a) => ReversedPrism' (NonNegative a) a
_MkNonNegative = Optic A_Prism NoIx a a (NonNegative a) (NonNegative a)
-> Optic
(ReversedOptic A_Prism) NoIx (NonNegative a) (NonNegative 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 ((NonNegative a -> a)
-> (a -> Either a (NonNegative a))
-> Optic A_Prism NoIx a a (NonNegative a) (NonNegative a)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism NonNegative a -> a
forall a. NonNegative a -> a
unNonNegative a -> Either a (NonNegative a)
forall {a}. (Num a, Ord a) => a -> Either a (NonNegative a)
g)
where
g :: a -> Either a (NonNegative a)
g a
x = case a -> Maybe (NonNegative a)
forall a. (Num a, Ord a) => a -> Maybe (NonNegative a)
mkNonNegative a
x of
Maybe (NonNegative a)
Nothing -> a -> Either a (NonNegative a)
forall a b. a -> Either a b
Left a
x
Just NonNegative a
x' -> NonNegative a -> Either a (NonNegative a)
forall a b. b -> Either a b
Right NonNegative a
x'
{-# INLINEABLE _MkNonNegative #-}