{-# 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.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.Multiplicative
  ( MEuclidean (mdivMod),
    MGroup ((.%.)),
    MMonoid (one),
    MSemigroup ((.*.)),
  )
import Numeric.Class.Division (Division (divide))
import Numeric.Literal.Integer (FromInteger (afromInteger))
import Numeric.Literal.Rational (FromRational (afromRational))
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 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
      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 (Num a) => MSemigroup (NonZero a) where
  UnsafeNonZero a
x .*. :: NonZero a -> NonZero a -> NonZero a
.*. UnsafeNonZero a
y = a -> NonZero a
forall a. a -> NonZero a
UnsafeNonZero (a -> NonZero a) -> a -> NonZero a
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
y
  {-# INLINE (.*.) #-}

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

-- | @since 0.1
instance (Division a, Num a) => MGroup (NonZero a) where
  UnsafeNonZero a
x .%. :: NonZero a -> NonZero a -> NonZero a
.%. UnsafeNonZero a
d = a -> NonZero a
forall a. a -> NonZero a
UnsafeNonZero (a
x a -> a -> a
forall a. Division a => a -> a -> a
`divide` a
d)
  {-# INLINE (.%.) #-}

-- | @since 0.1
instance (Division a, Integral 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 a. Integral a => a -> a -> (a, a)
`divMod` a
d
  {-# INLINE mdivMod #-}

-- | __WARNING: Partial__
--
-- @since 0.1
instance (FromInteger a, Num a, Ord a) => FromInteger (NonZero a) where
  afromInteger :: HasCallStack => Integer -> NonZero a
afromInteger = a -> NonZero a
forall a. (Eq a, HasCallStack, Num a) => 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
afromInteger
  {-# INLINE afromInteger #-}

-- | __WARNING: Partial__
--
-- @since 0.1
instance (FromRational a, Num a, Ord a) => FromRational (NonZero a) where
  afromRational :: HasCallStack => Rational -> NonZero a
afromRational = a -> NonZero a
forall a. (Eq a, HasCallStack, Num a) => 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
afromRational
  {-# INLINE afromRational #-}

-- | 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 :: (Eq a, HasCallStack, Num a) => a -> NonZero a
unsafeNonZero :: forall a. (Eq a, HasCallStack, Num a) => a -> NonZero a
unsafeNonZero a
x
  | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = String -> NonZero a
forall a. HasCallStack => String -> a
error (String -> NonZero a) -> String -> NonZero a
forall a b. (a -> b) -> a -> b
$ ShowS
errMsg String
"unsafeNonZero"
  | Bool
otherwise = a -> NonZero a
forall a. a -> NonZero a
UnsafeNonZero a
x
{-# INLINEABLE unsafeNonZero #-}

-- | @since 0.1
errMsg :: String -> String
errMsg :: ShowS
errMsg String
fn =
  [String] -> String
forall a. Monoid a => [a] -> a
mconcat
    [ String
"Numeric.Data.NonZero.",
      String
fn,
      String
": Received zero"
    ]