-- | This module defines 'Tweaks' which are the fundamental building blocks of
-- our "domain specific language" for attacks. They are essentially skeleton
-- modifications aware of the mockchain state.
module Cooked.Tweak.Common
  ( runTweakInChain,
    runTweakInChain',
    Tweak,
    UntypedTweak (UntypedTweak),

    -- * User API
    MonadTweak (..),
    failingTweak,
    doNothingTweak,
    viewTweak,
    viewAllTweak,
    setTweak,
    overTweak,
    overMaybeTweak,
    overMaybeSelectingTweak,
    selectP,
    combineModsTweak,
    iviewTweak,
  )
where

import Control.Arrow (second)
import Control.Monad
import Control.Monad.State
import Cooked.MockChain.BlockChain
import Cooked.Skeleton
import Data.Either.Combinators (rightToMaybe)
import Data.List (mapAccumL)
import Data.Maybe
import ListT (ListT)
import ListT qualified
import Optics.Core

-- * The type of tweaks

class (MonadPlus m, MonadBlockChainWithoutValidation m) => MonadTweak m where
  getTxSkel :: m TxSkel
  putTxSkel :: TxSkel -> m ()

type Tweak m = StateT TxSkel (ListT m)

instance (MonadBlockChainWithoutValidation m) => MonadTweak (Tweak m) where
  getTxSkel :: Tweak m TxSkel
getTxSkel = Tweak m TxSkel
forall s (m :: * -> *). MonadState s m => m s
get
  putTxSkel :: TxSkel -> Tweak m ()
putTxSkel = TxSkel -> Tweak m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put

-- | This is the function that gives a meaning to 'Tweak's: A 'Tweak' is a
-- computation that, depending on the state of the chain, looks at a transaction
-- and returns zero or more modified transactions, together with some additional
-- values.
--
-- Our intuition (and also the language of the comments pertaining to 'Tweak's)
-- is that a 'Tweak' @t@
--
-- - /fails/ if @runTweakInChain t skel@ is @mzero@.
--
-- - /returns/ the value in the first component of the pair returned by this
--   function (which is also the value it returns in the monad @Tweak m@).
--
-- - /modifies/ a 'TxSkel'. Since it can use every method of
--   'MonadBlockChainWithoutValidateTxSkel' to do so, this also includes
--   stateful lookups or even things like waiting for a certain amount of time
--   before submitting the transaction.
--
-- If you're using tweaks in a 'MonadModalBlockChain' together with mechanisms
-- like 'withTweak', 'somewhere', or 'everywhere', you should never have areason
-- to use this function.
runTweakInChain :: (MonadPlus m) => Tweak m a -> TxSkel -> m (a, TxSkel)
runTweakInChain :: forall (m :: * -> *) a.
MonadPlus m =>
Tweak m a -> TxSkel -> m (a, TxSkel)
runTweakInChain Tweak m a
tweak TxSkel
skel = ListT m (a, TxSkel) -> m (a, TxSkel)
forall (m :: * -> *) a.
(Alternative m, Monad m) =>
ListT m a -> m a
ListT.alternate (ListT m (a, TxSkel) -> m (a, TxSkel))
-> ListT m (a, TxSkel) -> m (a, TxSkel)
forall a b. (a -> b) -> a -> b
$ Tweak m a -> TxSkel -> ListT m (a, TxSkel)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT Tweak m a
tweak TxSkel
skel

-- | Like 'runTweakInChain', but for when you want to explicitly apply a tweak
-- to a transaction skeleton and get all results as a list.
--
-- If you're trying to apply a tweak to a transaction directly before it's
-- modified, consider using 'MonadModalBlockChain' and idioms like 'withTweak',
-- 'somewhere', or 'everywhere'.
runTweakInChain' :: (MonadBlockChainWithoutValidation m) => Tweak m a -> TxSkel -> m [(a, TxSkel)]
runTweakInChain' :: forall (m :: * -> *) a.
MonadBlockChainWithoutValidation m =>
Tweak m a -> TxSkel -> m [(a, TxSkel)]
runTweakInChain' Tweak m a
tweak TxSkel
skel = ListT m (a, TxSkel) -> m [(a, TxSkel)]
forall (m :: * -> *) a. Monad m => ListT m a -> m [a]
ListT.toList (ListT m (a, TxSkel) -> m [(a, TxSkel)])
-> ListT m (a, TxSkel) -> m [(a, TxSkel)]
forall a b. (a -> b) -> a -> b
$ Tweak m a -> TxSkel -> ListT m (a, TxSkel)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT Tweak m a
tweak TxSkel
skel

-- | This is a wrapper type used in the implementation of the Staged monad. You
-- will probably never use it while you're building 'Tweak's.
data UntypedTweak m where
  UntypedTweak :: Tweak m a -> UntypedTweak m

instance (Monad m) => Semigroup (UntypedTweak m) where
  -- The right tweak is applied first
  UntypedTweak Tweak m a
f <> :: UntypedTweak m -> UntypedTweak m -> UntypedTweak m
<> UntypedTweak Tweak m a
g = Tweak m a -> UntypedTweak m
forall (m :: * -> *) a. Tweak m a -> UntypedTweak m
UntypedTweak (Tweak m a -> UntypedTweak m) -> Tweak m a -> UntypedTweak m
forall a b. (a -> b) -> a -> b
$ Tweak m a
g Tweak m a -> Tweak m a -> Tweak m a
forall a b.
StateT TxSkel (ListT m) a
-> StateT TxSkel (ListT m) b -> StateT TxSkel (ListT m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tweak m a
f

instance (Monad m) => Monoid (UntypedTweak m) where
  mempty :: UntypedTweak m
mempty = Tweak m () -> UntypedTweak m
forall (m :: * -> *) a. Tweak m a -> UntypedTweak m
UntypedTweak (Tweak m () -> UntypedTweak m) -> Tweak m () -> UntypedTweak m
forall a b. (a -> b) -> a -> b
$ () -> Tweak m ()
forall a. a -> StateT TxSkel (ListT m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- * A few fundamental tweaks

-- | The never-applicable tweak.
failingTweak :: (MonadTweak m) => m a
failingTweak :: forall (m :: * -> *) a. MonadTweak m => m a
failingTweak = m a
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | The tweak that always applies and leaves the transaction unchanged.
doNothingTweak :: (MonadTweak m) => m ()
doNothingTweak :: forall (m :: * -> *). MonadTweak m => m ()
doNothingTweak = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- * Constructing Tweaks from Optics

-- | The "tweak" that obtains some value from the 'TxSkel'. This does *not*
-- modify the transaction.
viewTweak :: (MonadTweak m, Is k A_Getter) => Optic' k is TxSkel a -> m a
viewTweak :: forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Getter) =>
Optic' k is TxSkel a -> m a
viewTweak Optic' k is TxSkel a
optic = m TxSkel
forall (m :: * -> *). MonadTweak m => m TxSkel
getTxSkel m TxSkel -> (TxSkel -> a) -> m 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 :: (MonadTweak m, Is k A_Getter) => Optic' k (WithIx is) TxSkel a -> m (is, a)
iviewTweak :: forall (m :: * -> *) k is a.
(MonadTweak m, Is k A_Getter) =>
Optic' k (WithIx is) TxSkel a -> m (is, a)
iviewTweak Optic' k (WithIx is) TxSkel a
optic = m TxSkel
forall (m :: * -> *). MonadTweak m => m TxSkel
getTxSkel m TxSkel -> (TxSkel -> (is, a)) -> m (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 :: (MonadTweak m, Is k A_Fold) => Optic' k is TxSkel a -> m [a]
viewAllTweak :: forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Fold) =>
Optic' k is TxSkel a -> m [a]
viewAllTweak Optic' k is TxSkel a
optic = m TxSkel
forall (m :: * -> *). MonadTweak m => m TxSkel
getTxSkel m TxSkel -> (TxSkel -> [a]) -> m [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 :: (MonadTweak m, Is k A_Setter) => Optic' k is TxSkel a -> a -> m ()
setTweak :: forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Setter) =>
Optic' k is TxSkel a -> a -> m ()
setTweak Optic' k is TxSkel a
optic a
newValue = m TxSkel
forall (m :: * -> *). MonadTweak m => m TxSkel
getTxSkel m TxSkel -> (TxSkel -> 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
>>= TxSkel -> m ()
forall (m :: * -> *). MonadTweak m => TxSkel -> m ()
putTxSkel (TxSkel -> m ()) -> (TxSkel -> TxSkel) -> TxSkel -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' k is TxSkel a -> a -> TxSkel -> TxSkel
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic' k is TxSkel a
optic a
newValue

-- | The tweak that modifies a certain value in the 'TxSkel'.
overTweak :: (MonadTweak m, Is k A_Setter) => Optic' k is TxSkel a -> (a -> a) -> m ()
overTweak :: forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Setter) =>
Optic' k is TxSkel a -> (a -> a) -> m ()
overTweak Optic' k is TxSkel a
optic a -> a
change = m TxSkel
forall (m :: * -> *). MonadTweak m => m TxSkel
getTxSkel m TxSkel -> (TxSkel -> 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
>>= TxSkel -> m ()
forall (m :: * -> *). MonadTweak m => TxSkel -> m ()
putTxSkel (TxSkel -> m ()) -> (TxSkel -> TxSkel) -> TxSkel -> m ()
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 :: (MonadTweak m, Is k A_Traversal) => Optic' k is TxSkel a -> (a -> Maybe a) -> m [a]
overMaybeTweak :: forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Traversal) =>
Optic' k is TxSkel a -> (a -> Maybe a) -> m [a]
overMaybeTweak Optic' k is TxSkel a
optic a -> Maybe a
mChange = Optic' k is TxSkel a
-> (a -> Maybe a) -> (Integer -> Bool) -> m [a]
forall a (m :: * -> *) k (is :: IxList).
(MonadTweak m, Is k A_Traversal) =>
Optic' k is TxSkel a
-> (a -> Maybe a) -> (Integer -> Bool) -> m [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 ::
  forall a m k is.
  (MonadTweak m, Is k A_Traversal) =>
  Optic' k is TxSkel a ->
  (a -> Maybe a) ->
  (Integer -> Bool) ->
  m [a]
overMaybeSelectingTweak :: forall a (m :: * -> *) k (is :: IxList).
(MonadTweak m, Is k A_Traversal) =>
Optic' k is TxSkel a
-> (a -> Maybe a) -> (Integer -> Bool) -> m [a]
overMaybeSelectingTweak Optic' k is TxSkel a
optic a -> Maybe a
mChange Integer -> Bool
select = do
  [a]
allFoci <- Optic' A_Lens '[] TxSkel [a] -> m [a]
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Getter) =>
Optic' k is TxSkel a -> m a
viewTweak (Optic' A_Lens '[] TxSkel [a] -> m [a])
-> Optic' A_Lens '[] TxSkel [a] -> m [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 :: [(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] -> m ()
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Setter) =>
Optic' k is TxSkel a -> a -> m ()
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] -> m ()) -> [a] -> m ()
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] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> m [a]) -> [a] -> m [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 -> m [(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, MonadTweak m) =>
  ([is] -> [[is]]) ->
  Optic' k (WithIx is) TxSkel x ->
  (is -> x -> m [(x, l)]) ->
  m [l]
combineModsTweak :: forall is k (m :: * -> *) x l.
(Eq is, Is k A_Traversal, MonadTweak m) =>
([is] -> [[is]])
-> Optic' k (WithIx is) TxSkel x
-> (is -> x -> m [(x, l)])
-> m [l]
combineModsTweak [is] -> [[is]]
groupings Optic' k (WithIx is) TxSkel x
optic is -> x -> m [(x, l)]
changes = do
  ([is]
indexes, [x]
foci) <- Optic' A_Lens (WithIx [is]) TxSkel [x] -> m ([is], [x])
forall (m :: * -> *) k is a.
(MonadTweak m, Is k A_Getter) =>
Optic' k (WithIx is) TxSkel a -> m (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)
  [m [l]] -> m [l]
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([m [l]] -> m [l]) -> [m [l]] -> m [l]
forall a b. (a -> b) -> a -> b
$
    ([is] -> m [l]) -> [[is]] -> [m [l]]
forall a b. (a -> b) -> [a] -> [b]
map
      ( \[is]
grouping -> do
          let mChangedFoci :: [m [(x, Either () l)]]
mChangedFoci =
                (is -> x -> m [(x, Either () l)])
-> [is] -> [x] -> [m [(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)])
-> m [(x, l)] -> m [(x, Either () l)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> is -> x -> m [(x, l)]
changes is
i x
a
                        else [(x, Either () l)] -> m [(x, Either () l)]
forall a. a -> m 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 <- [m [(x, Either () l)]] -> m [[(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 [m [(x, Either () l)]]
mChangedFoci
          [m [l]] -> m [l]
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([m [l]] -> m [l]) -> [m [l]] -> m [l]
forall a b. (a -> b) -> a -> b
$
            ([(x, Either () l)] -> m [l]) -> [[(x, Either () l)]] -> [m [l]]
forall a b. (a -> b) -> [a] -> [b]
map
              ( \[(x, Either () l)]
combination -> do
                  Optic' A_Lens '[] TxSkel [x] -> [x] -> m ()
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Setter) =>
Optic' k is TxSkel a -> a -> m ()
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] -> m ()) -> [x] -> m ()
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] -> m [l]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([l] -> m [l]) -> [l] -> m [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)