{-# LANGUAGE TemplateHaskell #-}

-- | 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 (..),
    runTweak,
    evalTweak,
    execTweak,

    -- * Optics
    selectP,

    -- * Tweak primitives
    getTxSkel,
    putTxSkel,

    -- * Optics tweaks
    viewTweak,
    viewAllTweak,
    setTweak,
    overTweak,
    overMaybeTweak,
    overMaybeSelectingTweak,
    combineModsTweak,
    iviewTweak,
  )
where

import Control.Arrow (second)
import Control.Monad
import Cooked.Skeleton
import Data.Either.Combinators (rightToMaybe)
import Data.List (mapAccumL)
import Data.Maybe
import Optics.Core
import Polysemy
import Polysemy.NonDet
import Polysemy.State

-- | An effet 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 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

-- | Retrieves some value from the 'TxSkel'
viewTweak ::
  (Member Tweak effs, Is k A_Getter) =>
  Optic' k is TxSkel a ->
  Sem effs a
viewTweak :: forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Getter) =>
Optic' k is TxSkel a -> Sem effs a
viewTweak Optic' k is TxSkel a
optic = Sem effs TxSkel
forall (r :: EffectRow). Member Tweak r => Sem r TxSkel
getTxSkel Sem effs TxSkel -> (TxSkel -> a) -> Sem effs a
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Optic' k is TxSkel a -> TxSkel -> a
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' k is TxSkel a
optic

-- | Like 'viewTweak', only for indexed optics.
iviewTweak ::
  (Member Tweak effs, Is k A_Getter) =>
  Optic' k (WithIx is) TxSkel a ->
  Sem effs (is, a)
iviewTweak :: forall (effs :: EffectRow) k is a.
(Member Tweak effs, Is k A_Getter) =>
Optic' k (WithIx is) TxSkel a -> Sem effs (is, a)
iviewTweak Optic' k (WithIx is) TxSkel a
optic = Sem effs TxSkel
forall (r :: EffectRow). Member Tweak r => Sem r TxSkel
getTxSkel Sem effs TxSkel -> (TxSkel -> (is, a)) -> Sem effs (is, a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Optic' k (WithIx is) TxSkel a -> TxSkel -> (is, a)
forall k (is :: IxList) i s a.
(Is k A_Getter, HasSingleIndex is i) =>
Optic' k is s a -> s -> (i, a)
iview Optic' k (WithIx is) TxSkel a
optic

-- | Like the 'viewTweak', but returns a list of all foci
viewAllTweak ::
  (Member Tweak effs, Is k A_Fold) =>
  Optic' k is TxSkel a ->
  Sem effs [a]
viewAllTweak :: forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Fold) =>
Optic' k is TxSkel a -> Sem effs [a]
viewAllTweak Optic' k is TxSkel a
optic = Sem effs TxSkel
forall (r :: EffectRow). Member Tweak r => Sem r TxSkel
getTxSkel Sem effs TxSkel -> (TxSkel -> [a]) -> Sem effs [a]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Optic' k is TxSkel a -> TxSkel -> [a]
forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf Optic' k is TxSkel a
optic

-- | The tweak that sets a certain value in the 'TxSkel'.
setTweak ::
  (Member Tweak effs, Is k A_Setter) =>
  Optic' k is TxSkel a ->
  a ->
  Sem effs ()
setTweak :: forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Setter) =>
Optic' k is TxSkel a -> a -> Sem effs ()
setTweak Optic' k is TxSkel a
optic = Optic' k is TxSkel a -> (a -> a) -> Sem effs ()
forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Setter) =>
Optic' k is TxSkel a -> (a -> a) -> Sem effs ()
overTweak Optic' k is TxSkel a
optic ((a -> a) -> Sem effs ()) -> (a -> a -> a) -> a -> Sem effs ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a b. a -> b -> a
const

-- | The tweak that modifies a certain value in the 'TxSkel'.
overTweak ::
  (Member Tweak effs, Is k A_Setter) =>
  Optic' k is TxSkel a ->
  (a -> a) ->
  Sem effs ()
overTweak :: forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Setter) =>
Optic' k is TxSkel a -> (a -> a) -> Sem effs ()
overTweak Optic' k is TxSkel a
optic a -> a
change = Sem effs TxSkel
forall (r :: EffectRow). Member Tweak r => Sem r TxSkel
getTxSkel Sem effs TxSkel -> (TxSkel -> Sem effs ()) -> Sem effs ()
forall a b. Sem effs a -> (a -> Sem effs b) -> Sem effs b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TxSkel -> Sem effs ()
forall (r :: EffectRow). Member Tweak r => TxSkel -> Sem r ()
putTxSkel (TxSkel -> Sem effs ())
-> (TxSkel -> TxSkel) -> TxSkel -> Sem effs ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' k is TxSkel a -> (a -> a) -> TxSkel -> TxSkel
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic' k is TxSkel a
optic a -> a
change

-- | Like 'overTweak', but only modifies foci on which the argument function
-- returns @Just@ the new focus. Returns a list of the foci that were modified,
-- as they were /before/ the tweak, and in the order in which they occurred on
-- the original transaction.
overMaybeTweak ::
  (Member Tweak effs, Is k A_Traversal) =>
  Optic' k is TxSkel a ->
  (a -> Maybe a) ->
  Sem effs [a]
overMaybeTweak :: forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Traversal) =>
Optic' k is TxSkel a -> (a -> Maybe a) -> Sem effs [a]
overMaybeTweak Optic' k is TxSkel a
optic a -> Maybe a
mChange = Optic' k is TxSkel a
-> (a -> Maybe a) -> (Integer -> Bool) -> Sem effs [a]
forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Traversal) =>
Optic' k is TxSkel a
-> (a -> Maybe a) -> (Integer -> Bool) -> Sem effs [a]
overMaybeSelectingTweak Optic' k is TxSkel a
optic a -> Maybe a
mChange (Bool -> Integer -> Bool
forall a b. a -> b -> a
const Bool
True)

-- | Sometimes 'overMaybeTweak' modifies too many foci. This might be the case
-- if there are several identical foci, but you only want to modify some of
-- them. This is where this 'Tweak' becomes useful: The @(Integer -> Bool)@
-- argument can be used to select which of the modifiable foci should be
-- actually modified.
overMaybeSelectingTweak ::
  (Member Tweak effs, Is k A_Traversal) =>
  Optic' k is TxSkel a ->
  (a -> Maybe a) ->
  (Integer -> Bool) ->
  Sem effs [a]
overMaybeSelectingTweak :: forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Traversal) =>
Optic' k is TxSkel a
-> (a -> Maybe a) -> (Integer -> Bool) -> Sem effs [a]
overMaybeSelectingTweak Optic' k is TxSkel a
optic a -> Maybe a
mChange Integer -> Bool
select = do
  [a]
allFoci <- Optic' A_Lens '[] TxSkel [a] -> Sem effs [a]
forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Getter) =>
Optic' k is TxSkel a -> Sem effs a
viewTweak (Optic' A_Lens '[] TxSkel [a] -> Sem effs [a])
-> Optic' A_Lens '[] TxSkel [a] -> Sem effs [a]
forall a b. (a -> b) -> a -> b
$ Optic' k is TxSkel a -> Optic' A_Lens '[] TxSkel [a]
forall k (is :: IxList) s t a.
Is k A_Traversal =>
Optic k is s t a a -> Lens s t [a] [a]
partsOf Optic' k is TxSkel a
optic
  let evaluatedFoci :: [(a, Maybe a)]
evaluatedFoci =
        (Integer, [(a, Maybe a)]) -> [(a, Maybe a)]
forall a b. (a, b) -> b
snd ((Integer, [(a, Maybe a)]) -> [(a, Maybe a)])
-> (Integer, [(a, Maybe a)]) -> [(a, Maybe a)]
forall a b. (a -> b) -> a -> b
$
          (Integer -> a -> (Integer, (a, Maybe a)))
-> Integer -> [a] -> (Integer, [(a, Maybe a)])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL
            ( \Integer
i a
unmodifiedFocus ->
                case a -> Maybe a
mChange a
unmodifiedFocus of
                  Just a
modifiedFocus ->
                    if Integer -> Bool
select Integer
i
                      then (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1, (a
unmodifiedFocus, a -> Maybe a
forall a. a -> Maybe a
Just a
modifiedFocus))
                      else (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1, (a
unmodifiedFocus, Maybe a
forall a. Maybe a
Nothing))
                  Maybe a
Nothing -> (Integer
i, (a
unmodifiedFocus, Maybe a
forall a. Maybe a
Nothing))
            )
            Integer
0
            [a]
allFoci
  -- If the second component of the pair is @Just@, use it.
  Optic' A_Lens '[] TxSkel [a] -> [a] -> Sem effs ()
forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Setter) =>
Optic' k is TxSkel a -> a -> Sem effs ()
setTweak (Optic' k is TxSkel a -> Optic' A_Lens '[] TxSkel [a]
forall k (is :: IxList) s t a.
Is k A_Traversal =>
Optic k is s t a a -> Lens s t [a] [a]
partsOf Optic' k is TxSkel a
optic) ([a] -> Sem effs ()) -> [a] -> Sem effs ()
forall a b. (a -> b) -> a -> b
$ ((a, Maybe a) -> a) -> [(a, Maybe a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Maybe a -> a) -> (a, Maybe a) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe) [(a, Maybe a)]
evaluatedFoci
  [a] -> Sem effs [a]
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> Sem effs [a]) -> [a] -> Sem effs [a]
forall a b. (a -> b) -> a -> b
$
    ((a, Maybe a) -> Maybe a) -> [(a, Maybe a)] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
      (\(a
original, Maybe a
mNew) -> if Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
mNew then a -> Maybe a
forall a. a -> Maybe a
Just a
original else Maybe a
forall a. Maybe a
Nothing)
      [(a, Maybe a)]
evaluatedFoci

-- | When constructing a tweak from an optic and a modification of foci, there
-- are in principle two options for optics with many foci: (a) apply the
-- modification to all foci and return /one/ modified transaction (b) generate a
-- number of transactions that contain different combinations of modified and
-- un-modified foci.
--
-- While most of the other "optic -> tweak" functions in this module take take
-- the route (a), this function enables strategy (b).
--
--
-- __Explanation of the arguments and return value__
--
-- - Each of the foci of the @Optic k (WithIx is) TxSkel x@ argument is
--   something in the transaction that we might want to modify.
--
-- - The @is -> x -> Sem effs [(x, l)]@ argument computes a list of possible
--   modifications for each focus, depending on its index. For each modified
--   focus, it also returns a "label" of type @l@, which somehow describes the
--   modification that was made.
--
-- - The @[is] -> [[is]]@ argument determines which combinations of (un-)
--   modified foci will be present on the modified transactions: The input is a
--   list of all of the indices of foci, and for each element @[i_1,...,i_n]@ of
--   the output list, all possible modified transactions that have a
--   modification applied to the foci with indices @i_1,...,i_n@ are generated.
--
-- - The return value of type @[l]@ is the list of labels of all modified foci,
--   in the order in which their indices occurred. Later tweaks may use this
--   list to decide what to do.
--
--
-- __Example 1__
--
-- Assume the optic has three foci, let's denote them by @a, b, c :: x@, with
-- indices @1, 2, 3 :: Integer@ respectively. Also assume that the @is -> x -> m
-- [(x, l)]@ argument returns lists of 2, 3, and 5 elements on @a@, @b@, and
-- @c@, respectively. Let's call those elements @a1, a2@ and @b1, b2, b3@ and
-- @c1, c2, c3, c4, c5@.
--
-- If the @[ix] -> [[ix]]@ argument is @map (:[])@, you will try every
-- modification on a separate transaction, since
--
-- > map (:[]) [1, 2, 3] = [[1], [2], [3]]  .
--
-- Thus, there'll be 2+3+5=10 modified transactions in our examples. Namely, for
-- each element of the list
--
-- > [a1, a2, b1, b2, b3, c1, c2, c3, c4, c5]
--
-- you'll get one modified transaction that includes that value in place of the
-- original focus.
--
-- __Example 2__
--
-- In the setting of the first example, if you want to try combining all
-- possible modifications of one focus with all possible modifications of all
-- other foci, choose @tail . subsequences@ for the @[ix] -> [[ix]] argument. We
-- have
--
-- > tail (subsequences [1, 2, 3])
-- >   == [ [1], [2], [3],
-- >        [1, 2], [1, 3], [2, 3],
-- >        [1, 2, 3]
-- >      ]
--
-- This will correspond to the following 71 modified transactions, represented
-- by the list of modified foci they contain:
--
-- > [ -- one modified focus (the 10 cases from Example 1)
-- >   [a1],
-- >   [a2],
-- >   ...
-- >   [c4],
-- >   [c5],
-- >
-- >   -- two modifications of different foci (2*3 + 2*5 + 3*5 = 31 cases)
-- >   [a1, b1],
-- >   [a1, b2],
-- >   ...
-- >   [b3, c4],
-- >   [b3, c5],
-- >
-- >   -- three modified foci, one from each focus (2*3*5 = 30 cases)
-- >   [a1, b1, c1],
-- >   [a1, b1, c2],
-- >   ...
-- >   [a1, b3, c4],
-- >   [a1, b3, c5]
-- > ]
--
-- So you see that tweaks constructed like this can branch quite wildly. Use
-- with caution!
combineModsTweak ::
  (Eq is, Is k A_Traversal, Members '[Tweak, NonDet] effs) =>
  ([is] -> [[is]]) ->
  Optic' k (WithIx is) TxSkel x ->
  (is -> x -> Sem effs [(x, l)]) ->
  Sem effs [l]
combineModsTweak :: forall is k (effs :: EffectRow) x l.
(Eq is, Is k A_Traversal, Members '[Tweak, NonDet] effs) =>
([is] -> [[is]])
-> Optic' k (WithIx is) TxSkel x
-> (is -> x -> Sem effs [(x, l)])
-> Sem effs [l]
combineModsTweak [is] -> [[is]]
groupings Optic' k (WithIx is) TxSkel x
optic is -> x -> Sem effs [(x, l)]
changes = do
  ([is]
indexes, [x]
foci) <- Optic' A_Lens (WithIx [is]) TxSkel [x] -> Sem effs ([is], [x])
forall (effs :: EffectRow) k is a.
(Member Tweak effs, Is k A_Getter) =>
Optic' k (WithIx is) TxSkel a -> Sem effs (is, a)
iviewTweak (Optic' k (WithIx is) TxSkel x
-> Optic' A_Lens (WithIx [is]) TxSkel [x]
forall k (is :: IxList) i s t a.
(Is k A_Traversal, HasSingleIndex is i) =>
Optic k is s t a a -> IxLens [i] s t [a] [a]
ipartsOf Optic' k (WithIx is) TxSkel x
optic)
  [Sem effs [l]] -> Sem effs [l]
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Sem effs [l]] -> Sem effs [l]) -> [Sem effs [l]] -> Sem effs [l]
forall a b. (a -> b) -> a -> b
$
    ([is] -> Sem effs [l]) -> [[is]] -> [Sem effs [l]]
forall a b. (a -> b) -> [a] -> [b]
map
      ( \[is]
grouping -> do
          let mChangedFoci :: [Sem effs [(x, Either () l)]]
mChangedFoci =
                (is -> x -> Sem effs [(x, Either () l)])
-> [is] -> [x] -> [Sem effs [(x, Either () l)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
                  ( \is
i x
a ->
                      if is
i is -> [is] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [is]
grouping
                        then ((x, l) -> (x, Either () l)) -> [(x, l)] -> [(x, Either () l)]
forall a b. (a -> b) -> [a] -> [b]
map ((l -> Either () l) -> (x, l) -> (x, Either () l)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second l -> Either () l
forall a b. b -> Either a b
Right) ([(x, l)] -> [(x, Either () l)])
-> Sem effs [(x, l)] -> Sem effs [(x, Either () l)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> is -> x -> Sem effs [(x, l)]
changes is
i x
a
                        else [(x, Either () l)] -> Sem effs [(x, Either () l)]
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return [(x
a, () -> Either () l
forall a b. a -> Either a b
Left ())]
                  )
                  [is]
indexes
                  [x]
foci
          [[(x, Either () l)]]
changedFoci <- [Sem effs [(x, Either () l)]] -> Sem effs [[(x, Either () l)]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Sem effs [(x, Either () l)]]
mChangedFoci
          [Sem effs [l]] -> Sem effs [l]
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Sem effs [l]] -> Sem effs [l]) -> [Sem effs [l]] -> Sem effs [l]
forall a b. (a -> b) -> a -> b
$
            ([(x, Either () l)] -> Sem effs [l])
-> [[(x, Either () l)]] -> [Sem effs [l]]
forall a b. (a -> b) -> [a] -> [b]
map
              ( \[(x, Either () l)]
combination -> do
                  Optic' A_Lens '[] TxSkel [x] -> [x] -> Sem effs ()
forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Setter) =>
Optic' k is TxSkel a -> a -> Sem effs ()
setTweak (Optic' k (WithIx is) TxSkel x -> Optic' A_Lens '[] TxSkel [x]
forall k (is :: IxList) s t a.
Is k A_Traversal =>
Optic k is s t a a -> Lens s t [a] [a]
partsOf Optic' k (WithIx is) TxSkel x
optic) ([x] -> Sem effs ()) -> [x] -> Sem effs ()
forall a b. (a -> b) -> a -> b
$ ((x, Either () l) -> x) -> [(x, Either () l)] -> [x]
forall a b. (a -> b) -> [a] -> [b]
map (x, Either () l) -> x
forall a b. (a, b) -> a
fst [(x, Either () l)]
combination
                  [l] -> Sem effs [l]
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return ([l] -> Sem effs [l]) -> [l] -> Sem effs [l]
forall a b. (a -> b) -> a -> b
$ ((x, Either () l) -> Maybe l) -> [(x, Either () l)] -> [l]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Either () l -> Maybe l
forall a b. Either a b -> Maybe b
rightToMaybe (Either () l -> Maybe l)
-> ((x, Either () l) -> Either () l) -> (x, Either () l) -> Maybe l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x, Either () l) -> Either () l
forall a b. (a, b) -> b
snd) [(x, Either () l)]
combination
              )
              ([[(x, Either () l)]] -> [[(x, Either () l)]]
forall a. [[a]] -> [[a]]
allCombinations [[(x, Either () l)]]
changedFoci)
      )
      ([is] -> [[is]]
groupings [is]
indexes)
  where
    allCombinations :: [[a]] -> [[a]]
    allCombinations :: forall a. [[a]] -> [[a]]
allCombinations [] = [[]]
    allCombinations ([a]
first : [[a]]
rest) = [a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs | a
x <- [a]
first, [a]
xs <- [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
allCombinations [[a]]
rest]

-- | 'overMaybeTweak' requires a modification that can fail (targeting 'Maybe').
-- Sometimes, it can prove more convenient to explicitly state which property
-- the foci shoud satisfy to be eligible for a modification that cannot fail
-- instead. 'selectP' provides a prism to make such a selection.  The intended
-- use case is @overTweak (optic % selectP prop) mod@ where @optic@ gives the
-- candidate foci, @prop@ is the predicate to be satisfied by the foci, and
-- @mod@ is the modification to be applied to the selected foci.
selectP :: (a -> Bool) -> Prism' a a
selectP :: forall a. (a -> Bool) -> Prism' a a
selectP a -> Bool
prop = (a -> a) -> (a -> Maybe a) -> Prism a a a a
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' a -> a
forall a. a -> a
id (\a
a -> if a -> Bool
prop a
a then a -> Maybe a
forall a. a -> Maybe a
Just a
a else Maybe a
forall a. Maybe a
Nothing)