-- | This module defines 'Tweak's which are the building blocks of our DSL for
-- attacks. They are skeleton modifications aware of the mockchain state.
module Cooked.Tweak.Common
  ( -- * Tweak effect
    Tweak (..),
    getTxSkel,
    putTxSkel,

    -- * Running a tweak
    runTweak,
    evalTweak,
    execTweak,
  )
where

import Cooked.Skeleton
import Polysemy
import Polysemy.State

-- * Tweaks: state aware modifications over a 'TxSkel'

-- | An effect that allows to store or retrieve a 'TxSkel' from a context
data Tweak :: Effect where
  -- | Retrieves the 'TxSkel' from the context
  GetTxSkel :: Tweak m TxSkel
  -- | Overrides the 'TxSkel' in the context
  PutTxSkel :: TxSkel -> Tweak m ()

makeSem ''Tweak

-- * Running 'Tweak's

-- | Running a Tweak is equivalent to running a state monad storing a 'TxSkel'
runTweak ::
  TxSkel ->
  Sem (Tweak : effs) a ->
  Sem effs (TxSkel, a)
runTweak :: forall (effs :: EffectRow) a.
TxSkel -> Sem (Tweak : effs) a -> Sem effs (TxSkel, a)
runTweak TxSkel
txSkel =
  TxSkel -> Sem (State TxSkel : effs) a -> Sem effs (TxSkel, a)
forall s (r :: EffectRow) a.
s -> Sem (State s : r) a -> Sem r (s, a)
runState TxSkel
txSkel
    (Sem (State TxSkel : effs) a -> Sem effs (TxSkel, a))
-> (Sem (Tweak : effs) a -> Sem (State TxSkel : effs) a)
-> Sem (Tweak : effs) a
-> Sem effs (TxSkel, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (rInitial :: EffectRow) x.
 Tweak (Sem rInitial) x -> Sem (State TxSkel : effs) x)
-> Sem (Tweak : effs) a -> Sem (State TxSkel : effs) a
forall (e1 :: Effect) (e2 :: Effect) (r :: EffectRow) a.
FirstOrder e1 "reinterpret" =>
(forall (rInitial :: EffectRow) x.
 e1 (Sem rInitial) x -> Sem (e2 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
reinterpret
      ( \case
          Tweak (Sem rInitial) x
GetTxSkel -> Sem (State TxSkel : effs) x
forall s (r :: EffectRow). Member (State s) r => Sem r s
get
          PutTxSkel TxSkel
skel -> TxSkel -> Sem (State TxSkel : effs) ()
forall s (r :: EffectRow). Member (State s) r => s -> Sem r ()
put TxSkel
skel
      )

-- | Same as 'runTweak' but discards the returned 'TxSkel'
evalTweak ::
  TxSkel ->
  Sem (Tweak : effs) a ->
  Sem effs a
evalTweak :: forall (effs :: EffectRow) a.
TxSkel -> Sem (Tweak : effs) a -> Sem effs a
evalTweak TxSkel
skel = ((TxSkel, a) -> a
forall a b. (a, b) -> b
snd ((TxSkel, a) -> a) -> Sem effs (TxSkel, a) -> Sem effs a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Sem effs (TxSkel, a) -> Sem effs a)
-> (Sem (Tweak : effs) a -> Sem effs (TxSkel, a))
-> Sem (Tweak : effs) a
-> Sem effs a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkel -> Sem (Tweak : effs) a -> Sem effs (TxSkel, a)
forall (effs :: EffectRow) a.
TxSkel -> Sem (Tweak : effs) a -> Sem effs (TxSkel, a)
runTweak TxSkel
skel

-- | Same as 'runTweak' but discards the returned value
execTweak ::
  TxSkel ->
  Sem (Tweak : effs) a ->
  Sem effs TxSkel
execTweak :: forall (effs :: EffectRow) a.
TxSkel -> Sem (Tweak : effs) a -> Sem effs TxSkel
execTweak TxSkel
skel = ((TxSkel, a) -> TxSkel
forall a b. (a, b) -> a
fst ((TxSkel, a) -> TxSkel) -> Sem effs (TxSkel, a) -> Sem effs TxSkel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Sem effs (TxSkel, a) -> Sem effs TxSkel)
-> (Sem (Tweak : effs) a -> Sem effs (TxSkel, a))
-> Sem (Tweak : effs) a
-> Sem effs TxSkel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkel -> Sem (Tweak : effs) a -> Sem effs (TxSkel, a)
forall (effs :: EffectRow) a.
TxSkel -> Sem (Tweak : effs) a -> Sem effs (TxSkel, a)
runTweak TxSkel
skel