-- | Provides the 'NonNegative' type for enforcing a nonnegative invariant.
--
--
-- @since 0.1
module Numeric.Data.NonNegative
  ( -- * Type
    NonNegative (MkNonNegative),

    -- * Creation
    mkNonNegativeTH,
    mkNonNegative,
    Internal.unsafeNonNegative,
    (*!),
    reallyUnsafeNonNegative,

    -- * Elimination
    unNonNegative,

    -- * Optics
    -- $optics
    _MkNonNegative,
    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 (AMonoid (zero))
import Numeric.Data.Internal.Utils (rmatching)
import Numeric.Data.Internal.Utils qualified as Utils
import Numeric.Data.NonNegative.Internal
  ( NonNegative
      ( MkNonNegative,
        UnsafeNonNegative
      ),
  )
import Numeric.Data.NonNegative.Internal qualified as Internal
import Optics.Core (ReversedPrism', ReversibleOptic (re), prism)

-- $setup
-- >>> :set -XTemplateHaskell
-- >>> :set -XPostfixOperators

-- | Template haskell for creating a 'NonNegative' at compile-time.
--
-- ==== __Examples__
-- >>> $$(mkNonNegativeTH 1)
-- UnsafeNonNegative 1
--
-- @since 0.1
mkNonNegativeTH :: (AMonoid a, Lift a, Ord a, Show a) => a -> Code Q (NonNegative a)
mkNonNegativeTH :: forall a.
(AMonoid a, Lift a, Ord a, Show a) =>
a -> Code Q (NonNegative a)
mkNonNegativeTH = Either String (NonNegative a) -> Code Q (NonNegative a)
forall a. Lift a => Either String a -> Code Q a
Utils.liftErrorTH (Either String (NonNegative a) -> Code Q (NonNegative a))
-> (a -> Either String (NonNegative a))
-> a
-> Code Q (NonNegative a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either String (NonNegative a)
forall a.
(AMonoid a, Ord a, Show a) =>
a -> Either String (NonNegative a)
mkNonNegative
{-# INLINEABLE mkNonNegativeTH #-}

-- | Smart constructor for 'NonNegative'. Returns 'Nothing' if the second
-- parameter is @< 0@.
--
-- ==== __Examples__
-- >>> mkNonNegative 0
-- Right (UnsafeNonNegative 0)
--
-- >>> mkNonNegative (-2)
-- Left "Numeric.Data.NonNegative: Received value < zero: -2"
--
-- @since 0.1
mkNonNegative :: (AMonoid a, Ord a, Show a) => a -> Either String (NonNegative a)
mkNonNegative :: forall a.
(AMonoid a, Ord a, Show a) =>
a -> Either String (NonNegative a)
mkNonNegative a
x
  | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
forall m. AMonoid m => m
zero = NonNegative a -> Either String (NonNegative a)
forall a b. b -> Either a b
Right (a -> NonNegative a
forall a. a -> NonNegative a
UnsafeNonNegative a
x)
  | Bool
otherwise = String -> Either String (NonNegative a)
forall a b. a -> Either a b
Left (String -> Either String (NonNegative a))
-> String -> Either String (NonNegative a)
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
Internal.errMsg a
x
{-# INLINEABLE mkNonNegative #-}

-- | Postfix operator for 'Internal.unsafeNonNegative'.
--
-- __WARNING: Partial__
--
-- ==== __Examples__
--
-- >>> (7 *!)
-- UnsafeNonNegative 7
--
-- @since 0.1
(*!) :: (AMonoid a, HasCallStack, Ord a, Show a) => a -> NonNegative a
*! :: forall a.
(AMonoid a, HasCallStack, Ord a, Show a) =>
a -> NonNegative a
(*!) = a -> NonNegative a
forall a.
(AMonoid a, HasCallStack, Ord a, Show a) =>
a -> NonNegative a
Internal.unsafeNonNegative
{-# INLINE (*!) #-}

infixl 7 *!

-- | This function is an alias for the unchecked constructor @UnsafeNonNegative@
-- i.e. it allows us to construct a 'NonNegative' __without__ checking the
-- invariant. This is intended only for when we absolutely know the invariant
-- holds and a branch (i.e. 'Internal.unsafeNonNegative') is undesirable for
-- performance reasons. Exercise extreme caution.
--
-- @since 0.1
reallyUnsafeNonNegative :: a -> NonNegative a
reallyUnsafeNonNegative :: forall a. a -> NonNegative a
reallyUnsafeNonNegative = a -> NonNegative a
forall a. a -> NonNegative a
UnsafeNonNegative
{-# INLINEABLE reallyUnsafeNonNegative #-}

-- | @since 0.1
unNonNegative :: NonNegative a -> a
unNonNegative :: forall a. NonNegative a -> a
unNonNegative (UnsafeNonNegative a
x) = a
x
{-# INLINE unNonNegative #-}

-- $optics
-- We provide a 'ReversedPrism'' '_MkNonNegative' that allows for total
-- elimination and partial construction, along with a 'Optics.Core.LabelOptic' 'Optics.Core.Getter'
-- for @#unNonNegative@.
--
-- ==== __Examples__
--
-- >>> :set -XOverloadedLabels
-- >>> import Optics.Core (view)
-- >>> let n = $$(mkNonNegativeTH 2)
-- >>> view #unNonNegative n
-- 2

-- | 'ReversedPrism'' that enables total elimination and partial construction.
--
-- ==== __Examples__
-- >>> import Optics.Core (view)
-- >>> nn = $$(mkNonNegativeTH 2)
-- >>> view _MkNonNegative nn
-- 2
--
-- >>> rmatching _MkNonNegative 3
-- Right (UnsafeNonNegative 3)
--
-- >>> rmatching _MkNonNegative (-2)
-- Left (-2)
--
-- @since 0.1
_MkNonNegative :: forall a. (AMonoid a, Ord a, Show a) => ReversedPrism' (NonNegative a) a
_MkNonNegative :: forall a.
(AMonoid a, Ord a, Show 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 {b}.
(AMonoid b, Ord b, Show b) =>
b -> Either b (NonNegative b)
g)
  where
    g :: b -> Either b (NonNegative b)
g b
x = (String -> b)
-> Either String (NonNegative b) -> Either b (NonNegative 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 (NonNegative b) -> Either b (NonNegative b))
-> (b -> Either String (NonNegative b))
-> b
-> Either b (NonNegative b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either String (NonNegative b)
forall a.
(AMonoid a, Ord a, Show a) =>
a -> Either String (NonNegative a)
mkNonNegative (b -> Either b (NonNegative b)) -> b -> Either b (NonNegative b)
forall a b. (a -> b) -> a -> b
$ b
x
{-# INLINEABLE _MkNonNegative #-}