{-# OPTIONS_GHC -Wno-orphans #-}

-- | This module provides a way of accessing lower and upper bounds of
-- transaction validity through optics using @at@ and @ix@.
module Cooked.Skeleton.ValidityRange
  ( ValidityBound (..),
  )
where

import Ledger.Slot qualified as Ledger
import Optics.Core
import PlutusLedgerApi.V1.Interval qualified as Api

-- | A type used to index optics within a 'Ledger.SlotRange'. This allows the
-- usage of the following optics: @at Lower@, @at Upper@, @ix Lower@ and @ix
-- Upper@ to modify parts of a slot range. When set to @Nothing@, the associated
-- bound of the interval is considered infinite, and otherwise it is considered
-- finite, with closed closure.
data ValidityBound
  = Lower
  | Upper

type instance Index Ledger.SlotRange = ValidityBound

type instance IxValue Ledger.SlotRange = Ledger.Slot

instance Ixed Ledger.SlotRange

instance At Ledger.SlotRange where
  at :: Index SlotRange -> Lens' SlotRange (Maybe (IxValue SlotRange))
at Index SlotRange
ValidityBound
Lower =
    (SlotRange -> Maybe Slot)
-> (SlotRange -> Maybe Slot -> SlotRange)
-> Lens SlotRange SlotRange (Maybe Slot) (Maybe Slot)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
      ( \case
          (Api.Interval (Api.LowerBound (Api.Finite Slot
val) Closure
closure) UpperBound Slot
_) -> Slot -> Maybe Slot
forall a. a -> Maybe a
Just (Slot -> Maybe Slot) -> Slot -> Maybe Slot
forall a b. (a -> b) -> a -> b
$ if Closure
closure then Slot
val else Slot
val Slot -> Slot -> Slot
forall a. Num a => a -> a -> a
+ Slot
1
          SlotRange
_ -> Maybe Slot
forall a. Maybe a
Nothing
      )
      ( \(Api.Interval LowerBound Slot
_ UpperBound Slot
upperBound) Maybe Slot
newLowerBound ->
          LowerBound Slot -> UpperBound Slot -> SlotRange
forall a. LowerBound a -> UpperBound a -> Interval a
Api.Interval (Extended Slot -> Closure -> LowerBound Slot
forall a. Extended a -> Closure -> LowerBound a
Api.LowerBound (Extended Slot
-> (Slot -> Extended Slot) -> Maybe Slot -> Extended Slot
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Extended Slot
forall a. Extended a
Api.NegInf Slot -> Extended Slot
forall a. a -> Extended a
Api.Finite Maybe Slot
newLowerBound) Closure
True) UpperBound Slot
upperBound
      )
  at Index SlotRange
ValidityBound
Upper =
    (SlotRange -> Maybe Slot)
-> (SlotRange -> Maybe Slot -> SlotRange)
-> Lens SlotRange SlotRange (Maybe Slot) (Maybe Slot)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
      ( \case
          (Api.Interval LowerBound Slot
_ (Api.UpperBound (Api.Finite Slot
val) Closure
closure)) -> Slot -> Maybe Slot
forall a. a -> Maybe a
Just (Slot -> Maybe Slot) -> Slot -> Maybe Slot
forall a b. (a -> b) -> a -> b
$ if Closure
closure then Slot
val else Slot
val Slot -> Slot -> Slot
forall a. Num a => a -> a -> a
- Slot
1
          SlotRange
_ -> Maybe Slot
forall a. Maybe a
Nothing
      )
      ( \(Api.Interval LowerBound Slot
lowerBound UpperBound Slot
_) Maybe Slot
newUpperBound ->
          LowerBound Slot -> UpperBound Slot -> SlotRange
forall a. LowerBound a -> UpperBound a -> Interval a
Api.Interval LowerBound Slot
lowerBound (Extended Slot -> Closure -> UpperBound Slot
forall a. Extended a -> Closure -> UpperBound a
Api.UpperBound (Extended Slot
-> (Slot -> Extended Slot) -> Maybe Slot -> Extended Slot
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Extended Slot
forall a. Extended a
Api.PosInf Slot -> Extended Slot
forall a. a -> Extended a
Api.Finite Maybe Slot
newUpperBound) Closure
True)
      )