-- | Provides the 'NonZero' type for enforcing a non-zero invariant.
--
-- @since 0.1
module Numeric.Data.NonZero
  ( -- * Type
    NonZero (MkNonZero),

    -- * Creation
    mkNonZero,
    mkNonZeroTH,
    Internal.unsafeNonZero,
    reallyUnsafeNonZero,

    -- * Elimination
    unNonZero,

    -- * Optics
    -- $optics
    _MkNonZero,
    rmatching,
  )
where

import Data.Bifunctor (Bifunctor (first))
import Language.Haskell.TH (Code, Q)
import Language.Haskell.TH.Syntax (Lift)
import Numeric.Algebra (AMonoid, pattern NonZero, pattern Zero)
import Numeric.Data.Internal.Utils (rmatching)
import Numeric.Data.Internal.Utils qualified as Utils
import Numeric.Data.NonZero.Internal (NonZero (MkNonZero, UnsafeNonZero))
import Numeric.Data.NonZero.Internal qualified as Internal
import Optics.Core (ReversedPrism', prism, re)

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

-- | @since 0.1
unNonZero :: NonZero a -> a
unNonZero :: forall a. NonZero a -> a
unNonZero (UnsafeNonZero a
x) = a
x

-- | Smart constructor for 'NonZero'.
--
-- ==== __Examples__
-- >>> mkNonZero 7
-- Right (UnsafeNonZero 7)
--
-- >>> mkNonZero 0
-- Left "Numeric.Data.NonZero: Received zero"
--
-- @since 0.1
mkNonZero :: (AMonoid a, Eq a) => a -> Either String (NonZero a)
mkNonZero :: forall a. (AMonoid a, Eq a) => a -> Either String (NonZero a)
mkNonZero a
Zero = String -> Either String (NonZero a)
forall a b. a -> Either a b
Left String
Internal.errMsg
mkNonZero (NonZero a
x) = NonZero a -> Either String (NonZero a)
forall a b. b -> Either a b
Right (a -> NonZero a
forall a. a -> NonZero a
UnsafeNonZero a
x)
{-# INLINEABLE mkNonZero #-}

-- | Template-haskell version of 'mkNonZero' for creating 'NonZero'
-- at compile-time.
--
-- ==== __Examples__
-- >>> $$(mkNonZeroTH 7)
-- UnsafeNonZero 7
--
-- @since 0.1
mkNonZeroTH :: (AMonoid a, Eq a, Lift a) => a -> Code Q (NonZero a)
mkNonZeroTH :: forall a. (AMonoid a, Eq a, Lift a) => a -> Code Q (NonZero a)
mkNonZeroTH = Either String (NonZero a) -> Code Q (NonZero a)
forall a. Lift a => Either String a -> Code Q a
Utils.liftErrorTH (Either String (NonZero a) -> Code Q (NonZero a))
-> (a -> Either String (NonZero a)) -> a -> Code Q (NonZero a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either String (NonZero a)
forall a. (AMonoid a, Eq a) => a -> Either String (NonZero a)
mkNonZero
{-# INLINEABLE mkNonZeroTH #-}

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

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

-- | 'ReversedPrism'' that enables total elimination and partial construction.
--
-- ==== __Examples__
-- >>> import Optics.Core (view)
-- >>> nz = $$(mkNonZeroTH 7)
-- >>> view _MkNonZero nz
-- 7
--
-- >>> rmatching _MkNonZero 3
-- Right (UnsafeNonZero 3)
--
-- >>> rmatching _MkNonZero 0
-- Left 0
--
-- @since 0.1
_MkNonZero :: (AMonoid a, Eq a) => ReversedPrism' (NonZero a) a
_MkNonZero :: forall a. (AMonoid a, Eq a) => ReversedPrism' (NonZero a) a
_MkNonZero = Optic A_Prism NoIx a a (NonZero a) (NonZero a)
-> Optic (ReversedOptic A_Prism) NoIx (NonZero a) (NonZero 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 ((NonZero a -> a)
-> (a -> Either a (NonZero a))
-> Optic A_Prism NoIx a a (NonZero a) (NonZero a)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism NonZero a -> a
forall a. NonZero a -> a
unNonZero a -> Either a (NonZero a)
forall {b}. (AMonoid b, Eq b) => b -> Either b (NonZero b)
g)
  where
    g :: b -> Either b (NonZero b)
g b
x = (String -> b) -> Either String (NonZero b) -> Either b (NonZero 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 (NonZero b) -> Either b (NonZero b))
-> (b -> Either String (NonZero b)) -> b -> Either b (NonZero b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either String (NonZero b)
forall a. (AMonoid a, Eq a) => a -> Either String (NonZero a)
mkNonZero (b -> Either b (NonZero b)) -> b -> Either b (NonZero b)
forall a b. (a -> b) -> a -> b
$ b
x
{-# INLINEABLE _MkNonZero #-}