-- SPDX-FileCopyrightText: 2022 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Module declaring newtypes and 'Default' instances for 'Range'.
module Hedgehog.Range.Defaults
  ( Default(..)
  , Length(..)
  , SmallLength(..)
  , TinyLength(..)
  , TicketAmount(..)
  , ValueInt(..)
  , ExpressionInt(..)
  ) where

import Data.Default (Default(..))
import Hedgehog.Range (Range)
import Hedgehog.Range qualified as Range

import Hedgehog.Range.Defaults.Orphans ()

-- | Newtype for specifying lengths of various containers.
newtype Length = Length { Length -> Int
unLength :: Int }
  deriving newtype (Length -> Length -> Bool
(Length -> Length -> Bool)
-> (Length -> Length -> Bool) -> Eq Length
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Length -> Length -> Bool
$c/= :: Length -> Length -> Bool
== :: Length -> Length -> Bool
$c== :: Length -> Length -> Bool
Eq, Eq Length
Eq Length
-> (Length -> Length -> Ordering)
-> (Length -> Length -> Bool)
-> (Length -> Length -> Bool)
-> (Length -> Length -> Bool)
-> (Length -> Length -> Bool)
-> (Length -> Length -> Length)
-> (Length -> Length -> Length)
-> Ord Length
Length -> Length -> Bool
Length -> Length -> Ordering
Length -> Length -> Length
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
min :: Length -> Length -> Length
$cmin :: Length -> Length -> Length
max :: Length -> Length -> Length
$cmax :: Length -> Length -> Length
>= :: Length -> Length -> Bool
$c>= :: Length -> Length -> Bool
> :: Length -> Length -> Bool
$c> :: Length -> Length -> Bool
<= :: Length -> Length -> Bool
$c<= :: Length -> Length -> Bool
< :: Length -> Length -> Bool
$c< :: Length -> Length -> Bool
compare :: Length -> Length -> Ordering
$ccompare :: Length -> Length -> Ordering
Ord, Enum Length
Real Length
Real Length
-> Enum Length
-> (Length -> Length -> Length)
-> (Length -> Length -> Length)
-> (Length -> Length -> Length)
-> (Length -> Length -> Length)
-> (Length -> Length -> (Length, Length))
-> (Length -> Length -> (Length, Length))
-> (Length -> Integer)
-> Integral Length
Length -> Integer
Length -> Length -> (Length, Length)
Length -> Length -> Length
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Length -> Integer
$ctoInteger :: Length -> Integer
divMod :: Length -> Length -> (Length, Length)
$cdivMod :: Length -> Length -> (Length, Length)
quotRem :: Length -> Length -> (Length, Length)
$cquotRem :: Length -> Length -> (Length, Length)
mod :: Length -> Length -> Length
$cmod :: Length -> Length -> Length
div :: Length -> Length -> Length
$cdiv :: Length -> Length -> Length
rem :: Length -> Length -> Length
$crem :: Length -> Length -> Length
quot :: Length -> Length -> Length
$cquot :: Length -> Length -> Length
Integral, Int -> Length
Length -> Int
Length -> [Length]
Length -> Length
Length -> Length -> [Length]
Length -> Length -> Length -> [Length]
(Length -> Length)
-> (Length -> Length)
-> (Int -> Length)
-> (Length -> Int)
-> (Length -> [Length])
-> (Length -> Length -> [Length])
-> (Length -> Length -> [Length])
-> (Length -> Length -> Length -> [Length])
-> Enum Length
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Length -> Length -> Length -> [Length]
$cenumFromThenTo :: Length -> Length -> Length -> [Length]
enumFromTo :: Length -> Length -> [Length]
$cenumFromTo :: Length -> Length -> [Length]
enumFromThen :: Length -> Length -> [Length]
$cenumFromThen :: Length -> Length -> [Length]
enumFrom :: Length -> [Length]
$cenumFrom :: Length -> [Length]
fromEnum :: Length -> Int
$cfromEnum :: Length -> Int
toEnum :: Int -> Length
$ctoEnum :: Int -> Length
pred :: Length -> Length
$cpred :: Length -> Length
succ :: Length -> Length
$csucc :: Length -> Length
Enum, Length
Length -> Length -> Bounded Length
forall a. a -> a -> Bounded a
maxBound :: Length
$cmaxBound :: Length
minBound :: Length
$cminBound :: Length
Bounded, Num Length
Ord Length
Num Length -> Ord Length -> (Length -> Rational) -> Real Length
Length -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Length -> Rational
$ctoRational :: Length -> Rational
Real, Integer -> Length
Length -> Length
Length -> Length -> Length
(Length -> Length -> Length)
-> (Length -> Length -> Length)
-> (Length -> Length -> Length)
-> (Length -> Length)
-> (Length -> Length)
-> (Length -> Length)
-> (Integer -> Length)
-> Num Length
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Length
$cfromInteger :: Integer -> Length
signum :: Length -> Length
$csignum :: Length -> Length
abs :: Length -> Length
$cabs :: Length -> Length
negate :: Length -> Length
$cnegate :: Length -> Length
* :: Length -> Length -> Length
$c* :: Length -> Length -> Length
- :: Length -> Length -> Length
$c- :: Length -> Length -> Length
+ :: Length -> Length -> Length
$c+ :: Length -> Length -> Length
Num)

instance Default (Range Length) where
  def :: Range Length
def = Int -> Length
Length (Int -> Length) -> Range Int -> Range Length
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
100

-- | Newtype for specifying lengths of various containers.
newtype SmallLength = SmallLength { SmallLength -> Int
unSmallLength :: Int }
  deriving newtype (SmallLength -> SmallLength -> Bool
(SmallLength -> SmallLength -> Bool)
-> (SmallLength -> SmallLength -> Bool) -> Eq SmallLength
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SmallLength -> SmallLength -> Bool
$c/= :: SmallLength -> SmallLength -> Bool
== :: SmallLength -> SmallLength -> Bool
$c== :: SmallLength -> SmallLength -> Bool
Eq, Eq SmallLength
Eq SmallLength
-> (SmallLength -> SmallLength -> Ordering)
-> (SmallLength -> SmallLength -> Bool)
-> (SmallLength -> SmallLength -> Bool)
-> (SmallLength -> SmallLength -> Bool)
-> (SmallLength -> SmallLength -> Bool)
-> (SmallLength -> SmallLength -> SmallLength)
-> (SmallLength -> SmallLength -> SmallLength)
-> Ord SmallLength
SmallLength -> SmallLength -> Bool
SmallLength -> SmallLength -> Ordering
SmallLength -> SmallLength -> SmallLength
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
min :: SmallLength -> SmallLength -> SmallLength
$cmin :: SmallLength -> SmallLength -> SmallLength
max :: SmallLength -> SmallLength -> SmallLength
$cmax :: SmallLength -> SmallLength -> SmallLength
>= :: SmallLength -> SmallLength -> Bool
$c>= :: SmallLength -> SmallLength -> Bool
> :: SmallLength -> SmallLength -> Bool
$c> :: SmallLength -> SmallLength -> Bool
<= :: SmallLength -> SmallLength -> Bool
$c<= :: SmallLength -> SmallLength -> Bool
< :: SmallLength -> SmallLength -> Bool
$c< :: SmallLength -> SmallLength -> Bool
compare :: SmallLength -> SmallLength -> Ordering
$ccompare :: SmallLength -> SmallLength -> Ordering
Ord, Enum SmallLength
Real SmallLength
Real SmallLength
-> Enum SmallLength
-> (SmallLength -> SmallLength -> SmallLength)
-> (SmallLength -> SmallLength -> SmallLength)
-> (SmallLength -> SmallLength -> SmallLength)
-> (SmallLength -> SmallLength -> SmallLength)
-> (SmallLength -> SmallLength -> (SmallLength, SmallLength))
-> (SmallLength -> SmallLength -> (SmallLength, SmallLength))
-> (SmallLength -> Integer)
-> Integral SmallLength
SmallLength -> Integer
SmallLength -> SmallLength -> (SmallLength, SmallLength)
SmallLength -> SmallLength -> SmallLength
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: SmallLength -> Integer
$ctoInteger :: SmallLength -> Integer
divMod :: SmallLength -> SmallLength -> (SmallLength, SmallLength)
$cdivMod :: SmallLength -> SmallLength -> (SmallLength, SmallLength)
quotRem :: SmallLength -> SmallLength -> (SmallLength, SmallLength)
$cquotRem :: SmallLength -> SmallLength -> (SmallLength, SmallLength)
mod :: SmallLength -> SmallLength -> SmallLength
$cmod :: SmallLength -> SmallLength -> SmallLength
div :: SmallLength -> SmallLength -> SmallLength
$cdiv :: SmallLength -> SmallLength -> SmallLength
rem :: SmallLength -> SmallLength -> SmallLength
$crem :: SmallLength -> SmallLength -> SmallLength
quot :: SmallLength -> SmallLength -> SmallLength
$cquot :: SmallLength -> SmallLength -> SmallLength
Integral, Int -> SmallLength
SmallLength -> Int
SmallLength -> [SmallLength]
SmallLength -> SmallLength
SmallLength -> SmallLength -> [SmallLength]
SmallLength -> SmallLength -> SmallLength -> [SmallLength]
(SmallLength -> SmallLength)
-> (SmallLength -> SmallLength)
-> (Int -> SmallLength)
-> (SmallLength -> Int)
-> (SmallLength -> [SmallLength])
-> (SmallLength -> SmallLength -> [SmallLength])
-> (SmallLength -> SmallLength -> [SmallLength])
-> (SmallLength -> SmallLength -> SmallLength -> [SmallLength])
-> Enum SmallLength
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SmallLength -> SmallLength -> SmallLength -> [SmallLength]
$cenumFromThenTo :: SmallLength -> SmallLength -> SmallLength -> [SmallLength]
enumFromTo :: SmallLength -> SmallLength -> [SmallLength]
$cenumFromTo :: SmallLength -> SmallLength -> [SmallLength]
enumFromThen :: SmallLength -> SmallLength -> [SmallLength]
$cenumFromThen :: SmallLength -> SmallLength -> [SmallLength]
enumFrom :: SmallLength -> [SmallLength]
$cenumFrom :: SmallLength -> [SmallLength]
fromEnum :: SmallLength -> Int
$cfromEnum :: SmallLength -> Int
toEnum :: Int -> SmallLength
$ctoEnum :: Int -> SmallLength
pred :: SmallLength -> SmallLength
$cpred :: SmallLength -> SmallLength
succ :: SmallLength -> SmallLength
$csucc :: SmallLength -> SmallLength
Enum, SmallLength
SmallLength -> SmallLength -> Bounded SmallLength
forall a. a -> a -> Bounded a
maxBound :: SmallLength
$cmaxBound :: SmallLength
minBound :: SmallLength
$cminBound :: SmallLength
Bounded, Num SmallLength
Ord SmallLength
Num SmallLength
-> Ord SmallLength -> (SmallLength -> Rational) -> Real SmallLength
SmallLength -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: SmallLength -> Rational
$ctoRational :: SmallLength -> Rational
Real, Integer -> SmallLength
SmallLength -> SmallLength
SmallLength -> SmallLength -> SmallLength
(SmallLength -> SmallLength -> SmallLength)
-> (SmallLength -> SmallLength -> SmallLength)
-> (SmallLength -> SmallLength -> SmallLength)
-> (SmallLength -> SmallLength)
-> (SmallLength -> SmallLength)
-> (SmallLength -> SmallLength)
-> (Integer -> SmallLength)
-> Num SmallLength
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> SmallLength
$cfromInteger :: Integer -> SmallLength
signum :: SmallLength -> SmallLength
$csignum :: SmallLength -> SmallLength
abs :: SmallLength -> SmallLength
$cabs :: SmallLength -> SmallLength
negate :: SmallLength -> SmallLength
$cnegate :: SmallLength -> SmallLength
* :: SmallLength -> SmallLength -> SmallLength
$c* :: SmallLength -> SmallLength -> SmallLength
- :: SmallLength -> SmallLength -> SmallLength
$c- :: SmallLength -> SmallLength -> SmallLength
+ :: SmallLength -> SmallLength -> SmallLength
$c+ :: SmallLength -> SmallLength -> SmallLength
Num)

instance Default (Range SmallLength) where
  def :: Range SmallLength
def = Int -> SmallLength
SmallLength (Int -> SmallLength) -> Range Int -> Range SmallLength
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
10

-- | Newtype for specifying lengths of various containers.
newtype TinyLength = TinyLength { TinyLength -> Int
unTinyLength :: Int }
  deriving newtype (TinyLength -> TinyLength -> Bool
(TinyLength -> TinyLength -> Bool)
-> (TinyLength -> TinyLength -> Bool) -> Eq TinyLength
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TinyLength -> TinyLength -> Bool
$c/= :: TinyLength -> TinyLength -> Bool
== :: TinyLength -> TinyLength -> Bool
$c== :: TinyLength -> TinyLength -> Bool
Eq, Eq TinyLength
Eq TinyLength
-> (TinyLength -> TinyLength -> Ordering)
-> (TinyLength -> TinyLength -> Bool)
-> (TinyLength -> TinyLength -> Bool)
-> (TinyLength -> TinyLength -> Bool)
-> (TinyLength -> TinyLength -> Bool)
-> (TinyLength -> TinyLength -> TinyLength)
-> (TinyLength -> TinyLength -> TinyLength)
-> Ord TinyLength
TinyLength -> TinyLength -> Bool
TinyLength -> TinyLength -> Ordering
TinyLength -> TinyLength -> TinyLength
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
min :: TinyLength -> TinyLength -> TinyLength
$cmin :: TinyLength -> TinyLength -> TinyLength
max :: TinyLength -> TinyLength -> TinyLength
$cmax :: TinyLength -> TinyLength -> TinyLength
>= :: TinyLength -> TinyLength -> Bool
$c>= :: TinyLength -> TinyLength -> Bool
> :: TinyLength -> TinyLength -> Bool
$c> :: TinyLength -> TinyLength -> Bool
<= :: TinyLength -> TinyLength -> Bool
$c<= :: TinyLength -> TinyLength -> Bool
< :: TinyLength -> TinyLength -> Bool
$c< :: TinyLength -> TinyLength -> Bool
compare :: TinyLength -> TinyLength -> Ordering
$ccompare :: TinyLength -> TinyLength -> Ordering
Ord, Enum TinyLength
Real TinyLength
Real TinyLength
-> Enum TinyLength
-> (TinyLength -> TinyLength -> TinyLength)
-> (TinyLength -> TinyLength -> TinyLength)
-> (TinyLength -> TinyLength -> TinyLength)
-> (TinyLength -> TinyLength -> TinyLength)
-> (TinyLength -> TinyLength -> (TinyLength, TinyLength))
-> (TinyLength -> TinyLength -> (TinyLength, TinyLength))
-> (TinyLength -> Integer)
-> Integral TinyLength
TinyLength -> Integer
TinyLength -> TinyLength -> (TinyLength, TinyLength)
TinyLength -> TinyLength -> TinyLength
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: TinyLength -> Integer
$ctoInteger :: TinyLength -> Integer
divMod :: TinyLength -> TinyLength -> (TinyLength, TinyLength)
$cdivMod :: TinyLength -> TinyLength -> (TinyLength, TinyLength)
quotRem :: TinyLength -> TinyLength -> (TinyLength, TinyLength)
$cquotRem :: TinyLength -> TinyLength -> (TinyLength, TinyLength)
mod :: TinyLength -> TinyLength -> TinyLength
$cmod :: TinyLength -> TinyLength -> TinyLength
div :: TinyLength -> TinyLength -> TinyLength
$cdiv :: TinyLength -> TinyLength -> TinyLength
rem :: TinyLength -> TinyLength -> TinyLength
$crem :: TinyLength -> TinyLength -> TinyLength
quot :: TinyLength -> TinyLength -> TinyLength
$cquot :: TinyLength -> TinyLength -> TinyLength
Integral, Int -> TinyLength
TinyLength -> Int
TinyLength -> [TinyLength]
TinyLength -> TinyLength
TinyLength -> TinyLength -> [TinyLength]
TinyLength -> TinyLength -> TinyLength -> [TinyLength]
(TinyLength -> TinyLength)
-> (TinyLength -> TinyLength)
-> (Int -> TinyLength)
-> (TinyLength -> Int)
-> (TinyLength -> [TinyLength])
-> (TinyLength -> TinyLength -> [TinyLength])
-> (TinyLength -> TinyLength -> [TinyLength])
-> (TinyLength -> TinyLength -> TinyLength -> [TinyLength])
-> Enum TinyLength
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TinyLength -> TinyLength -> TinyLength -> [TinyLength]
$cenumFromThenTo :: TinyLength -> TinyLength -> TinyLength -> [TinyLength]
enumFromTo :: TinyLength -> TinyLength -> [TinyLength]
$cenumFromTo :: TinyLength -> TinyLength -> [TinyLength]
enumFromThen :: TinyLength -> TinyLength -> [TinyLength]
$cenumFromThen :: TinyLength -> TinyLength -> [TinyLength]
enumFrom :: TinyLength -> [TinyLength]
$cenumFrom :: TinyLength -> [TinyLength]
fromEnum :: TinyLength -> Int
$cfromEnum :: TinyLength -> Int
toEnum :: Int -> TinyLength
$ctoEnum :: Int -> TinyLength
pred :: TinyLength -> TinyLength
$cpred :: TinyLength -> TinyLength
succ :: TinyLength -> TinyLength
$csucc :: TinyLength -> TinyLength
Enum, TinyLength
TinyLength -> TinyLength -> Bounded TinyLength
forall a. a -> a -> Bounded a
maxBound :: TinyLength
$cmaxBound :: TinyLength
minBound :: TinyLength
$cminBound :: TinyLength
Bounded, Num TinyLength
Ord TinyLength
Num TinyLength
-> Ord TinyLength -> (TinyLength -> Rational) -> Real TinyLength
TinyLength -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: TinyLength -> Rational
$ctoRational :: TinyLength -> Rational
Real, Integer -> TinyLength
TinyLength -> TinyLength
TinyLength -> TinyLength -> TinyLength
(TinyLength -> TinyLength -> TinyLength)
-> (TinyLength -> TinyLength -> TinyLength)
-> (TinyLength -> TinyLength -> TinyLength)
-> (TinyLength -> TinyLength)
-> (TinyLength -> TinyLength)
-> (TinyLength -> TinyLength)
-> (Integer -> TinyLength)
-> Num TinyLength
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> TinyLength
$cfromInteger :: Integer -> TinyLength
signum :: TinyLength -> TinyLength
$csignum :: TinyLength -> TinyLength
abs :: TinyLength -> TinyLength
$cabs :: TinyLength -> TinyLength
negate :: TinyLength -> TinyLength
$cnegate :: TinyLength -> TinyLength
* :: TinyLength -> TinyLength -> TinyLength
$c* :: TinyLength -> TinyLength -> TinyLength
- :: TinyLength -> TinyLength -> TinyLength
$c- :: TinyLength -> TinyLength -> TinyLength
+ :: TinyLength -> TinyLength -> TinyLength
$c+ :: TinyLength -> TinyLength -> TinyLength
Num)

instance Default (Range TinyLength) where
  def :: Range TinyLength
def = Int -> TinyLength
TinyLength (Int -> TinyLength) -> Range Int -> Range TinyLength
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
5

-- | Newtype for the range of @Ticket@ amount field.
newtype TicketAmount = MkTicketAmount { TicketAmount -> Natural
unTicketAmount :: Natural }
  deriving newtype (TicketAmount -> TicketAmount -> Bool
(TicketAmount -> TicketAmount -> Bool)
-> (TicketAmount -> TicketAmount -> Bool) -> Eq TicketAmount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TicketAmount -> TicketAmount -> Bool
$c/= :: TicketAmount -> TicketAmount -> Bool
== :: TicketAmount -> TicketAmount -> Bool
$c== :: TicketAmount -> TicketAmount -> Bool
Eq, Eq TicketAmount
Eq TicketAmount
-> (TicketAmount -> TicketAmount -> Ordering)
-> (TicketAmount -> TicketAmount -> Bool)
-> (TicketAmount -> TicketAmount -> Bool)
-> (TicketAmount -> TicketAmount -> Bool)
-> (TicketAmount -> TicketAmount -> Bool)
-> (TicketAmount -> TicketAmount -> TicketAmount)
-> (TicketAmount -> TicketAmount -> TicketAmount)
-> Ord TicketAmount
TicketAmount -> TicketAmount -> Bool
TicketAmount -> TicketAmount -> Ordering
TicketAmount -> TicketAmount -> TicketAmount
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
min :: TicketAmount -> TicketAmount -> TicketAmount
$cmin :: TicketAmount -> TicketAmount -> TicketAmount
max :: TicketAmount -> TicketAmount -> TicketAmount
$cmax :: TicketAmount -> TicketAmount -> TicketAmount
>= :: TicketAmount -> TicketAmount -> Bool
$c>= :: TicketAmount -> TicketAmount -> Bool
> :: TicketAmount -> TicketAmount -> Bool
$c> :: TicketAmount -> TicketAmount -> Bool
<= :: TicketAmount -> TicketAmount -> Bool
$c<= :: TicketAmount -> TicketAmount -> Bool
< :: TicketAmount -> TicketAmount -> Bool
$c< :: TicketAmount -> TicketAmount -> Bool
compare :: TicketAmount -> TicketAmount -> Ordering
$ccompare :: TicketAmount -> TicketAmount -> Ordering
Ord, Int -> TicketAmount
TicketAmount -> Int
TicketAmount -> [TicketAmount]
TicketAmount -> TicketAmount
TicketAmount -> TicketAmount -> [TicketAmount]
TicketAmount -> TicketAmount -> TicketAmount -> [TicketAmount]
(TicketAmount -> TicketAmount)
-> (TicketAmount -> TicketAmount)
-> (Int -> TicketAmount)
-> (TicketAmount -> Int)
-> (TicketAmount -> [TicketAmount])
-> (TicketAmount -> TicketAmount -> [TicketAmount])
-> (TicketAmount -> TicketAmount -> [TicketAmount])
-> (TicketAmount -> TicketAmount -> TicketAmount -> [TicketAmount])
-> Enum TicketAmount
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TicketAmount -> TicketAmount -> TicketAmount -> [TicketAmount]
$cenumFromThenTo :: TicketAmount -> TicketAmount -> TicketAmount -> [TicketAmount]
enumFromTo :: TicketAmount -> TicketAmount -> [TicketAmount]
$cenumFromTo :: TicketAmount -> TicketAmount -> [TicketAmount]
enumFromThen :: TicketAmount -> TicketAmount -> [TicketAmount]
$cenumFromThen :: TicketAmount -> TicketAmount -> [TicketAmount]
enumFrom :: TicketAmount -> [TicketAmount]
$cenumFrom :: TicketAmount -> [TicketAmount]
fromEnum :: TicketAmount -> Int
$cfromEnum :: TicketAmount -> Int
toEnum :: Int -> TicketAmount
$ctoEnum :: Int -> TicketAmount
pred :: TicketAmount -> TicketAmount
$cpred :: TicketAmount -> TicketAmount
succ :: TicketAmount -> TicketAmount
$csucc :: TicketAmount -> TicketAmount
Enum, Enum TicketAmount
Real TicketAmount
Real TicketAmount
-> Enum TicketAmount
-> (TicketAmount -> TicketAmount -> TicketAmount)
-> (TicketAmount -> TicketAmount -> TicketAmount)
-> (TicketAmount -> TicketAmount -> TicketAmount)
-> (TicketAmount -> TicketAmount -> TicketAmount)
-> (TicketAmount -> TicketAmount -> (TicketAmount, TicketAmount))
-> (TicketAmount -> TicketAmount -> (TicketAmount, TicketAmount))
-> (TicketAmount -> Integer)
-> Integral TicketAmount
TicketAmount -> Integer
TicketAmount -> TicketAmount -> (TicketAmount, TicketAmount)
TicketAmount -> TicketAmount -> TicketAmount
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: TicketAmount -> Integer
$ctoInteger :: TicketAmount -> Integer
divMod :: TicketAmount -> TicketAmount -> (TicketAmount, TicketAmount)
$cdivMod :: TicketAmount -> TicketAmount -> (TicketAmount, TicketAmount)
quotRem :: TicketAmount -> TicketAmount -> (TicketAmount, TicketAmount)
$cquotRem :: TicketAmount -> TicketAmount -> (TicketAmount, TicketAmount)
mod :: TicketAmount -> TicketAmount -> TicketAmount
$cmod :: TicketAmount -> TicketAmount -> TicketAmount
div :: TicketAmount -> TicketAmount -> TicketAmount
$cdiv :: TicketAmount -> TicketAmount -> TicketAmount
rem :: TicketAmount -> TicketAmount -> TicketAmount
$crem :: TicketAmount -> TicketAmount -> TicketAmount
quot :: TicketAmount -> TicketAmount -> TicketAmount
$cquot :: TicketAmount -> TicketAmount -> TicketAmount
Integral, Num TicketAmount
Ord TicketAmount
Num TicketAmount
-> Ord TicketAmount
-> (TicketAmount -> Rational)
-> Real TicketAmount
TicketAmount -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: TicketAmount -> Rational
$ctoRational :: TicketAmount -> Rational
Real, Integer -> TicketAmount
TicketAmount -> TicketAmount
TicketAmount -> TicketAmount -> TicketAmount
(TicketAmount -> TicketAmount -> TicketAmount)
-> (TicketAmount -> TicketAmount -> TicketAmount)
-> (TicketAmount -> TicketAmount -> TicketAmount)
-> (TicketAmount -> TicketAmount)
-> (TicketAmount -> TicketAmount)
-> (TicketAmount -> TicketAmount)
-> (Integer -> TicketAmount)
-> Num TicketAmount
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> TicketAmount
$cfromInteger :: Integer -> TicketAmount
signum :: TicketAmount -> TicketAmount
$csignum :: TicketAmount -> TicketAmount
abs :: TicketAmount -> TicketAmount
$cabs :: TicketAmount -> TicketAmount
negate :: TicketAmount -> TicketAmount
$cnegate :: TicketAmount -> TicketAmount
* :: TicketAmount -> TicketAmount -> TicketAmount
$c* :: TicketAmount -> TicketAmount -> TicketAmount
- :: TicketAmount -> TicketAmount -> TicketAmount
$c- :: TicketAmount -> TicketAmount -> TicketAmount
+ :: TicketAmount -> TicketAmount -> TicketAmount
$c+ :: TicketAmount -> TicketAmount -> TicketAmount
Num)

instance Default (Range TicketAmount) where
  def :: Range TicketAmount
def = Natural -> TicketAmount
MkTicketAmount (Natural -> TicketAmount) -> Range Natural -> Range TicketAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> Natural -> Natural -> Range Natural
forall a. Integral a => a -> a -> a -> Range a
Range.linearFrom Natural
0 Natural
0 Natural
1000

-- | Newtype for the range of @ValueInt@ constructor of untyped @Value'@.
newtype ValueInt = MkValueInt { ValueInt -> Integer
unValueInt :: Integer }
  deriving newtype (ValueInt -> ValueInt -> Bool
(ValueInt -> ValueInt -> Bool)
-> (ValueInt -> ValueInt -> Bool) -> Eq ValueInt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValueInt -> ValueInt -> Bool
$c/= :: ValueInt -> ValueInt -> Bool
== :: ValueInt -> ValueInt -> Bool
$c== :: ValueInt -> ValueInt -> Bool
Eq, Eq ValueInt
Eq ValueInt
-> (ValueInt -> ValueInt -> Ordering)
-> (ValueInt -> ValueInt -> Bool)
-> (ValueInt -> ValueInt -> Bool)
-> (ValueInt -> ValueInt -> Bool)
-> (ValueInt -> ValueInt -> Bool)
-> (ValueInt -> ValueInt -> ValueInt)
-> (ValueInt -> ValueInt -> ValueInt)
-> Ord ValueInt
ValueInt -> ValueInt -> Bool
ValueInt -> ValueInt -> Ordering
ValueInt -> ValueInt -> ValueInt
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
min :: ValueInt -> ValueInt -> ValueInt
$cmin :: ValueInt -> ValueInt -> ValueInt
max :: ValueInt -> ValueInt -> ValueInt
$cmax :: ValueInt -> ValueInt -> ValueInt
>= :: ValueInt -> ValueInt -> Bool
$c>= :: ValueInt -> ValueInt -> Bool
> :: ValueInt -> ValueInt -> Bool
$c> :: ValueInt -> ValueInt -> Bool
<= :: ValueInt -> ValueInt -> Bool
$c<= :: ValueInt -> ValueInt -> Bool
< :: ValueInt -> ValueInt -> Bool
$c< :: ValueInt -> ValueInt -> Bool
compare :: ValueInt -> ValueInt -> Ordering
$ccompare :: ValueInt -> ValueInt -> Ordering
Ord, Int -> ValueInt
ValueInt -> Int
ValueInt -> [ValueInt]
ValueInt -> ValueInt
ValueInt -> ValueInt -> [ValueInt]
ValueInt -> ValueInt -> ValueInt -> [ValueInt]
(ValueInt -> ValueInt)
-> (ValueInt -> ValueInt)
-> (Int -> ValueInt)
-> (ValueInt -> Int)
-> (ValueInt -> [ValueInt])
-> (ValueInt -> ValueInt -> [ValueInt])
-> (ValueInt -> ValueInt -> [ValueInt])
-> (ValueInt -> ValueInt -> ValueInt -> [ValueInt])
-> Enum ValueInt
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ValueInt -> ValueInt -> ValueInt -> [ValueInt]
$cenumFromThenTo :: ValueInt -> ValueInt -> ValueInt -> [ValueInt]
enumFromTo :: ValueInt -> ValueInt -> [ValueInt]
$cenumFromTo :: ValueInt -> ValueInt -> [ValueInt]
enumFromThen :: ValueInt -> ValueInt -> [ValueInt]
$cenumFromThen :: ValueInt -> ValueInt -> [ValueInt]
enumFrom :: ValueInt -> [ValueInt]
$cenumFrom :: ValueInt -> [ValueInt]
fromEnum :: ValueInt -> Int
$cfromEnum :: ValueInt -> Int
toEnum :: Int -> ValueInt
$ctoEnum :: Int -> ValueInt
pred :: ValueInt -> ValueInt
$cpred :: ValueInt -> ValueInt
succ :: ValueInt -> ValueInt
$csucc :: ValueInt -> ValueInt
Enum, Num ValueInt
Ord ValueInt
Num ValueInt
-> Ord ValueInt -> (ValueInt -> Rational) -> Real ValueInt
ValueInt -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: ValueInt -> Rational
$ctoRational :: ValueInt -> Rational
Real, Integer -> ValueInt
ValueInt -> ValueInt
ValueInt -> ValueInt -> ValueInt
(ValueInt -> ValueInt -> ValueInt)
-> (ValueInt -> ValueInt -> ValueInt)
-> (ValueInt -> ValueInt -> ValueInt)
-> (ValueInt -> ValueInt)
-> (ValueInt -> ValueInt)
-> (ValueInt -> ValueInt)
-> (Integer -> ValueInt)
-> Num ValueInt
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> ValueInt
$cfromInteger :: Integer -> ValueInt
signum :: ValueInt -> ValueInt
$csignum :: ValueInt -> ValueInt
abs :: ValueInt -> ValueInt
$cabs :: ValueInt -> ValueInt
negate :: ValueInt -> ValueInt
$cnegate :: ValueInt -> ValueInt
* :: ValueInt -> ValueInt -> ValueInt
$c* :: ValueInt -> ValueInt -> ValueInt
- :: ValueInt -> ValueInt -> ValueInt
$c- :: ValueInt -> ValueInt -> ValueInt
+ :: ValueInt -> ValueInt -> ValueInt
$c+ :: ValueInt -> ValueInt -> ValueInt
Num)

instance Default (Range ValueInt) where
  def :: Range ValueInt
def = Integer -> ValueInt
MkValueInt (Integer -> ValueInt) -> Range Integer -> Range ValueInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Integer -> Integer -> Integer -> Range Integer
forall a. Integral a => a -> a -> a -> Range a
Range.linearFrom Integer
0
      (Int64 -> Integer
forall a b. (Integral a, Integral b, CheckIntSubType a b) => a -> b
fromIntegral (Int64 -> Integer) -> Int64 -> Integer
forall a b. (a -> b) -> a -> b
$ forall a. Bounded a => a
minBound @Int64)
      (Word64 -> Integer
forall a b. (Integral a, Integral b, CheckIntSubType a b) => a -> b
fromIntegral (Word64 -> Integer) -> Word64 -> Integer
forall a b. (a -> b) -> a -> b
$ forall a. Bounded a => a
maxBound @Word64)

-- | Newtype for the range of @ExpressionInt@ constructor of @Expression@.
newtype ExpressionInt = MkExpressionInt { ExpressionInt -> Integer
unExpressionInt :: Integer }
  deriving newtype (ExpressionInt -> ExpressionInt -> Bool
(ExpressionInt -> ExpressionInt -> Bool)
-> (ExpressionInt -> ExpressionInt -> Bool) -> Eq ExpressionInt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExpressionInt -> ExpressionInt -> Bool
$c/= :: ExpressionInt -> ExpressionInt -> Bool
== :: ExpressionInt -> ExpressionInt -> Bool
$c== :: ExpressionInt -> ExpressionInt -> Bool
Eq, Eq ExpressionInt
Eq ExpressionInt
-> (ExpressionInt -> ExpressionInt -> Ordering)
-> (ExpressionInt -> ExpressionInt -> Bool)
-> (ExpressionInt -> ExpressionInt -> Bool)
-> (ExpressionInt -> ExpressionInt -> Bool)
-> (ExpressionInt -> ExpressionInt -> Bool)
-> (ExpressionInt -> ExpressionInt -> ExpressionInt)
-> (ExpressionInt -> ExpressionInt -> ExpressionInt)
-> Ord ExpressionInt
ExpressionInt -> ExpressionInt -> Bool
ExpressionInt -> ExpressionInt -> Ordering
ExpressionInt -> ExpressionInt -> ExpressionInt
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
min :: ExpressionInt -> ExpressionInt -> ExpressionInt
$cmin :: ExpressionInt -> ExpressionInt -> ExpressionInt
max :: ExpressionInt -> ExpressionInt -> ExpressionInt
$cmax :: ExpressionInt -> ExpressionInt -> ExpressionInt
>= :: ExpressionInt -> ExpressionInt -> Bool
$c>= :: ExpressionInt -> ExpressionInt -> Bool
> :: ExpressionInt -> ExpressionInt -> Bool
$c> :: ExpressionInt -> ExpressionInt -> Bool
<= :: ExpressionInt -> ExpressionInt -> Bool
$c<= :: ExpressionInt -> ExpressionInt -> Bool
< :: ExpressionInt -> ExpressionInt -> Bool
$c< :: ExpressionInt -> ExpressionInt -> Bool
compare :: ExpressionInt -> ExpressionInt -> Ordering
$ccompare :: ExpressionInt -> ExpressionInt -> Ordering
Ord, Int -> ExpressionInt
ExpressionInt -> Int
ExpressionInt -> [ExpressionInt]
ExpressionInt -> ExpressionInt
ExpressionInt -> ExpressionInt -> [ExpressionInt]
ExpressionInt -> ExpressionInt -> ExpressionInt -> [ExpressionInt]
(ExpressionInt -> ExpressionInt)
-> (ExpressionInt -> ExpressionInt)
-> (Int -> ExpressionInt)
-> (ExpressionInt -> Int)
-> (ExpressionInt -> [ExpressionInt])
-> (ExpressionInt -> ExpressionInt -> [ExpressionInt])
-> (ExpressionInt -> ExpressionInt -> [ExpressionInt])
-> (ExpressionInt
    -> ExpressionInt -> ExpressionInt -> [ExpressionInt])
-> Enum ExpressionInt
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ExpressionInt -> ExpressionInt -> ExpressionInt -> [ExpressionInt]
$cenumFromThenTo :: ExpressionInt -> ExpressionInt -> ExpressionInt -> [ExpressionInt]
enumFromTo :: ExpressionInt -> ExpressionInt -> [ExpressionInt]
$cenumFromTo :: ExpressionInt -> ExpressionInt -> [ExpressionInt]
enumFromThen :: ExpressionInt -> ExpressionInt -> [ExpressionInt]
$cenumFromThen :: ExpressionInt -> ExpressionInt -> [ExpressionInt]
enumFrom :: ExpressionInt -> [ExpressionInt]
$cenumFrom :: ExpressionInt -> [ExpressionInt]
fromEnum :: ExpressionInt -> Int
$cfromEnum :: ExpressionInt -> Int
toEnum :: Int -> ExpressionInt
$ctoEnum :: Int -> ExpressionInt
pred :: ExpressionInt -> ExpressionInt
$cpred :: ExpressionInt -> ExpressionInt
succ :: ExpressionInt -> ExpressionInt
$csucc :: ExpressionInt -> ExpressionInt
Enum, Num ExpressionInt
Ord ExpressionInt
Num ExpressionInt
-> Ord ExpressionInt
-> (ExpressionInt -> Rational)
-> Real ExpressionInt
ExpressionInt -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: ExpressionInt -> Rational
$ctoRational :: ExpressionInt -> Rational
Real, Integer -> ExpressionInt
ExpressionInt -> ExpressionInt
ExpressionInt -> ExpressionInt -> ExpressionInt
(ExpressionInt -> ExpressionInt -> ExpressionInt)
-> (ExpressionInt -> ExpressionInt -> ExpressionInt)
-> (ExpressionInt -> ExpressionInt -> ExpressionInt)
-> (ExpressionInt -> ExpressionInt)
-> (ExpressionInt -> ExpressionInt)
-> (ExpressionInt -> ExpressionInt)
-> (Integer -> ExpressionInt)
-> Num ExpressionInt
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> ExpressionInt
$cfromInteger :: Integer -> ExpressionInt
signum :: ExpressionInt -> ExpressionInt
$csignum :: ExpressionInt -> ExpressionInt
abs :: ExpressionInt -> ExpressionInt
$cabs :: ExpressionInt -> ExpressionInt
negate :: ExpressionInt -> ExpressionInt
$cnegate :: ExpressionInt -> ExpressionInt
* :: ExpressionInt -> ExpressionInt -> ExpressionInt
$c* :: ExpressionInt -> ExpressionInt -> ExpressionInt
- :: ExpressionInt -> ExpressionInt -> ExpressionInt
$c- :: ExpressionInt -> ExpressionInt -> ExpressionInt
+ :: ExpressionInt -> ExpressionInt -> ExpressionInt
$c+ :: ExpressionInt -> ExpressionInt -> ExpressionInt
Num)

instance Default (Range ExpressionInt) where
  def :: Range ExpressionInt
def = Integer -> ExpressionInt
MkExpressionInt (Integer -> ExpressionInt) -> Range Integer -> Range ExpressionInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Integer -> Integer -> Range Integer
forall a. Integral a => a -> a -> a -> Range a
Range.linearFrom Integer
0 Integer
-1000 Integer
1000