-- | Provides the 'Positive' type for enforcing a positive invariant.
--
-- @since 0.1
module Numeric.Data.Positive
  ( -- * Type
    Positive (MkPositive),

    -- * Creation
    mkPositiveTH,
    mkPositive,
    Internal.unsafePositive,
    (+!),
    reallyUnsafePositive,

    -- * Elimination
    unPositive,

    -- * Functions
    positiveToNonZero,

    -- * Optics
    -- $optics
    _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,
  )

-- $setup
-- >>> :set -XTemplateHaskell
-- >>> :set -XPostfixOperators
-- >>> import Numeric.Data.Positive.Internal (unsafePositive)

-- | Template haskell for creating a 'Positive' at compile-time.
--
-- ==== __Examples__
-- >>> $$(mkPositiveTH 1)
-- UnsafePositive 1
--
-- @since 0.1
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 #-}

-- | Smart constructor for 'Positive'. Returns 'Nothing' if the second
-- parameter is @<= 0@.
--
-- ==== __Examples__
-- >>> mkPositive 7
-- Right (UnsafePositive 7)
--
-- >>> mkPositive 0
-- Left "Numeric.Data.Positive: Received value <= zero: 0"
--
-- @since 0.1
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 #-}

-- | Postfix operator for 'Internal.unsafePositive'.
--
-- __WARNING: Partial__
--
-- ==== __Examples__
--
-- >>> (7 +!)
-- UnsafePositive 7
--
-- @since 0.1
(+!) :: (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 +!

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

-- | Convenience function for adding a 'NonZero' proof to our 'Positive'.
--
-- ==== __Examples__
-- >>> positiveToNonZero $ unsafePositive 3
-- UnsafeNonZero (UnsafePositive 3)
--
-- @since 0.1
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 #-}

-- | @since 0.1
unPositive :: Positive a -> a
unPositive :: forall a. Positive a -> a
unPositive (UnsafePositive a
x) = a
x
{-# INLINE unPositive #-}

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

-- | 'ReversedPrism'' that enables total elimination and partial construction.
--
-- ==== __Examples__
-- >>> import Optics.Core (view)
-- >>> pos = $$(mkPositiveTH 2)
-- >>> view _MkPositive pos
-- 2
--
-- >>> rmatching _MkPositive 3
-- Right (UnsafePositive 3)
--
-- >>> rmatching _MkPositive 0
-- Left 0
--
-- @since 0.1
_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 #-}