{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Cardano.Ledger.BaseTypes.NonZero (
  KnownBounds (..),
  HasZero (..),
  WithinBounds,
  NonZero,
  unNonZero,
  nonZero,
  knownNonZero,
  knownNonZeroBounded,
  (%.),
  bindNonZero,
  mapNonZero,
  unsafeNonZero,
  toIntegerNonZero,
  (/.),
  nonZeroOr,
  recipNonZero,
  negateNonZero,
  mulNonZero,
  mulNonZeroNat,
  toRatioNonZero,
  (%?),
) where

import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR)
import Control.DeepSeq (NFData)
import Data.Aeson (FromJSON (..), ToJSON)
import Data.Maybe (fromMaybe)
import Data.Proxy (Proxy (..))
import Data.Ratio (Ratio, numerator, (%))
import Data.Typeable (Typeable)
import Data.Word (Word16, Word32, Word64, Word8)
import GHC.TypeLits
import NoThunks.Class (NoThunks)
#if __GLASGOW_HASKELL__ < 900
import Numeric.Natural (Natural)
#endif

class KnownBounds a where
  type MinBound a :: Nat
  type MaxBound a :: Nat

instance KnownBounds Word8 where
  type MinBound Word8 = 0
  type MaxBound Word8 = 0xFF

instance KnownBounds Word16 where
  type MinBound Word16 = 0
  type MaxBound Word16 = 0xFFFF

instance KnownBounds Word32 where
  type MinBound Word32 = 0
  type MaxBound Word32 = 0xFFFFFFFF

instance KnownBounds Word64 where
  type MinBound Word64 = 0
  type MaxBound Word64 = 0xFFFFFFFFFFFFFFFF

type WithinBounds n a = (MinBound a <= n, n <= MaxBound a)

newtype NonZero a = NonZero {forall a. NonZero a -> a
unNonZero :: a}
  deriving (NonZero a -> NonZero a -> Bool
forall a. Eq a => NonZero a -> NonZero a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NonZero a -> NonZero a -> Bool
$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
Eq, 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
min :: NonZero a -> NonZero a -> NonZero a
$cmin :: forall a. Ord a => NonZero a -> NonZero a -> NonZero a
max :: NonZero a -> NonZero a -> NonZero a
$cmax :: forall a. Ord a => NonZero a -> NonZero a -> NonZero a
>= :: 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
$c< :: forall a. Ord a => NonZero a -> NonZero a -> Bool
compare :: NonZero a -> NonZero a -> Ordering
$ccompare :: forall a. Ord a => NonZero a -> NonZero a -> Ordering
Ord, Int -> NonZero a -> ShowS
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
showList :: [NonZero a] -> ShowS
$cshowList :: forall a. Show a => [NonZero a] -> ShowS
show :: NonZero a -> String
$cshow :: forall a. Show a => NonZero a -> String
showsPrec :: Int -> NonZero a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> NonZero a -> ShowS
Show, Context -> NonZero a -> IO (Maybe ThunkInfo)
Proxy (NonZero a) -> String
forall a.
NoThunks a =>
Context -> NonZero a -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Proxy (NonZero a) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (NonZero a) -> String
$cshowTypeOf :: forall a. NoThunks a => Proxy (NonZero a) -> String
wNoThunks :: Context -> NonZero a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall a.
NoThunks a =>
Context -> NonZero a -> IO (Maybe ThunkInfo)
noThunks :: Context -> NonZero a -> IO (Maybe ThunkInfo)
$cnoThunks :: forall a.
NoThunks a =>
Context -> NonZero a -> IO (Maybe ThunkInfo)
NoThunks, NonZero a -> ()
forall a. NFData a => NonZero a -> ()
forall a. (a -> ()) -> NFData a
rnf :: NonZero a -> ()
$crnf :: forall a. NFData a => NonZero a -> ()
NFData)
  deriving newtype (NonZero a -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [NonZero a] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (NonZero a) -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
forall {a}. EncCBOR a => Typeable (NonZero a)
forall a. EncCBOR a => NonZero a -> Encoding
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [NonZero a] -> Size
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (NonZero a) -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [NonZero a] -> Size
$cencodedListSizeExpr :: forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [NonZero a] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (NonZero a) -> Size
$cencodedSizeExpr :: forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (NonZero a) -> Size
encCBOR :: NonZero a -> Encoding
$cencCBOR :: forall a. EncCBOR a => NonZero a -> Encoding
EncCBOR, [NonZero a] -> Encoding
[NonZero a] -> Value
NonZero a -> Bool
NonZero a -> Encoding
NonZero a -> Value
forall a. ToJSON a => [NonZero a] -> Encoding
forall a. ToJSON a => [NonZero a] -> Value
forall a. ToJSON a => NonZero a -> Bool
forall a. ToJSON a => NonZero a -> Encoding
forall a. ToJSON a => NonZero a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
omitField :: NonZero a -> Bool
$comitField :: forall a. ToJSON a => NonZero a -> Bool
toEncodingList :: [NonZero a] -> Encoding
$ctoEncodingList :: forall a. ToJSON a => [NonZero a] -> Encoding
toJSONList :: [NonZero a] -> Value
$ctoJSONList :: forall a. ToJSON a => [NonZero a] -> Value
toEncoding :: NonZero a -> Encoding
$ctoEncoding :: forall a. ToJSON a => NonZero a -> Encoding
toJSON :: NonZero a -> Value
$ctoJSON :: forall a. ToJSON a => NonZero a -> Value
ToJSON)

class HasZero a where
  isZero :: a -> Bool
  default isZero :: (Eq a, Num a) => a -> Bool
  isZero = (forall a. Eq a => a -> a -> Bool
== a
0)

instance HasZero Word8

instance HasZero Word16

instance HasZero Word32

instance HasZero Word64

instance HasZero Integer

instance HasZero Int

instance HasZero Natural

instance HasZero a => HasZero (Ratio a) where
  isZero :: Ratio a -> Bool
isZero = forall a. HasZero a => a -> Bool
isZero forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ratio a -> a
numerator

instance (Typeable a, DecCBOR a, HasZero a) => DecCBOR (NonZero a) where
  decCBOR :: forall s. Decoder s (NonZero a)
decCBOR = forall a s. DecCBOR a => Decoder s a
decCBOR forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a (m :: * -> *).
(HasZero a, MonadFail m) =>
a -> m (NonZero a)
nonZeroM

instance (FromJSON a, HasZero a) => FromJSON (NonZero a) where
  parseJSON :: Value -> Parser (NonZero a)
parseJSON Value
v = forall a. FromJSON a => Value -> Parser a
parseJSON Value
v forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a (m :: * -> *).
(HasZero a, MonadFail m) =>
a -> m (NonZero a)
nonZeroM

knownNonZero ::
  forall (n :: Nat).
  (KnownNat n, 1 <= n) =>
  NonZero Integer
knownNonZero :: forall (n :: Natural). (KnownNat n, 1 <= n) => NonZero Integer
knownNonZero = forall a. a -> NonZero a
NonZero (forall (n :: Natural) (proxy :: Natural -> *).
KnownNat n =>
proxy n -> Integer
natVal forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @n)

knownNonZeroBounded ::
  forall (n :: Nat) a.
  (KnownNat n, 1 <= n, WithinBounds n a, Num a) =>
  NonZero a
knownNonZeroBounded :: forall (n :: Natural) a.
(KnownNat n, 1 <= n, WithinBounds n a, Num a) =>
NonZero a
knownNonZeroBounded = forall a. a -> NonZero a
NonZero (forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Natural) (proxy :: Natural -> *).
KnownNat n =>
proxy n -> Integer
natVal forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @n)

nonZero :: HasZero a => a -> Maybe (NonZero a)
nonZero :: forall a. HasZero a => a -> Maybe (NonZero a)
nonZero = forall a (m :: * -> *).
(HasZero a, MonadFail m) =>
a -> m (NonZero a)
nonZeroM

nonZeroM :: (HasZero a, MonadFail m) => a -> m (NonZero a)
nonZeroM :: forall a (m :: * -> *).
(HasZero a, MonadFail m) =>
a -> m (NonZero a)
nonZeroM a
x
  | forall a. HasZero a => a -> Bool
isZero a
x = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Encountered zero while trying to construct a NonZero value"
  | Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> NonZero a
NonZero a
x

nonZeroOr :: HasZero a => a -> NonZero a -> NonZero a
nonZeroOr :: forall a. HasZero a => a -> NonZero a -> NonZero a
nonZeroOr a
x NonZero a
d = forall a. a -> Maybe a -> a
fromMaybe NonZero a
d forall a b. (a -> b) -> a -> b
$ forall a. HasZero a => a -> Maybe (NonZero a)
nonZero a
x

mapNonZero :: (Eq b, HasZero b) => (a -> b) -> NonZero a -> Maybe (NonZero b)
mapNonZero :: forall b a.
(Eq b, HasZero b) =>
(a -> b) -> NonZero a -> Maybe (NonZero b)
mapNonZero a -> b
f (NonZero a
x) = forall a. HasZero a => a -> Maybe (NonZero a)
nonZero forall a b. (a -> b) -> a -> b
$ a -> b
f a
x

bindNonZero :: (a -> NonZero b) -> NonZero a -> NonZero b
bindNonZero :: forall a b. (a -> NonZero b) -> NonZero a -> NonZero b
bindNonZero a -> NonZero b
f (NonZero a
x) = a -> NonZero b
f a
x

unsafeNonZero :: a -> NonZero a
unsafeNonZero :: forall a. a -> NonZero a
unsafeNonZero = forall a. a -> NonZero a
NonZero

infixl 7 %.
(%.) :: Integral a => a -> NonZero a -> Ratio a
a
x %. :: forall a. Integral a => a -> NonZero a -> Ratio a
%. NonZero a
y = a
x forall a. Integral a => a -> a -> Ratio a
% forall a. NonZero a -> a
unNonZero NonZero a
y

infixl 7 %?
(%?) :: Integral a => a -> a -> Ratio a
a
x %? :: forall a. Integral a => a -> a -> Ratio a
%? a
y
  | a
y forall a. Eq a => a -> a -> Bool
== a
0 = Ratio a
0
  | Bool
otherwise = a
x forall a. Integral a => a -> a -> Ratio a
% a
y

toIntegerNonZero :: Integral a => NonZero a -> NonZero Integer
toIntegerNonZero :: forall a. Integral a => NonZero a -> NonZero Integer
toIntegerNonZero (NonZero a
x) = forall a. a -> NonZero a
NonZero forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Integer
toInteger a
x

infixl 7 /.
(/.) :: Fractional a => a -> NonZero a -> a
a
x /. :: forall a. Fractional a => a -> NonZero a -> a
/. NonZero a
y = a
x forall a. Fractional a => a -> a -> a
/ forall a. NonZero a -> a
unNonZero NonZero a
y

-- Common safe functions

toRatioNonZero :: Integral a => NonZero a -> NonZero (Ratio a)
toRatioNonZero :: forall a. Integral a => NonZero a -> NonZero (Ratio a)
toRatioNonZero (NonZero a
x) = forall a. a -> NonZero a
NonZero forall a b. (a -> b) -> a -> b
$ a
x forall a. Integral a => a -> a -> Ratio a
% a
1

recipNonZero :: Integral a => NonZero (Ratio a) -> NonZero (Ratio a)
recipNonZero :: forall a. Integral a => NonZero (Ratio a) -> NonZero (Ratio a)
recipNonZero (NonZero Ratio a
x) = forall a. a -> NonZero a
NonZero forall a b. (a -> b) -> a -> b
$ forall a. Fractional a => a -> a
recip Ratio a
x

negateNonZero :: NonZero Integer -> NonZero Integer
negateNonZero :: NonZero Integer -> NonZero Integer
negateNonZero (NonZero Integer
x) = forall a. a -> NonZero a
NonZero forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
negate Integer
x

mulNonZero :: (Integral a, Integral b) => NonZero a -> NonZero b -> NonZero Integer
mulNonZero :: forall a b.
(Integral a, Integral b) =>
NonZero a -> NonZero b -> NonZero Integer
mulNonZero (NonZero a
x) (NonZero b
y) = forall a. a -> NonZero a
NonZero forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Integer
toInteger a
x forall a. Num a => a -> a -> a
* forall a. Integral a => a -> Integer
toInteger b
y

mulNonZeroNat :: forall n a. (KnownNat n, 1 <= n, Integral a) => NonZero a -> NonZero Integer
mulNonZeroNat :: forall (n :: Natural) a.
(KnownNat n, 1 <= n, Integral a) =>
NonZero a -> NonZero Integer
mulNonZeroNat (NonZero a
x) = forall a. a -> NonZero a
NonZero (forall a. Integral a => a -> Integer
toInteger a
x forall a. Num a => a -> a -> a
* forall (n :: Natural) (proxy :: Natural -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy @n))