{-# LANGUAGE DeriveAnyClass       #-}
{-# LANGUAGE DeriveGeneric        #-}
{-# LANGUAGE DerivingStrategies   #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE MonoLocalBinds       #-}
{-# LANGUAGE NoImplicitPrelude    #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
{-# OPTIONS_GHC -fno-specialise #-}
{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}

-- | A type for intervals and associated functions.
module Plutus.V1.Ledger.Interval(
      Interval(..)
    , UpperBound(..)
    , LowerBound(..)
    , Extended(..)
    , Closure
    , member
    , interval
    , from
    , to
    , always
    , never
    , singleton
    , hull
    , intersection
    , overlaps
    , contains
    , isEmpty
    , before
    , after
    , lowerBound
    , upperBound
    , strictLowerBound
    , strictUpperBound
    ) where

import Control.DeepSeq (NFData)
import GHC.Generics (Generic)
import Prelude qualified as Haskell
import Prettyprinter (Pretty (pretty), comma, (<+>))

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

-- | An interval of @a@s.
--
--   The interval may be either closed or open at either end, meaning
--   that the endpoints may or may not be included in the interval.
--
--   The interval can also be unbounded on either side.
data Interval a = Interval { Interval a -> LowerBound a
ivFrom :: LowerBound a, Interval a -> UpperBound a
ivTo :: UpperBound a }
    deriving stock (Interval a -> Interval a -> Bool
(Interval a -> Interval a -> Bool)
-> (Interval a -> Interval a -> Bool) -> Eq (Interval a)
forall a. Eq a => Interval a -> Interval a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Interval a -> Interval a -> Bool
$c/= :: forall a. Eq a => Interval a -> Interval a -> Bool
== :: Interval a -> Interval a -> Bool
$c== :: forall a. Eq a => Interval a -> Interval a -> Bool
Haskell.Eq, Eq (Interval a)
Eq (Interval a)
-> (Interval a -> Interval a -> Ordering)
-> (Interval a -> Interval a -> Bool)
-> (Interval a -> Interval a -> Bool)
-> (Interval a -> Interval a -> Bool)
-> (Interval a -> Interval a -> Bool)
-> (Interval a -> Interval a -> Interval a)
-> (Interval a -> Interval a -> Interval a)
-> Ord (Interval a)
Interval a -> Interval a -> Bool
Interval a -> Interval a -> Ordering
Interval a -> Interval a -> Interval 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 (Interval a)
forall a. Ord a => Interval a -> Interval a -> Bool
forall a. Ord a => Interval a -> Interval a -> Ordering
forall a. Ord a => Interval a -> Interval a -> Interval a
min :: Interval a -> Interval a -> Interval a
$cmin :: forall a. Ord a => Interval a -> Interval a -> Interval a
max :: Interval a -> Interval a -> Interval a
$cmax :: forall a. Ord a => Interval a -> Interval a -> Interval a
>= :: Interval a -> Interval a -> Bool
$c>= :: forall a. Ord a => Interval a -> Interval a -> Bool
> :: Interval a -> Interval a -> Bool
$c> :: forall a. Ord a => Interval a -> Interval a -> Bool
<= :: Interval a -> Interval a -> Bool
$c<= :: forall a. Ord a => Interval a -> Interval a -> Bool
< :: Interval a -> Interval a -> Bool
$c< :: forall a. Ord a => Interval a -> Interval a -> Bool
compare :: Interval a -> Interval a -> Ordering
$ccompare :: forall a. Ord a => Interval a -> Interval a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Interval a)
Haskell.Ord, Int -> Interval a -> ShowS
[Interval a] -> ShowS
Interval a -> String
(Int -> Interval a -> ShowS)
-> (Interval a -> String)
-> ([Interval a] -> ShowS)
-> Show (Interval a)
forall a. Show a => Int -> Interval a -> ShowS
forall a. Show a => [Interval a] -> ShowS
forall a. Show a => Interval a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Interval a] -> ShowS
$cshowList :: forall a. Show a => [Interval a] -> ShowS
show :: Interval a -> String
$cshow :: forall a. Show a => Interval a -> String
showsPrec :: Int -> Interval a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Interval a -> ShowS
Haskell.Show, (forall x. Interval a -> Rep (Interval a) x)
-> (forall x. Rep (Interval a) x -> Interval a)
-> Generic (Interval a)
forall x. Rep (Interval a) x -> Interval a
forall x. Interval a -> Rep (Interval a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Interval a) x -> Interval a
forall a x. Interval a -> Rep (Interval a) x
$cto :: forall a x. Rep (Interval a) x -> Interval a
$cfrom :: forall a x. Interval a -> Rep (Interval a) x
Generic)
    deriving anyclass (Interval a -> ()
(Interval a -> ()) -> NFData (Interval a)
forall a. NFData a => Interval a -> ()
forall a. (a -> ()) -> NFData a
rnf :: Interval a -> ()
$crnf :: forall a. NFData a => Interval a -> ()
NFData)

instance Functor Interval where
  fmap :: (a -> b) -> Interval a -> Interval b
fmap a -> b
f (Interval LowerBound a
from UpperBound a
to) = LowerBound b -> UpperBound b -> Interval b
forall a. LowerBound a -> UpperBound a -> Interval a
Interval (a -> b
f (a -> b) -> LowerBound a -> LowerBound b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LowerBound a
from) (a -> b
f (a -> b) -> UpperBound a -> UpperBound b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UpperBound a
to)

instance Pretty a => Pretty (Interval a) where
    pretty :: Interval a -> Doc ann
pretty (Interval LowerBound a
l UpperBound a
h) = LowerBound a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty LowerBound a
l Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
comma Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> UpperBound a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty UpperBound a
h

-- | A set extended with a positive and negative infinity.
data Extended a = NegInf | Finite a | PosInf
    deriving stock (Extended a -> Extended a -> Bool
(Extended a -> Extended a -> Bool)
-> (Extended a -> Extended a -> Bool) -> Eq (Extended a)
forall a. Eq a => Extended a -> Extended a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Extended a -> Extended a -> Bool
$c/= :: forall a. Eq a => Extended a -> Extended a -> Bool
== :: Extended a -> Extended a -> Bool
$c== :: forall a. Eq a => Extended a -> Extended a -> Bool
Haskell.Eq, Eq (Extended a)
Eq (Extended a)
-> (Extended a -> Extended a -> Ordering)
-> (Extended a -> Extended a -> Bool)
-> (Extended a -> Extended a -> Bool)
-> (Extended a -> Extended a -> Bool)
-> (Extended a -> Extended a -> Bool)
-> (Extended a -> Extended a -> Extended a)
-> (Extended a -> Extended a -> Extended a)
-> Ord (Extended a)
Extended a -> Extended a -> Bool
Extended a -> Extended a -> Ordering
Extended a -> Extended a -> Extended 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 (Extended a)
forall a. Ord a => Extended a -> Extended a -> Bool
forall a. Ord a => Extended a -> Extended a -> Ordering
forall a. Ord a => Extended a -> Extended a -> Extended a
min :: Extended a -> Extended a -> Extended a
$cmin :: forall a. Ord a => Extended a -> Extended a -> Extended a
max :: Extended a -> Extended a -> Extended a
$cmax :: forall a. Ord a => Extended a -> Extended a -> Extended a
>= :: Extended a -> Extended a -> Bool
$c>= :: forall a. Ord a => Extended a -> Extended a -> Bool
> :: Extended a -> Extended a -> Bool
$c> :: forall a. Ord a => Extended a -> Extended a -> Bool
<= :: Extended a -> Extended a -> Bool
$c<= :: forall a. Ord a => Extended a -> Extended a -> Bool
< :: Extended a -> Extended a -> Bool
$c< :: forall a. Ord a => Extended a -> Extended a -> Bool
compare :: Extended a -> Extended a -> Ordering
$ccompare :: forall a. Ord a => Extended a -> Extended a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Extended a)
Haskell.Ord, Int -> Extended a -> ShowS
[Extended a] -> ShowS
Extended a -> String
(Int -> Extended a -> ShowS)
-> (Extended a -> String)
-> ([Extended a] -> ShowS)
-> Show (Extended a)
forall a. Show a => Int -> Extended a -> ShowS
forall a. Show a => [Extended a] -> ShowS
forall a. Show a => Extended a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Extended a] -> ShowS
$cshowList :: forall a. Show a => [Extended a] -> ShowS
show :: Extended a -> String
$cshow :: forall a. Show a => Extended a -> String
showsPrec :: Int -> Extended a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Extended a -> ShowS
Haskell.Show, (forall x. Extended a -> Rep (Extended a) x)
-> (forall x. Rep (Extended a) x -> Extended a)
-> Generic (Extended a)
forall x. Rep (Extended a) x -> Extended a
forall x. Extended a -> Rep (Extended a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Extended a) x -> Extended a
forall a x. Extended a -> Rep (Extended a) x
$cto :: forall a x. Rep (Extended a) x -> Extended a
$cfrom :: forall a x. Extended a -> Rep (Extended a) x
Generic)
    deriving anyclass (Extended a -> ()
(Extended a -> ()) -> NFData (Extended a)
forall a. NFData a => Extended a -> ()
forall a. (a -> ()) -> NFData a
rnf :: Extended a -> ()
$crnf :: forall a. NFData a => Extended a -> ()
NFData)

instance Functor Extended where
  fmap :: (a -> b) -> Extended a -> Extended b
fmap a -> b
_ Extended a
NegInf     = Extended b
forall a. Extended a
NegInf
  fmap a -> b
f (Finite a
a) = b -> Extended b
forall a. a -> Extended a
Finite (a -> b
f a
a)
  fmap a -> b
_ Extended a
PosInf     = Extended b
forall a. Extended a
PosInf

instance Pretty a => Pretty (Extended a) where
    pretty :: Extended a -> Doc ann
pretty Extended a
NegInf     = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"-∞"
    pretty Extended a
PosInf     = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"+∞"
    pretty (Finite a
a) = a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
a

-- | Whether a bound is inclusive or not.
type Closure = Bool

-- | The upper bound of an interval.
data UpperBound a = UpperBound (Extended a) Closure
    deriving stock (UpperBound a -> UpperBound a -> Bool
(UpperBound a -> UpperBound a -> Bool)
-> (UpperBound a -> UpperBound a -> Bool) -> Eq (UpperBound a)
forall a. Eq a => UpperBound a -> UpperBound a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpperBound a -> UpperBound a -> Bool
$c/= :: forall a. Eq a => UpperBound a -> UpperBound a -> Bool
== :: UpperBound a -> UpperBound a -> Bool
$c== :: forall a. Eq a => UpperBound a -> UpperBound a -> Bool
Haskell.Eq, Eq (UpperBound a)
Eq (UpperBound a)
-> (UpperBound a -> UpperBound a -> Ordering)
-> (UpperBound a -> UpperBound a -> Bool)
-> (UpperBound a -> UpperBound a -> Bool)
-> (UpperBound a -> UpperBound a -> Bool)
-> (UpperBound a -> UpperBound a -> Bool)
-> (UpperBound a -> UpperBound a -> UpperBound a)
-> (UpperBound a -> UpperBound a -> UpperBound a)
-> Ord (UpperBound a)
UpperBound a -> UpperBound a -> Bool
UpperBound a -> UpperBound a -> Ordering
UpperBound a -> UpperBound a -> UpperBound 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 (UpperBound a)
forall a. Ord a => UpperBound a -> UpperBound a -> Bool
forall a. Ord a => UpperBound a -> UpperBound a -> Ordering
forall a. Ord a => UpperBound a -> UpperBound a -> UpperBound a
min :: UpperBound a -> UpperBound a -> UpperBound a
$cmin :: forall a. Ord a => UpperBound a -> UpperBound a -> UpperBound a
max :: UpperBound a -> UpperBound a -> UpperBound a
$cmax :: forall a. Ord a => UpperBound a -> UpperBound a -> UpperBound a
>= :: UpperBound a -> UpperBound a -> Bool
$c>= :: forall a. Ord a => UpperBound a -> UpperBound a -> Bool
> :: UpperBound a -> UpperBound a -> Bool
$c> :: forall a. Ord a => UpperBound a -> UpperBound a -> Bool
<= :: UpperBound a -> UpperBound a -> Bool
$c<= :: forall a. Ord a => UpperBound a -> UpperBound a -> Bool
< :: UpperBound a -> UpperBound a -> Bool
$c< :: forall a. Ord a => UpperBound a -> UpperBound a -> Bool
compare :: UpperBound a -> UpperBound a -> Ordering
$ccompare :: forall a. Ord a => UpperBound a -> UpperBound a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (UpperBound a)
Haskell.Ord, Int -> UpperBound a -> ShowS
[UpperBound a] -> ShowS
UpperBound a -> String
(Int -> UpperBound a -> ShowS)
-> (UpperBound a -> String)
-> ([UpperBound a] -> ShowS)
-> Show (UpperBound a)
forall a. Show a => Int -> UpperBound a -> ShowS
forall a. Show a => [UpperBound a] -> ShowS
forall a. Show a => UpperBound a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpperBound a] -> ShowS
$cshowList :: forall a. Show a => [UpperBound a] -> ShowS
show :: UpperBound a -> String
$cshow :: forall a. Show a => UpperBound a -> String
showsPrec :: Int -> UpperBound a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> UpperBound a -> ShowS
Haskell.Show, (forall x. UpperBound a -> Rep (UpperBound a) x)
-> (forall x. Rep (UpperBound a) x -> UpperBound a)
-> Generic (UpperBound a)
forall x. Rep (UpperBound a) x -> UpperBound a
forall x. UpperBound a -> Rep (UpperBound a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (UpperBound a) x -> UpperBound a
forall a x. UpperBound a -> Rep (UpperBound a) x
$cto :: forall a x. Rep (UpperBound a) x -> UpperBound a
$cfrom :: forall a x. UpperBound a -> Rep (UpperBound a) x
Generic)
    deriving anyclass (UpperBound a -> ()
(UpperBound a -> ()) -> NFData (UpperBound a)
forall a. NFData a => UpperBound a -> ()
forall a. (a -> ()) -> NFData a
rnf :: UpperBound a -> ()
$crnf :: forall a. NFData a => UpperBound a -> ()
NFData)

instance Functor UpperBound where
  fmap :: (a -> b) -> UpperBound a -> UpperBound b
fmap a -> b
f (UpperBound Extended a
e Bool
c) = Extended b -> Bool -> UpperBound b
forall a. Extended a -> Bool -> UpperBound a
UpperBound (a -> b
f (a -> b) -> Extended a -> Extended b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Extended a
e) Bool
c

instance Pretty a => Pretty (UpperBound a) where
    pretty :: UpperBound a -> Doc ann
pretty (UpperBound Extended a
PosInf Bool
_) = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"+∞)"
    pretty (UpperBound Extended a
NegInf Bool
_) = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"-∞)"
    pretty (UpperBound Extended a
a Bool
True)   = Extended a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Extended a
a Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"]"
    pretty (UpperBound Extended a
a Bool
False)  = Extended a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Extended a
a Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
")"

-- | The lower bound of an interval.
data LowerBound a = LowerBound (Extended a) Closure
    deriving stock (LowerBound a -> LowerBound a -> Bool
(LowerBound a -> LowerBound a -> Bool)
-> (LowerBound a -> LowerBound a -> Bool) -> Eq (LowerBound a)
forall a. Eq a => LowerBound a -> LowerBound a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LowerBound a -> LowerBound a -> Bool
$c/= :: forall a. Eq a => LowerBound a -> LowerBound a -> Bool
== :: LowerBound a -> LowerBound a -> Bool
$c== :: forall a. Eq a => LowerBound a -> LowerBound a -> Bool
Haskell.Eq, Eq (LowerBound a)
Eq (LowerBound a)
-> (LowerBound a -> LowerBound a -> Ordering)
-> (LowerBound a -> LowerBound a -> Bool)
-> (LowerBound a -> LowerBound a -> Bool)
-> (LowerBound a -> LowerBound a -> Bool)
-> (LowerBound a -> LowerBound a -> Bool)
-> (LowerBound a -> LowerBound a -> LowerBound a)
-> (LowerBound a -> LowerBound a -> LowerBound a)
-> Ord (LowerBound a)
LowerBound a -> LowerBound a -> Bool
LowerBound a -> LowerBound a -> Ordering
LowerBound a -> LowerBound a -> LowerBound 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 (LowerBound a)
forall a. Ord a => LowerBound a -> LowerBound a -> Bool
forall a. Ord a => LowerBound a -> LowerBound a -> Ordering
forall a. Ord a => LowerBound a -> LowerBound a -> LowerBound a
min :: LowerBound a -> LowerBound a -> LowerBound a
$cmin :: forall a. Ord a => LowerBound a -> LowerBound a -> LowerBound a
max :: LowerBound a -> LowerBound a -> LowerBound a
$cmax :: forall a. Ord a => LowerBound a -> LowerBound a -> LowerBound a
>= :: LowerBound a -> LowerBound a -> Bool
$c>= :: forall a. Ord a => LowerBound a -> LowerBound a -> Bool
> :: LowerBound a -> LowerBound a -> Bool
$c> :: forall a. Ord a => LowerBound a -> LowerBound a -> Bool
<= :: LowerBound a -> LowerBound a -> Bool
$c<= :: forall a. Ord a => LowerBound a -> LowerBound a -> Bool
< :: LowerBound a -> LowerBound a -> Bool
$c< :: forall a. Ord a => LowerBound a -> LowerBound a -> Bool
compare :: LowerBound a -> LowerBound a -> Ordering
$ccompare :: forall a. Ord a => LowerBound a -> LowerBound a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (LowerBound a)
Haskell.Ord, Int -> LowerBound a -> ShowS
[LowerBound a] -> ShowS
LowerBound a -> String
(Int -> LowerBound a -> ShowS)
-> (LowerBound a -> String)
-> ([LowerBound a] -> ShowS)
-> Show (LowerBound a)
forall a. Show a => Int -> LowerBound a -> ShowS
forall a. Show a => [LowerBound a] -> ShowS
forall a. Show a => LowerBound a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LowerBound a] -> ShowS
$cshowList :: forall a. Show a => [LowerBound a] -> ShowS
show :: LowerBound a -> String
$cshow :: forall a. Show a => LowerBound a -> String
showsPrec :: Int -> LowerBound a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> LowerBound a -> ShowS
Haskell.Show, (forall x. LowerBound a -> Rep (LowerBound a) x)
-> (forall x. Rep (LowerBound a) x -> LowerBound a)
-> Generic (LowerBound a)
forall x. Rep (LowerBound a) x -> LowerBound a
forall x. LowerBound a -> Rep (LowerBound a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (LowerBound a) x -> LowerBound a
forall a x. LowerBound a -> Rep (LowerBound a) x
$cto :: forall a x. Rep (LowerBound a) x -> LowerBound a
$cfrom :: forall a x. LowerBound a -> Rep (LowerBound a) x
Generic)
    deriving anyclass (LowerBound a -> ()
(LowerBound a -> ()) -> NFData (LowerBound a)
forall a. NFData a => LowerBound a -> ()
forall a. (a -> ()) -> NFData a
rnf :: LowerBound a -> ()
$crnf :: forall a. NFData a => LowerBound a -> ()
NFData)

instance Functor LowerBound where
  fmap :: (a -> b) -> LowerBound a -> LowerBound b
fmap a -> b
f (LowerBound Extended a
e Bool
c) = Extended b -> Bool -> LowerBound b
forall a. Extended a -> Bool -> LowerBound a
LowerBound (a -> b
f (a -> b) -> Extended a -> Extended b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Extended a
e) Bool
c

instance Pretty a => Pretty (LowerBound a) where
    pretty :: LowerBound a -> Doc ann
pretty (LowerBound Extended a
PosInf Bool
_) = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"(+∞"
    pretty (LowerBound Extended a
NegInf Bool
_) = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"(-∞"
    pretty (LowerBound Extended a
a Bool
True)   = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"[" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Extended a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Extended a
a
    pretty (LowerBound Extended a
a Bool
False)  = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"(" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Extended a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Extended a
a

PlutusTx.makeIsDataIndexed ''Extended [('NegInf,0),('Finite,1),('PosInf,2)]
PlutusTx.makeIsDataIndexed ''UpperBound [('UpperBound,0)]
PlutusTx.makeIsDataIndexed ''LowerBound [('LowerBound,0)]
PlutusTx.makeIsDataIndexed ''Interval [('Interval,0)]

makeLift ''Extended
makeLift ''LowerBound
makeLift ''UpperBound
makeLift ''Interval

instance Eq a => Eq (Extended a) where
    {-# INLINABLE (==) #-}
    Extended a
NegInf   == :: Extended a -> Extended a -> Bool
== Extended a
NegInf   = Bool
True
    Extended a
PosInf   == Extended a
PosInf   = Bool
True
    Finite a
l == Finite a
r = a
l a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
r
    Extended a
_        == Extended a
_        = Bool
False

instance Ord a => Ord (Extended a) where
    {-# INLINABLE compare #-}
    Extended a
NegInf   compare :: Extended a -> Extended a -> Ordering
`compare` Extended a
NegInf   = Ordering
EQ
    Extended a
NegInf   `compare` Extended a
_        = Ordering
LT
    Extended a
_        `compare` Extended a
NegInf   = Ordering
GT
    Extended a
PosInf   `compare` Extended a
PosInf   = Ordering
EQ
    Extended a
_        `compare` Extended a
PosInf   = Ordering
LT
    Extended a
PosInf   `compare` Extended a
_        = Ordering
GT
    Finite a
l `compare` Finite a
r = a
l a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` a
r

instance Eq a => Eq (UpperBound a) where
    {-# INLINABLE (==) #-}
    UpperBound Extended a
v1 Bool
in1 == :: UpperBound a -> UpperBound a -> Bool
== UpperBound Extended a
v2 Bool
in2 = Extended a
v1 Extended a -> Extended a -> Bool
forall a. Eq a => a -> a -> Bool
== Extended a
v2 Bool -> Bool -> Bool
&& Bool
in1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
in2

instance Ord a => Ord (UpperBound a) where
    {-# INLINABLE compare #-}
    UpperBound Extended a
v1 Bool
in1 compare :: UpperBound a -> UpperBound a -> Ordering
`compare` UpperBound Extended a
v2 Bool
in2 = case Extended a
v1 Extended a -> Extended a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Extended a
v2 of
        Ordering
LT -> Ordering
LT
        Ordering
GT -> Ordering
GT
        -- A closed upper bound is bigger than an open upper bound. This corresponds
        -- to the normal order on Bool.
        Ordering
EQ -> Bool
in1 Bool -> Bool -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Bool
in2

instance Eq a => Eq (LowerBound a) where
    {-# INLINABLE (==) #-}
    LowerBound Extended a
v1 Bool
in1 == :: LowerBound a -> LowerBound a -> Bool
== LowerBound Extended a
v2 Bool
in2 = Extended a
v1 Extended a -> Extended a -> Bool
forall a. Eq a => a -> a -> Bool
== Extended a
v2 Bool -> Bool -> Bool
&& Bool
in1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
in2

instance Ord a => Ord (LowerBound a) where
    {-# INLINABLE compare #-}
    LowerBound Extended a
v1 Bool
in1 compare :: LowerBound a -> LowerBound a -> Ordering
`compare` LowerBound Extended a
v2 Bool
in2 = case Extended a
v1 Extended a -> Extended a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Extended a
v2 of
        Ordering
LT -> Ordering
LT
        Ordering
GT -> Ordering
GT
        -- An open lower bound is bigger than a closed lower bound. This corresponds
        -- to the *reverse* of the normal order on Bool.
        Ordering
EQ -> Bool
in2 Bool -> Bool -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Bool
in1

{-# INLINABLE strictUpperBound #-}
strictUpperBound :: a -> UpperBound a
strictUpperBound :: a -> UpperBound a
strictUpperBound a
a = Extended a -> Bool -> UpperBound a
forall a. Extended a -> Bool -> UpperBound a
UpperBound (a -> Extended a
forall a. a -> Extended a
Finite a
a) Bool
False

{-# INLINABLE strictLowerBound #-}
strictLowerBound :: a -> LowerBound a
strictLowerBound :: a -> LowerBound a
strictLowerBound a
a = Extended a -> Bool -> LowerBound a
forall a. Extended a -> Bool -> LowerBound a
LowerBound (a -> Extended a
forall a. a -> Extended a
Finite a
a) Bool
False

{-# INLINABLE lowerBound #-}
lowerBound :: a -> LowerBound a
lowerBound :: a -> LowerBound a
lowerBound a
a = Extended a -> Bool -> LowerBound a
forall a. Extended a -> Bool -> LowerBound a
LowerBound (a -> Extended a
forall a. a -> Extended a
Finite a
a) Bool
True

{-# INLINABLE upperBound #-}
upperBound :: a -> UpperBound a
upperBound :: a -> UpperBound a
upperBound a
a = Extended a -> Bool -> UpperBound a
forall a. Extended a -> Bool -> UpperBound a
UpperBound (a -> Extended a
forall a. a -> Extended a
Finite a
a) Bool
True

instance Ord a => JoinSemiLattice (Interval a) where
    {-# INLINABLE (\/) #-}
    \/ :: Interval a -> Interval a -> Interval a
(\/) = Interval a -> Interval a -> Interval a
forall a. Ord a => Interval a -> Interval a -> Interval a
hull

instance Ord a => BoundedJoinSemiLattice (Interval a) where
    {-# INLINABLE bottom #-}
    bottom :: Interval a
bottom = Interval a
forall a. Interval a
never

instance Ord a => MeetSemiLattice (Interval a) where
    {-# INLINABLE (/\) #-}
    /\ :: Interval a -> Interval a -> Interval a
(/\) = Interval a -> Interval a -> Interval a
forall a. Ord a => Interval a -> Interval a -> Interval a
intersection

instance Ord a => BoundedMeetSemiLattice (Interval a) where
    {-# INLINABLE top #-}
    top :: Interval a
top = Interval a
forall a. Interval a
always

instance Eq a => Eq (Interval a) where
    {-# INLINABLE (==) #-}
    Interval a
l == :: Interval a -> Interval a -> Bool
== Interval a
r = Interval a -> LowerBound a
forall a. Interval a -> LowerBound a
ivFrom Interval a
l LowerBound a -> LowerBound a -> Bool
forall a. Eq a => a -> a -> Bool
== Interval a -> LowerBound a
forall a. Interval a -> LowerBound a
ivFrom Interval a
r Bool -> Bool -> Bool
&& Interval a -> UpperBound a
forall a. Interval a -> UpperBound a
ivTo Interval a
l UpperBound a -> UpperBound a -> Bool
forall a. Eq a => a -> a -> Bool
== Interval a -> UpperBound a
forall a. Interval a -> UpperBound a
ivTo Interval a
r

{-# INLINABLE interval #-}
-- | @interval a b@ includes all values that are greater than or equal to @a@
-- and smaller than or equal to @b@. Therefore it includes @a@ and @b@.
interval :: a -> a -> Interval a
interval :: a -> a -> Interval a
interval a
s a
s' = LowerBound a -> UpperBound a -> Interval a
forall a. LowerBound a -> UpperBound a -> Interval a
Interval (a -> LowerBound a
forall a. a -> LowerBound a
lowerBound a
s) (a -> UpperBound a
forall a. a -> UpperBound a
upperBound a
s')

{-# INLINABLE singleton #-}
singleton :: a -> Interval a
singleton :: a -> Interval a
singleton a
s = a -> a -> Interval a
forall a. a -> a -> Interval a
interval a
s a
s

{-# INLINABLE from #-}
-- | @from a@ is an 'Interval' that includes all values that are
--  greater than or equal to @a@.
from :: a -> Interval a
from :: a -> Interval a
from a
s = LowerBound a -> UpperBound a -> Interval a
forall a. LowerBound a -> UpperBound a -> Interval a
Interval (a -> LowerBound a
forall a. a -> LowerBound a
lowerBound a
s) (Extended a -> Bool -> UpperBound a
forall a. Extended a -> Bool -> UpperBound a
UpperBound Extended a
forall a. Extended a
PosInf Bool
True)

{-# INLINABLE to #-}
-- | @to a@ is an 'Interval' that includes all values that are
--  smaller than or equal to @a@.
to :: a -> Interval a
to :: a -> Interval a
to a
s = LowerBound a -> UpperBound a -> Interval a
forall a. LowerBound a -> UpperBound a -> Interval a
Interval (Extended a -> Bool -> LowerBound a
forall a. Extended a -> Bool -> LowerBound a
LowerBound Extended a
forall a. Extended a
NegInf Bool
True) (a -> UpperBound a
forall a. a -> UpperBound a
upperBound a
s)

{-# INLINABLE always #-}
-- | An 'Interval' that covers every slot.
always :: Interval a
always :: Interval a
always = LowerBound a -> UpperBound a -> Interval a
forall a. LowerBound a -> UpperBound a -> Interval a
Interval (Extended a -> Bool -> LowerBound a
forall a. Extended a -> Bool -> LowerBound a
LowerBound Extended a
forall a. Extended a
NegInf Bool
True) (Extended a -> Bool -> UpperBound a
forall a. Extended a -> Bool -> UpperBound a
UpperBound Extended a
forall a. Extended a
PosInf Bool
True)

{-# INLINABLE never #-}
-- | An 'Interval' that is empty.
never :: Interval a
never :: Interval a
never = LowerBound a -> UpperBound a -> Interval a
forall a. LowerBound a -> UpperBound a -> Interval a
Interval (Extended a -> Bool -> LowerBound a
forall a. Extended a -> Bool -> LowerBound a
LowerBound Extended a
forall a. Extended a
PosInf Bool
True) (Extended a -> Bool -> UpperBound a
forall a. Extended a -> Bool -> UpperBound a
UpperBound Extended a
forall a. Extended a
NegInf Bool
True)

{-# INLINABLE member #-}
-- | Check whether a value is in an interval.
member :: Ord a => a -> Interval a -> Bool
member :: a -> Interval a -> Bool
member a
a Interval a
i = Interval a
i Interval a -> Interval a -> Bool
forall a. Ord a => Interval a -> Interval a -> Bool
`contains` a -> Interval a
forall a. a -> Interval a
singleton a
a

{-# INLINABLE overlaps #-}
-- | Check whether two intervals overlap, that is, whether there is a value that
--   is a member of both intervals.
overlaps :: (Enum a, Ord a) => Interval a -> Interval a -> Bool
overlaps :: Interval a -> Interval a -> Bool
overlaps Interval a
l Interval a
r = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Interval a -> Bool
forall a. (Enum a, Ord a) => Interval a -> Bool
isEmpty (Interval a
l Interval a -> Interval a -> Interval a
forall a. Ord a => Interval a -> Interval a -> Interval a
`intersection` Interval a
r)

{-# INLINABLE intersection #-}
-- | 'intersection a b' is the largest interval that is contained in 'a' and in
--   'b', if it exists.
intersection :: Ord a => Interval a -> Interval a -> Interval a
intersection :: Interval a -> Interval a -> Interval a
intersection (Interval LowerBound a
l1 UpperBound a
h1) (Interval LowerBound a
l2 UpperBound a
h2) = LowerBound a -> UpperBound a -> Interval a
forall a. LowerBound a -> UpperBound a -> Interval a
Interval (LowerBound a -> LowerBound a -> LowerBound a
forall a. Ord a => a -> a -> a
max LowerBound a
l1 LowerBound a
l2) (UpperBound a -> UpperBound a -> UpperBound a
forall a. Ord a => a -> a -> a
min UpperBound a
h1 UpperBound a
h2)

{-# INLINABLE hull #-}
-- | 'hull a b' is the smallest interval containing 'a' and 'b'.
hull :: Ord a => Interval a -> Interval a -> Interval a
hull :: Interval a -> Interval a -> Interval a
hull (Interval LowerBound a
l1 UpperBound a
h1) (Interval LowerBound a
l2 UpperBound a
h2) = LowerBound a -> UpperBound a -> Interval a
forall a. LowerBound a -> UpperBound a -> Interval a
Interval (LowerBound a -> LowerBound a -> LowerBound a
forall a. Ord a => a -> a -> a
min LowerBound a
l1 LowerBound a
l2) (UpperBound a -> UpperBound a -> UpperBound a
forall a. Ord a => a -> a -> a
max UpperBound a
h1 UpperBound a
h2)

{-# INLINABLE contains #-}
-- | @a `contains` b@ is true if the 'Interval' @b@ is entirely contained in
--   @a@. That is, @a `contains` b@ if for every entry @s@, if @member s b@ then
--   @member s a@.
contains :: Ord a => Interval a -> Interval a -> Bool
contains :: Interval a -> Interval a -> Bool
contains (Interval LowerBound a
l1 UpperBound a
h1) (Interval LowerBound a
l2 UpperBound a
h2) = LowerBound a
l1 LowerBound a -> LowerBound a -> Bool
forall a. Ord a => a -> a -> Bool
<= LowerBound a
l2 Bool -> Bool -> Bool
&& UpperBound a
h2 UpperBound a -> UpperBound a -> Bool
forall a. Ord a => a -> a -> Bool
<= UpperBound a
h1

{-# INLINABLE isEmpty #-}
-- | Check if an 'Interval' is empty.
isEmpty :: (Enum a, Ord a) => Interval a -> Bool
isEmpty :: Interval a -> Bool
isEmpty (Interval (LowerBound Extended a
v1 Bool
in1) (UpperBound Extended a
v2 Bool
in2)) = case Extended a
v1 Extended a -> Extended a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Extended a
v2 of
    Ordering
LT -> if Bool
openInterval then Extended a -> Extended a -> Bool
forall a. (Ord a, Enum a) => Extended a -> Extended a -> Bool
checkEnds Extended a
v1 Extended a
v2 else Bool
False
    Ordering
GT -> Bool
True
    Ordering
EQ -> Bool -> Bool
not (Bool
in1 Bool -> Bool -> Bool
&& Bool
in2)
    where
        openInterval :: Bool
openInterval = Bool
in1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False Bool -> Bool -> Bool
&& Bool
in2 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False
        -- | We check two finite ends to figure out if there are elements between them.
        -- If there are no elements then the interval is empty (#3467).
        checkEnds :: Extended a -> Extended a -> Bool
checkEnds (Finite a
v1') (Finite a
v2') = (a -> a
forall a. Enum a => a -> a
succ a
v1') a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` a
v2' Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
        checkEnds Extended a
_ Extended a
_                       = Bool
False

{-# INLINABLE before #-}
-- | Check if a value is earlier than the beginning of an 'Interval'.
before :: Ord a => a -> Interval a -> Bool
before :: a -> Interval a -> Bool
before a
h (Interval LowerBound a
f UpperBound a
_) = a -> LowerBound a
forall a. a -> LowerBound a
lowerBound a
h LowerBound a -> LowerBound a -> Bool
forall a. Ord a => a -> a -> Bool
< LowerBound a
f

{-# INLINABLE after #-}
-- | Check if a value is later than the end of a 'Interval'.
after :: Ord a => a -> Interval a -> Bool
after :: a -> Interval a -> Bool
after a
h (Interval LowerBound a
_ UpperBound a
t) = a -> UpperBound a
forall a. a -> UpperBound a
upperBound a
h UpperBound a -> UpperBound a -> Bool
forall a. Ord a => a -> a -> Bool
> UpperBound a
t