{-# LANGUAGE DeriveAnyClass       #-}
{-# LANGUAGE DeriveGeneric        #-}
{-# LANGUAGE DerivingStrategies   #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE MonoLocalBinds       #-}
{-# LANGUAGE NoImplicitPrelude    #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE UndecidableInstances #-}
-- Otherwise we get a complaint about the 'fromIntegral' call in the generated instance of 'Integral' for 'Ada'
{-# OPTIONS_GHC -Wno-identities #-}
{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE DeriveDataTypeable   #-}

-- | Slots and slot ranges.
module Ledger.Slot(
      Slot(..)
    , SlotRange
    , width
    ) where

import Codec.Serialise.Class (Serialise)
import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
import Data.Hashable (Hashable)
import GHC.Generics (Generic)
import Prelude qualified as Haskell
import Prettyprinter (Pretty (pretty), (<+>))


import PlutusTx qualified
import PlutusTx.Lift (makeLift)
import PlutusTx.Prelude

import Data.Data (Data)
import Plutus.V1.Ledger.Interval

{- HLINT ignore "Redundant if" -}

-- | The slot number. This is a good proxy for time, since on the Cardano blockchain
-- slots pass at a constant rate.
newtype Slot = Slot { Slot -> Integer
getSlot :: Integer }
    deriving stock (Slot -> Slot -> Bool
(Slot -> Slot -> Bool) -> (Slot -> Slot -> Bool) -> Eq Slot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Slot -> Slot -> Bool
$c/= :: Slot -> Slot -> Bool
== :: Slot -> Slot -> Bool
$c== :: Slot -> Slot -> Bool
Haskell.Eq, Eq Slot
Eq Slot
-> (Slot -> Slot -> Ordering)
-> (Slot -> Slot -> Bool)
-> (Slot -> Slot -> Bool)
-> (Slot -> Slot -> Bool)
-> (Slot -> Slot -> Bool)
-> (Slot -> Slot -> Slot)
-> (Slot -> Slot -> Slot)
-> Ord Slot
Slot -> Slot -> Bool
Slot -> Slot -> Ordering
Slot -> Slot -> Slot
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 :: Slot -> Slot -> Slot
$cmin :: Slot -> Slot -> Slot
max :: Slot -> Slot -> Slot
$cmax :: Slot -> Slot -> Slot
>= :: Slot -> Slot -> Bool
$c>= :: Slot -> Slot -> Bool
> :: Slot -> Slot -> Bool
$c> :: Slot -> Slot -> Bool
<= :: Slot -> Slot -> Bool
$c<= :: Slot -> Slot -> Bool
< :: Slot -> Slot -> Bool
$c< :: Slot -> Slot -> Bool
compare :: Slot -> Slot -> Ordering
$ccompare :: Slot -> Slot -> Ordering
$cp1Ord :: Eq Slot
Haskell.Ord, Int -> Slot -> ShowS
[Slot] -> ShowS
Slot -> String
(Int -> Slot -> ShowS)
-> (Slot -> String) -> ([Slot] -> ShowS) -> Show Slot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Slot] -> ShowS
$cshowList :: [Slot] -> ShowS
show :: Slot -> String
$cshow :: Slot -> String
showsPrec :: Int -> Slot -> ShowS
$cshowsPrec :: Int -> Slot -> ShowS
Haskell.Show, (forall x. Slot -> Rep Slot x)
-> (forall x. Rep Slot x -> Slot) -> Generic Slot
forall x. Rep Slot x -> Slot
forall x. Slot -> Rep Slot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Slot x -> Slot
$cfrom :: forall x. Slot -> Rep Slot x
Generic, Typeable Slot
DataType
Constr
Typeable Slot
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Slot -> c Slot)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Slot)
-> (Slot -> Constr)
-> (Slot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Slot))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Slot))
-> ((forall b. Data b => b -> b) -> Slot -> Slot)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Slot -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Slot -> r)
-> (forall u. (forall d. Data d => d -> u) -> Slot -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Slot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Slot -> m Slot)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Slot -> m Slot)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Slot -> m Slot)
-> Data Slot
Slot -> DataType
Slot -> Constr
(forall b. Data b => b -> b) -> Slot -> Slot
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Slot -> c Slot
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Slot
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Slot -> u
forall u. (forall d. Data d => d -> u) -> Slot -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Slot -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Slot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Slot -> m Slot
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Slot -> m Slot
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Slot
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Slot -> c Slot
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Slot)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Slot)
$cSlot :: Constr
$tSlot :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Slot -> m Slot
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Slot -> m Slot
gmapMp :: (forall d. Data d => d -> m d) -> Slot -> m Slot
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Slot -> m Slot
gmapM :: (forall d. Data d => d -> m d) -> Slot -> m Slot
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Slot -> m Slot
gmapQi :: Int -> (forall d. Data d => d -> u) -> Slot -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Slot -> u
gmapQ :: (forall d. Data d => d -> u) -> Slot -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Slot -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Slot -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Slot -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Slot -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Slot -> r
gmapT :: (forall b. Data b => b -> b) -> Slot -> Slot
$cgmapT :: (forall b. Data b => b -> b) -> Slot -> Slot
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Slot)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Slot)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Slot)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Slot)
dataTypeOf :: Slot -> DataType
$cdataTypeOf :: Slot -> DataType
toConstr :: Slot -> Constr
$ctoConstr :: Slot -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Slot
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Slot
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Slot -> c Slot
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Slot -> c Slot
$cp1Data :: Typeable Slot
Data)
    deriving anyclass (Value -> Parser [Slot]
Value -> Parser Slot
(Value -> Parser Slot) -> (Value -> Parser [Slot]) -> FromJSON Slot
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Slot]
$cparseJSONList :: Value -> Parser [Slot]
parseJSON :: Value -> Parser Slot
$cparseJSON :: Value -> Parser Slot
FromJSON, FromJSONKeyFunction [Slot]
FromJSONKeyFunction Slot
FromJSONKeyFunction Slot
-> FromJSONKeyFunction [Slot] -> FromJSONKey Slot
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [Slot]
$cfromJSONKeyList :: FromJSONKeyFunction [Slot]
fromJSONKey :: FromJSONKeyFunction Slot
$cfromJSONKey :: FromJSONKeyFunction Slot
FromJSONKey, [Slot] -> Encoding
[Slot] -> Value
Slot -> Encoding
Slot -> Value
(Slot -> Value)
-> (Slot -> Encoding)
-> ([Slot] -> Value)
-> ([Slot] -> Encoding)
-> ToJSON Slot
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Slot] -> Encoding
$ctoEncodingList :: [Slot] -> Encoding
toJSONList :: [Slot] -> Value
$ctoJSONList :: [Slot] -> Value
toEncoding :: Slot -> Encoding
$ctoEncoding :: Slot -> Encoding
toJSON :: Slot -> Value
$ctoJSON :: Slot -> Value
ToJSON, ToJSONKeyFunction [Slot]
ToJSONKeyFunction Slot
ToJSONKeyFunction Slot
-> ToJSONKeyFunction [Slot] -> ToJSONKey Slot
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [Slot]
$ctoJSONKeyList :: ToJSONKeyFunction [Slot]
toJSONKey :: ToJSONKeyFunction Slot
$ctoJSONKey :: ToJSONKeyFunction Slot
ToJSONKey)
    deriving newtype (Slot -> Slot -> Slot
(Slot -> Slot -> Slot) -> AdditiveSemigroup Slot
forall a. (a -> a -> a) -> AdditiveSemigroup a
+ :: Slot -> Slot -> Slot
$c+ :: Slot -> Slot -> Slot
AdditiveSemigroup, AdditiveSemigroup Slot
Slot
AdditiveSemigroup Slot -> Slot -> AdditiveMonoid Slot
forall a. AdditiveSemigroup a -> a -> AdditiveMonoid a
zero :: Slot
$czero :: Slot
$cp1AdditiveMonoid :: AdditiveSemigroup Slot
AdditiveMonoid, AdditiveMonoid Slot
AdditiveMonoid Slot -> (Slot -> Slot -> Slot) -> AdditiveGroup Slot
Slot -> Slot -> Slot
forall a. AdditiveMonoid a -> (a -> a -> a) -> AdditiveGroup a
- :: Slot -> Slot -> Slot
$c- :: Slot -> Slot -> Slot
$cp1AdditiveGroup :: AdditiveMonoid Slot
AdditiveGroup, Slot -> Slot -> Bool
(Slot -> Slot -> Bool) -> Eq Slot
forall a. (a -> a -> Bool) -> Eq a
== :: Slot -> Slot -> Bool
$c== :: Slot -> Slot -> Bool
Eq, Eq Slot
Eq Slot
-> (Slot -> Slot -> Ordering)
-> (Slot -> Slot -> Bool)
-> (Slot -> Slot -> Bool)
-> (Slot -> Slot -> Bool)
-> (Slot -> Slot -> Bool)
-> (Slot -> Slot -> Slot)
-> (Slot -> Slot -> Slot)
-> Ord Slot
Slot -> Slot -> Bool
Slot -> Slot -> Ordering
Slot -> Slot -> Slot
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 :: Slot -> Slot -> Slot
$cmin :: Slot -> Slot -> Slot
max :: Slot -> Slot -> Slot
$cmax :: Slot -> Slot -> Slot
>= :: Slot -> Slot -> Bool
$c>= :: Slot -> Slot -> Bool
> :: Slot -> Slot -> Bool
$c> :: Slot -> Slot -> Bool
<= :: Slot -> Slot -> Bool
$c<= :: Slot -> Slot -> Bool
< :: Slot -> Slot -> Bool
$c< :: Slot -> Slot -> Bool
compare :: Slot -> Slot -> Ordering
$ccompare :: Slot -> Slot -> Ordering
$cp1Ord :: Eq Slot
Ord, Integer -> Slot
Slot -> Integer
Slot -> Slot
(Slot -> Slot)
-> (Slot -> Slot)
-> (Integer -> Slot)
-> (Slot -> Integer)
-> Enum Slot
forall a.
(a -> a) -> (a -> a) -> (Integer -> a) -> (a -> Integer) -> Enum a
fromEnum :: Slot -> Integer
$cfromEnum :: Slot -> Integer
toEnum :: Integer -> Slot
$ctoEnum :: Integer -> Slot
pred :: Slot -> Slot
$cpred :: Slot -> Slot
succ :: Slot -> Slot
$csucc :: Slot -> Slot
Enum, Slot -> BuiltinData
(Slot -> BuiltinData) -> ToData Slot
forall a. (a -> BuiltinData) -> ToData a
toBuiltinData :: Slot -> BuiltinData
$ctoBuiltinData :: Slot -> BuiltinData
PlutusTx.ToData, BuiltinData -> Maybe Slot
(BuiltinData -> Maybe Slot) -> FromData Slot
forall a. (BuiltinData -> Maybe a) -> FromData a
fromBuiltinData :: BuiltinData -> Maybe Slot
$cfromBuiltinData :: BuiltinData -> Maybe Slot
PlutusTx.FromData, BuiltinData -> Slot
(BuiltinData -> Slot) -> UnsafeFromData Slot
forall a. (BuiltinData -> a) -> UnsafeFromData a
unsafeFromBuiltinData :: BuiltinData -> Slot
$cunsafeFromBuiltinData :: BuiltinData -> Slot
PlutusTx.UnsafeFromData)
    deriving newtype (Integer -> Slot
Slot -> Slot
Slot -> Slot -> Slot
(Slot -> Slot -> Slot)
-> (Slot -> Slot -> Slot)
-> (Slot -> Slot -> Slot)
-> (Slot -> Slot)
-> (Slot -> Slot)
-> (Slot -> Slot)
-> (Integer -> Slot)
-> Num Slot
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Slot
$cfromInteger :: Integer -> Slot
signum :: Slot -> Slot
$csignum :: Slot -> Slot
abs :: Slot -> Slot
$cabs :: Slot -> Slot
negate :: Slot -> Slot
$cnegate :: Slot -> Slot
* :: Slot -> Slot -> Slot
$c* :: Slot -> Slot -> Slot
- :: Slot -> Slot -> Slot
$c- :: Slot -> Slot -> Slot
+ :: Slot -> Slot -> Slot
$c+ :: Slot -> Slot -> Slot
Haskell.Num, Int -> Slot
Slot -> Int
Slot -> [Slot]
Slot -> Slot
Slot -> Slot -> [Slot]
Slot -> Slot -> Slot -> [Slot]
(Slot -> Slot)
-> (Slot -> Slot)
-> (Int -> Slot)
-> (Slot -> Int)
-> (Slot -> [Slot])
-> (Slot -> Slot -> [Slot])
-> (Slot -> Slot -> [Slot])
-> (Slot -> Slot -> Slot -> [Slot])
-> Enum Slot
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 :: Slot -> Slot -> Slot -> [Slot]
$cenumFromThenTo :: Slot -> Slot -> Slot -> [Slot]
enumFromTo :: Slot -> Slot -> [Slot]
$cenumFromTo :: Slot -> Slot -> [Slot]
enumFromThen :: Slot -> Slot -> [Slot]
$cenumFromThen :: Slot -> Slot -> [Slot]
enumFrom :: Slot -> [Slot]
$cenumFrom :: Slot -> [Slot]
fromEnum :: Slot -> Int
$cfromEnum :: Slot -> Int
toEnum :: Int -> Slot
$ctoEnum :: Int -> Slot
pred :: Slot -> Slot
$cpred :: Slot -> Slot
succ :: Slot -> Slot
$csucc :: Slot -> Slot
Haskell.Enum, Num Slot
Ord Slot
Num Slot -> Ord Slot -> (Slot -> Rational) -> Real Slot
Slot -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Slot -> Rational
$ctoRational :: Slot -> Rational
$cp2Real :: Ord Slot
$cp1Real :: Num Slot
Haskell.Real, Enum Slot
Real Slot
Real Slot
-> Enum Slot
-> (Slot -> Slot -> Slot)
-> (Slot -> Slot -> Slot)
-> (Slot -> Slot -> Slot)
-> (Slot -> Slot -> Slot)
-> (Slot -> Slot -> (Slot, Slot))
-> (Slot -> Slot -> (Slot, Slot))
-> (Slot -> Integer)
-> Integral Slot
Slot -> Integer
Slot -> Slot -> (Slot, Slot)
Slot -> Slot -> Slot
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 :: Slot -> Integer
$ctoInteger :: Slot -> Integer
divMod :: Slot -> Slot -> (Slot, Slot)
$cdivMod :: Slot -> Slot -> (Slot, Slot)
quotRem :: Slot -> Slot -> (Slot, Slot)
$cquotRem :: Slot -> Slot -> (Slot, Slot)
mod :: Slot -> Slot -> Slot
$cmod :: Slot -> Slot -> Slot
div :: Slot -> Slot -> Slot
$cdiv :: Slot -> Slot -> Slot
rem :: Slot -> Slot -> Slot
$crem :: Slot -> Slot -> Slot
quot :: Slot -> Slot -> Slot
$cquot :: Slot -> Slot -> Slot
$cp2Integral :: Enum Slot
$cp1Integral :: Real Slot
Haskell.Integral, Decoder s Slot
Decoder s [Slot]
[Slot] -> Encoding
Slot -> Encoding
(Slot -> Encoding)
-> (forall s. Decoder s Slot)
-> ([Slot] -> Encoding)
-> (forall s. Decoder s [Slot])
-> Serialise Slot
forall s. Decoder s [Slot]
forall s. Decoder s Slot
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [Slot]
$cdecodeList :: forall s. Decoder s [Slot]
encodeList :: [Slot] -> Encoding
$cencodeList :: [Slot] -> Encoding
decode :: Decoder s Slot
$cdecode :: forall s. Decoder s Slot
encode :: Slot -> Encoding
$cencode :: Slot -> Encoding
Serialise, Int -> Slot -> Int
Slot -> Int
(Int -> Slot -> Int) -> (Slot -> Int) -> Hashable Slot
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Slot -> Int
$chash :: Slot -> Int
hashWithSalt :: Int -> Slot -> Int
$chashWithSalt :: Int -> Slot -> Int
Hashable)

makeLift ''Slot

instance Pretty Slot where
    pretty :: Slot -> Doc ann
pretty (Slot Integer
i) = Doc ann
"Slot" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i

-- | An 'Interval' of 'Slot's.
type SlotRange = Interval Slot

{-# INLINABLE width #-}
-- | Number of 'Slot's covered by the interval, if finite. @width (from x) == Nothing@.
width :: SlotRange -> Maybe Integer
width :: SlotRange -> Maybe Integer
width (Interval (LowerBound (Finite (Slot Integer
s1)) Bool
in1) (UpperBound (Finite (Slot Integer
s2)) Bool
in2)) =
    let lowestValue :: Integer
lowestValue = if Bool
in1 then Integer
s1 else Integer
s1 Integer -> Integer -> Integer
forall a. AdditiveSemigroup a => a -> a -> a
+ Integer
1
        highestValue :: Integer
highestValue = if Bool
in2 then Integer
s2 else Integer
s2 Integer -> Integer -> Integer
forall a. AdditiveGroup a => a -> a -> a
- Integer
1
    in if Integer
lowestValue Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
highestValue
    -- +1 avoids fencepost error: width of [2,4] is 3.
    then Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ (Integer
highestValue Integer -> Integer -> Integer
forall a. AdditiveGroup a => a -> a -> a
- Integer
lowestValue) Integer -> Integer -> Integer
forall a. AdditiveSemigroup a => a -> a -> a
+ Integer
1
    -- low > high, i.e. empty interval
    else Maybe Integer
forall a. Maybe a
Nothing
-- Infinity is involved!
width SlotRange
_ = Maybe Integer
forall a. Maybe a
Nothing


deriving anyclass instance (Hashable a) => Hashable (Interval a)
deriving anyclass instance (Serialise a) => Serialise (Interval a)
deriving anyclass instance (ToJSON a) => ToJSON (Interval a)
deriving anyclass instance (FromJSON a) => FromJSON (Interval a)

deriving anyclass instance (Hashable a) => Hashable (LowerBound a)
deriving anyclass instance (Serialise a) => Serialise (LowerBound a)
deriving anyclass instance (ToJSON a) => ToJSON (LowerBound a)
deriving anyclass instance (FromJSON a) => FromJSON (LowerBound a)

deriving anyclass instance (Hashable a) => Hashable (UpperBound a)
deriving anyclass instance (Serialise a) => Serialise (UpperBound a)
deriving anyclass instance (ToJSON a) => ToJSON (UpperBound a)
deriving anyclass instance (FromJSON a) => FromJSON (UpperBound a)

deriving anyclass instance (Hashable a) => Hashable (Extended a)
deriving anyclass instance (Serialise a) => Serialise (Extended a)
deriving anyclass instance (ToJSON a) => ToJSON (Extended a)
deriving anyclass instance (FromJSON a) => FromJSON (Extended a)