-- | 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 Language.Haskell.TH (Code, Q)
import Language.Haskell.TH.Syntax (Lift (liftTyped))
import Numeric.Algebra (AMonoid, pattern NonZero, pattern Zero)
import Numeric.Data.Internal.Utils (rmatching)
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
-- Just (UnsafeNonZero 7)
--
-- >>> mkNonZero 0
-- Nothing
--
-- @since 0.1
mkNonZero :: (AMonoid a, Eq a) => a -> Maybe (NonZero a)
mkNonZero :: forall a. (AMonoid a, Eq a) => a -> Maybe (NonZero a)
mkNonZero a
Zero = Maybe (NonZero a)
forall a. Maybe a
Nothing
mkNonZero (NonZero a
x) = NonZero a -> Maybe (NonZero a)
forall a. a -> Maybe a
Just (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 a
Zero = [Char] -> Code Q (NonZero a)
forall a. HasCallStack => [Char] -> a
error ([Char] -> Code Q (NonZero a)) -> [Char] -> Code Q (NonZero a)
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
Internal.errMsg [Char]
"mkNonZeroTH"
mkNonZeroTH (NonZero a
x) = NonZero a -> Code Q (NonZero a)
forall t (m :: Type -> Type). (Lift t, Quote m) => t -> Code m t
forall (m :: Type -> Type).
Quote m =>
NonZero a -> Code m (NonZero a)
liftTyped (a -> NonZero a
forall a. a -> NonZero a
UnsafeNonZero a
x)
{-# 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
f a -> Either a (NonZero a)
forall {a}. (AMonoid a, Eq a) => a -> Either a (NonZero a)
g)
  where
    f :: NonZero a -> a
f = NonZero a -> a
forall a. NonZero a -> a
unNonZero
    g :: a -> Either a (NonZero a)
g a
x = case a -> Maybe (NonZero a)
forall a. (AMonoid a, Eq a) => a -> Maybe (NonZero a)
mkNonZero a
x of
      Maybe (NonZero a)
Nothing -> a -> Either a (NonZero a)
forall a b. a -> Either a b
Left a
x
      Just NonZero a
x' -> NonZero a -> Either a (NonZero a)
forall a b. b -> Either a b
Right NonZero a
x'
{-# INLINEABLE _MkNonZero #-}