{-# LANGUAGE UndecidableInstances #-}

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

    -- * Creation
    unsafeNonZero,

    -- * Misc
    errMsg,
  )
where

import Control.DeepSeq (NFData)
import Data.Bifunctor (Bifunctor (bimap))
import Data.Hashable (Hashable)
import Data.Kind (Type)
import Data.Text.Display (Display, ShowInstance (ShowInstance))
import GHC.Generics (Generic)
import GHC.Records (HasField (getField))
import GHC.Stack (HasCallStack)
import Language.Haskell.TH.Syntax (Lift)
import Numeric.Algebra (AMonoid)
import Numeric.Algebra.Additive (pattern NonZero, pattern Zero)
import Numeric.Algebra.MetricSpace (MetricSpace (diffR))
import Numeric.Algebra.Multiplicative
  ( MEuclidean (mdivMod),
    MGroup ((.%.)),
    MMonoid (one),
    MSemigroup ((.*.)),
  )
import Numeric.Algebra.Normed (Normed (norm, sgn))
import Numeric.Convert.Integer (FromInteger (fromZ), ToInteger (toZ))
import Numeric.Convert.Rational (FromRational (fromQ), ToRational (toQ))
import Numeric.Convert.Real (FromReal (fromR), ToReal (toR))
import Optics.Core (A_Getter, LabelOptic (labelOptic), to)

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

-- | Smart-constructor for creating a \"non-zero\" @a@.
--
-- @since 0.1
type NonZero :: Type -> Type
newtype NonZero a = UnsafeNonZero a
  deriving stock
    ( -- | @since 0.1
      NonZero a -> NonZero a -> Bool
(NonZero a -> NonZero a -> Bool)
-> (NonZero a -> NonZero a -> Bool) -> Eq (NonZero a)
forall a. Eq a => NonZero a -> NonZero a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => NonZero a -> NonZero a -> Bool
== :: NonZero a -> NonZero a -> Bool
$c/= :: forall a. Eq a => NonZero a -> NonZero a -> Bool
/= :: NonZero a -> NonZero a -> Bool
Eq,
      -- | @since 0.1
      (forall m. Monoid m => NonZero m -> m)
-> (forall m a. Monoid m => (a -> m) -> NonZero a -> m)
-> (forall m a. Monoid m => (a -> m) -> NonZero a -> m)
-> (forall a b. (a -> b -> b) -> b -> NonZero a -> b)
-> (forall a b. (a -> b -> b) -> b -> NonZero a -> b)
-> (forall b a. (b -> a -> b) -> b -> NonZero a -> b)
-> (forall b a. (b -> a -> b) -> b -> NonZero a -> b)
-> (forall a. (a -> a -> a) -> NonZero a -> a)
-> (forall a. (a -> a -> a) -> NonZero a -> a)
-> (forall a. NonZero a -> [a])
-> (forall a. NonZero a -> Bool)
-> (forall a. NonZero a -> Int)
-> (forall a. Eq a => a -> NonZero a -> Bool)
-> (forall a. Ord a => NonZero a -> a)
-> (forall a. Ord a => NonZero a -> a)
-> (forall a. Num a => NonZero a -> a)
-> (forall a. Num a => NonZero a -> a)
-> Foldable NonZero
forall a. Eq a => a -> NonZero a -> Bool
forall a. Num a => NonZero a -> a
forall a. Ord a => NonZero a -> a
forall m. Monoid m => NonZero m -> m
forall a. NonZero a -> Bool
forall a. NonZero a -> Int
forall a. NonZero a -> [a]
forall a. (a -> a -> a) -> NonZero a -> a
forall m a. Monoid m => (a -> m) -> NonZero a -> m
forall b a. (b -> a -> b) -> b -> NonZero a -> b
forall a b. (a -> b -> b) -> b -> NonZero a -> b
forall (t :: Type -> Type).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => NonZero m -> m
fold :: forall m. Monoid m => NonZero m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> NonZero a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> NonZero a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> NonZero a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> NonZero a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> NonZero a -> b
foldr :: forall a b. (a -> b -> b) -> b -> NonZero a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> NonZero a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> NonZero a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> NonZero a -> b
foldl :: forall b a. (b -> a -> b) -> b -> NonZero a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> NonZero a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> NonZero a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> NonZero a -> a
foldr1 :: forall a. (a -> a -> a) -> NonZero a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> NonZero a -> a
foldl1 :: forall a. (a -> a -> a) -> NonZero a -> a
$ctoList :: forall a. NonZero a -> [a]
toList :: forall a. NonZero a -> [a]
$cnull :: forall a. NonZero a -> Bool
null :: forall a. NonZero a -> Bool
$clength :: forall a. NonZero a -> Int
length :: forall a. NonZero a -> Int
$celem :: forall a. Eq a => a -> NonZero a -> Bool
elem :: forall a. Eq a => a -> NonZero a -> Bool
$cmaximum :: forall a. Ord a => NonZero a -> a
maximum :: forall a. Ord a => NonZero a -> a
$cminimum :: forall a. Ord a => NonZero a -> a
minimum :: forall a. Ord a => NonZero a -> a
$csum :: forall a. Num a => NonZero a -> a
sum :: forall a. Num a => NonZero a -> a
$cproduct :: forall a. Num a => NonZero a -> a
product :: forall a. Num a => NonZero a -> a
Foldable,
      -- | @since 0.1
      (forall x. NonZero a -> Rep (NonZero a) x)
-> (forall x. Rep (NonZero a) x -> NonZero a)
-> Generic (NonZero a)
forall x. Rep (NonZero a) x -> NonZero a
forall x. NonZero a -> Rep (NonZero a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (NonZero a) x -> NonZero a
forall a x. NonZero a -> Rep (NonZero a) x
$cfrom :: forall a x. NonZero a -> Rep (NonZero a) x
from :: forall x. NonZero a -> Rep (NonZero a) x
$cto :: forall a x. Rep (NonZero a) x -> NonZero a
to :: forall x. Rep (NonZero a) x -> NonZero a
Generic,
      -- | @since 0.1
      (forall (m :: Type -> Type). Quote m => NonZero a -> m Exp)
-> (forall (m :: Type -> Type).
    Quote m =>
    NonZero a -> Code m (NonZero a))
-> Lift (NonZero a)
forall a (m :: Type -> Type).
(Lift a, Quote m) =>
NonZero a -> m Exp
forall a (m :: Type -> Type).
(Lift a, Quote m) =>
NonZero a -> Code m (NonZero a)
forall t.
(forall (m :: Type -> Type). Quote m => t -> m Exp)
-> (forall (m :: Type -> Type). Quote m => t -> Code m t) -> Lift t
forall (m :: Type -> Type). Quote m => NonZero a -> m Exp
forall (m :: Type -> Type).
Quote m =>
NonZero a -> Code m (NonZero a)
$clift :: forall a (m :: Type -> Type).
(Lift a, Quote m) =>
NonZero a -> m Exp
lift :: forall (m :: Type -> Type). Quote m => NonZero a -> m Exp
$cliftTyped :: forall a (m :: Type -> Type).
(Lift a, Quote m) =>
NonZero a -> Code m (NonZero a)
liftTyped :: forall (m :: Type -> Type).
Quote m =>
NonZero a -> Code m (NonZero a)
Lift,
      -- | @since 0.1
      Eq (NonZero a)
Eq (NonZero a) =>
(NonZero a -> NonZero a -> Ordering)
-> (NonZero a -> NonZero a -> Bool)
-> (NonZero a -> NonZero a -> Bool)
-> (NonZero a -> NonZero a -> Bool)
-> (NonZero a -> NonZero a -> Bool)
-> (NonZero a -> NonZero a -> NonZero a)
-> (NonZero a -> NonZero a -> NonZero a)
-> Ord (NonZero a)
NonZero a -> NonZero a -> Bool
NonZero a -> NonZero a -> Ordering
NonZero a -> NonZero a -> NonZero a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (NonZero a)
forall a. Ord a => NonZero a -> NonZero a -> Bool
forall a. Ord a => NonZero a -> NonZero a -> Ordering
forall a. Ord a => NonZero a -> NonZero a -> NonZero a
$ccompare :: forall a. Ord a => NonZero a -> NonZero a -> Ordering
compare :: NonZero a -> NonZero a -> Ordering
$c< :: forall a. Ord a => NonZero a -> NonZero a -> Bool
< :: NonZero a -> NonZero a -> Bool
$c<= :: forall a. Ord a => NonZero a -> NonZero a -> Bool
<= :: NonZero a -> NonZero a -> Bool
$c> :: forall a. Ord a => NonZero a -> NonZero a -> Bool
> :: NonZero a -> NonZero a -> Bool
$c>= :: forall a. Ord a => NonZero a -> NonZero a -> Bool
>= :: NonZero a -> NonZero a -> Bool
$cmax :: forall a. Ord a => NonZero a -> NonZero a -> NonZero a
max :: NonZero a -> NonZero a -> NonZero a
$cmin :: forall a. Ord a => NonZero a -> NonZero a -> NonZero a
min :: NonZero a -> NonZero a -> NonZero a
Ord,
      -- | @since 0.1
      Int -> NonZero a -> ShowS
[NonZero a] -> ShowS
NonZero a -> String
(Int -> NonZero a -> ShowS)
-> (NonZero a -> String)
-> ([NonZero a] -> ShowS)
-> Show (NonZero a)
forall a. Show a => Int -> NonZero a -> ShowS
forall a. Show a => [NonZero a] -> ShowS
forall a. Show a => NonZero a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> NonZero a -> ShowS
showsPrec :: Int -> NonZero a -> ShowS
$cshow :: forall a. Show a => NonZero a -> String
show :: NonZero a -> String
$cshowList :: forall a. Show a => [NonZero a] -> ShowS
showList :: [NonZero a] -> ShowS
Show
    )
  deriving anyclass
    ( -- | @since 0.1.0.0
      Eq (NonZero a)
Eq (NonZero a) =>
(Int -> NonZero a -> Int)
-> (NonZero a -> Int) -> Hashable (NonZero a)
Int -> NonZero a -> Int
NonZero a -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall a. Hashable a => Eq (NonZero a)
forall a. Hashable a => Int -> NonZero a -> Int
forall a. Hashable a => NonZero a -> Int
$chashWithSalt :: forall a. Hashable a => Int -> NonZero a -> Int
hashWithSalt :: Int -> NonZero a -> Int
$chash :: forall a. Hashable a => NonZero a -> Int
hash :: NonZero a -> Int
Hashable,
      -- | @since 0.1.0.0
      NonZero a -> ()
(NonZero a -> ()) -> NFData (NonZero a)
forall a. NFData a => NonZero a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => NonZero a -> ()
rnf :: NonZero a -> ()
NFData
    )
  deriving
    ( -- | @since 0.1
      Int -> NonZero a -> Builder
[NonZero a] -> Builder
NonZero a -> Builder
(NonZero a -> Builder)
-> ([NonZero a] -> Builder)
-> (Int -> NonZero a -> Builder)
-> Display (NonZero a)
forall a. Show a => Int -> NonZero a -> Builder
forall a. Show a => [NonZero a] -> Builder
forall a. Show a => NonZero a -> Builder
forall a.
(a -> Builder)
-> ([a] -> Builder) -> (Int -> a -> Builder) -> Display a
$cdisplayBuilder :: forall a. Show a => NonZero a -> Builder
displayBuilder :: NonZero a -> Builder
$cdisplayList :: forall a. Show a => [NonZero a] -> Builder
displayList :: [NonZero a] -> Builder
$cdisplayPrec :: forall a. Show a => Int -> NonZero a -> Builder
displayPrec :: Int -> NonZero a -> Builder
Display
    )
    via (ShowInstance a)

-- | @since 0.1
instance HasField "unNonZero" (NonZero a) a where
  getField :: NonZero a -> a
getField (UnsafeNonZero a
x) = a
x

-- | @since 0.1
instance
  ( k ~ A_Getter,
    x ~ a,
    y ~ a
  ) =>
  LabelOptic "unNonZero" k (NonZero a) (NonZero a) x y
  where
  labelOptic :: Optic k NoIx (NonZero a) (NonZero a) x y
labelOptic = (NonZero a -> x) -> Getter (NonZero a) x
forall s a. (s -> a) -> Getter s a
to (\(UnsafeNonZero a
x) -> x
a
x)
  {-# INLINE labelOptic #-}

-- | @since 0.1
instance (MSemigroup a) => MSemigroup (NonZero a) where
  .*. :: NonZero a -> NonZero a -> NonZero a
(.*.) = (a -> a -> a) -> NonZero a -> NonZero a -> NonZero a
forall a. (a -> a -> a) -> NonZero a -> NonZero a -> NonZero a
liftNonZero2 a -> a -> a
forall s. MSemigroup s => s -> s -> s
(.*.)
  {-# INLINE (.*.) #-}

-- | @since 0.1
instance (MMonoid a) => MMonoid (NonZero a) where
  one :: NonZero a
one = a -> NonZero a
forall a. a -> NonZero a
UnsafeNonZero a
forall m. MMonoid m => m
one
  {-# INLINE one #-}

-- | @since 0.1
instance (MGroup a) => MGroup (NonZero a) where
  .%. :: NonZero a -> NonZero a -> NonZero a
(.%.) = (a -> a -> a) -> NonZero a -> NonZero a -> NonZero a
forall a. (a -> a -> a) -> NonZero a -> NonZero a -> NonZero a
liftNonZero2 a -> a -> a
forall g. MGroup g => g -> g -> g
(.%.)
  {-# INLINE (.%.) #-}

-- | @since 0.1
instance (MEuclidean a) => MEuclidean (NonZero a) where
  UnsafeNonZero a
x mdivMod :: NonZero a -> NonZero a -> (NonZero a, NonZero a)
`mdivMod` UnsafeNonZero a
d =
    (a -> NonZero a)
-> (a -> NonZero a) -> (a, a) -> (NonZero a, NonZero a)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: Type -> Type -> Type) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> NonZero a
forall a. a -> NonZero a
UnsafeNonZero a -> NonZero a
forall a. a -> NonZero a
UnsafeNonZero ((a, a) -> (NonZero a, NonZero a))
-> (a, a) -> (NonZero a, NonZero a)
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> (a, a)
forall g. MEuclidean g => g -> g -> (g, g)
`mdivMod` a
d
  {-# INLINE mdivMod #-}

-- | @since 0.1
instance (MetricSpace a) => MetricSpace (NonZero a) where
  diffR :: NonZero a -> NonZero a -> Double
diffR = (a -> a -> Double) -> NonZero a -> NonZero a -> Double
forall a r. (a -> a -> r) -> NonZero a -> NonZero a -> r
applyNonZero2 a -> a -> Double
forall s. MetricSpace s => s -> s -> Double
diffR
  {-# INLINEABLE diffR #-}

-- | @since 0.1
instance (Normed a) => Normed (NonZero a) where
  norm :: NonZero a -> NonZero a
norm (UnsafeNonZero a
x) = a -> NonZero a
forall a. a -> NonZero a
UnsafeNonZero (a -> NonZero a) -> a -> NonZero a
forall a b. (a -> b) -> a -> b
$ a -> a
forall s. Normed s => s -> s
norm a
x
  {-# INLINEABLE norm #-}

  sgn :: NonZero a -> NonZero a
sgn (UnsafeNonZero a
x) = a -> NonZero a
forall a. a -> NonZero a
UnsafeNonZero (a -> NonZero a) -> a -> NonZero a
forall a b. (a -> b) -> a -> b
$ a -> a
forall s. Normed s => s -> s
sgn a
x
  {-# INLINEABLE sgn #-}

-- | __WARNING: Partial__
--
-- @since 0.1
instance (AMonoid a, Eq a, FromInteger a) => FromInteger (NonZero a) where
  fromZ :: HasCallStack => Integer -> NonZero a
fromZ = a -> NonZero a
forall a. (AMonoid a, Eq a, HasCallStack) => a -> NonZero a
unsafeNonZero (a -> NonZero a) -> (Integer -> a) -> Integer -> NonZero a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. (FromInteger a, HasCallStack) => Integer -> a
fromZ
  {-# INLINE fromZ #-}

-- | @since 0.1
instance (ToInteger a) => ToInteger (NonZero a) where
  toZ :: HasCallStack => NonZero a -> Integer
toZ (UnsafeNonZero a
x) = a -> Integer
forall a. (ToInteger a, HasCallStack) => a -> Integer
toZ a
x
  {-# INLINEABLE toZ #-}

-- | __WARNING: Partial__
--
-- @since 0.1
instance (AMonoid a, Eq a, FromRational a) => FromRational (NonZero a) where
  fromQ :: HasCallStack => Rational -> NonZero a
fromQ = a -> NonZero a
forall a. (AMonoid a, Eq a, HasCallStack) => a -> NonZero a
unsafeNonZero (a -> NonZero a) -> (Rational -> a) -> Rational -> NonZero a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. (FromRational a, HasCallStack) => Rational -> a
fromQ
  {-# INLINE fromQ #-}

-- | @since 0.1
instance (ToRational a) => ToRational (NonZero a) where
  toQ :: HasCallStack => NonZero a -> Rational
toQ (UnsafeNonZero a
x) = a -> Rational
forall a. (ToRational a, HasCallStack) => a -> Rational
toQ a
x
  {-# INLINEABLE toQ #-}

-- | __WARNING: Partial__
--
-- @since 0.1
instance (AMonoid a, Eq a, FromReal a) => FromReal (NonZero a) where
  fromR :: HasCallStack => Double -> NonZero a
fromR = a -> NonZero a
forall a. (AMonoid a, Eq a, HasCallStack) => a -> NonZero a
unsafeNonZero (a -> NonZero a) -> (Double -> a) -> Double -> NonZero a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> a
forall a. (FromReal a, HasCallStack) => Double -> a
fromR
  {-# INLINEABLE fromR #-}

-- | @since 0.1
instance (ToReal a) => ToReal (NonZero a) where
  toR :: HasCallStack => NonZero a -> Double
toR (UnsafeNonZero a
x) = a -> Double
forall a. (ToReal a, HasCallStack) => a -> Double
toR a
x
  {-# INLINEABLE toR #-}

-- | Unidirectional pattern synonym for 'NonZero'. This allows us to pattern
-- match on a nonzero term without exposing the unsafe internal details.
--
-- @since 0.1
pattern MkNonZero :: a -> NonZero a
pattern $mMkNonZero :: forall {r} {a}. NonZero a -> (a -> r) -> ((# #) -> r) -> r
MkNonZero x <- UnsafeNonZero x

{-# COMPLETE MkNonZero #-}

-- | Throws an error when given 0.
--
-- __WARNING: Partial__
--
-- ==== __Examples__
-- >>> unsafeNonZero 7
-- UnsafeNonZero 7
--
-- @since 0.1
unsafeNonZero :: (AMonoid a, Eq a, HasCallStack) => a -> NonZero a
unsafeNonZero :: forall a. (AMonoid a, Eq a, HasCallStack) => a -> NonZero a
unsafeNonZero a
Zero = String -> NonZero a
forall a. HasCallStack => String -> a
error String
errMsg
unsafeNonZero (NonZero a
x) = a -> NonZero a
forall a. a -> NonZero a
UnsafeNonZero a
x
{-# INLINEABLE unsafeNonZero #-}

-- | @since 0.1
errMsg :: String
errMsg :: String
errMsg = String
"Numeric.Data.NonZero: Received zero"

liftNonZero2 ::
  forall a.
  (a -> a -> a) ->
  NonZero a ->
  NonZero a ->
  NonZero a
liftNonZero2 :: forall a. (a -> a -> a) -> NonZero a -> NonZero a -> NonZero a
liftNonZero2 a -> a -> a
f NonZero a
x = a -> NonZero a
forall a. a -> NonZero a
UnsafeNonZero (a -> NonZero a) -> (NonZero a -> a) -> NonZero a -> NonZero a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a) -> NonZero a -> NonZero a -> a
forall a r. (a -> a -> r) -> NonZero a -> NonZero a -> r
applyNonZero2 a -> a -> a
f NonZero a
x

applyNonZero2 ::
  (a -> a -> r) ->
  NonZero a ->
  NonZero a ->
  r
applyNonZero2 :: forall a r. (a -> a -> r) -> NonZero a -> NonZero a -> r
applyNonZero2 a -> a -> r
f (UnsafeNonZero a
x) (UnsafeNonZero a
y) = a -> a -> r
f a
x a
y