-- | This module provides tweaks operating on transaction labels
module Cooked.Tweak.Labels
  ( addLabelTweak,
    removeLabelTweak,
    hasLabelTweak,
  )
where

import Control.Monad
import Cooked.Skeleton
import Cooked.Tweak.Common
import Data.Functor
import Data.Set qualified as Set

-- | Adds a label to a 'TxSkel'.
addLabelTweak :: (MonadTweak m, LabelConstrs x) => x -> m ()
addLabelTweak :: forall (m :: * -> *) x. (MonadTweak m, LabelConstrs x) => x -> m ()
addLabelTweak = Optic' A_Lens NoIx TxSkel (Set TxLabel)
-> (Set TxLabel -> Set TxLabel) -> m ()
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Setter) =>
Optic' k is TxSkel a -> (a -> a) -> m ()
overTweak Optic' A_Lens NoIx TxSkel (Set TxLabel)
txSkelLabelL ((Set TxLabel -> Set TxLabel) -> m ())
-> (x -> Set TxLabel -> Set TxLabel) -> x -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxLabel -> Set TxLabel -> Set TxLabel
forall a. Ord a => a -> Set a -> Set a
Set.insert (TxLabel -> Set TxLabel -> Set TxLabel)
-> (x -> TxLabel) -> x -> Set TxLabel -> Set TxLabel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> TxLabel
forall x. LabelConstrs x => x -> TxLabel
TxLabel

-- | Checks if a given label is present in the 'TxSkel'
hasLabelTweak :: (MonadTweak m, LabelConstrs x) => x -> m Bool
hasLabelTweak :: forall (m :: * -> *) x.
(MonadTweak m, LabelConstrs x) =>
x -> m Bool
hasLabelTweak = (Optic' A_Lens NoIx TxSkel (Set TxLabel) -> m (Set TxLabel)
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Getter) =>
Optic' k is TxSkel a -> m a
viewTweak Optic' A_Lens NoIx TxSkel (Set TxLabel)
txSkelLabelL m (Set TxLabel) -> (Set TxLabel -> Bool) -> m Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>) ((Set TxLabel -> Bool) -> m Bool)
-> (x -> Set TxLabel -> Bool) -> x -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxLabel -> Set TxLabel -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (TxLabel -> Set TxLabel -> Bool)
-> (x -> TxLabel) -> x -> Set TxLabel -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> TxLabel
forall x. LabelConstrs x => x -> TxLabel
TxLabel

-- | Removes a label from a 'TxSkel' when possible, fails otherwise
removeLabelTweak :: (MonadTweak m, LabelConstrs x) => x -> m ()
removeLabelTweak :: forall (m :: * -> *) x. (MonadTweak m, LabelConstrs x) => x -> m ()
removeLabelTweak x
label = do
  x -> m Bool
forall (m :: * -> *) x.
(MonadTweak m, LabelConstrs x) =>
x -> m Bool
hasLabelTweak x
label m Bool -> (Bool -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard
  Optic' A_Lens NoIx TxSkel (Set TxLabel)
-> (Set TxLabel -> Set TxLabel) -> m ()
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Setter) =>
Optic' k is TxSkel a -> (a -> a) -> m ()
overTweak Optic' A_Lens NoIx TxSkel (Set TxLabel)
txSkelLabelL ((Set TxLabel -> Set TxLabel) -> m ())
-> (TxLabel -> Set TxLabel -> Set TxLabel) -> TxLabel -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxLabel -> Set TxLabel -> Set TxLabel
forall a. Ord a => a -> Set a -> Set a
Set.delete (TxLabel -> m ()) -> TxLabel -> m ()
forall a b. (a -> b) -> a -> b
$ x -> TxLabel
forall x. LabelConstrs x => x -> TxLabel
TxLabel x
label