-- | This module exposes involved tweaks to selectively and systematically
-- modify elements of the same nature within a 'TxSkel'
module Cooked.Tweak.Modify
  ( -- * Modification parameters
    Branching (..),
    ModifyTweakParams (..),
    modifyTweakParamsAllIndexes,
    modifyTweakParamsNoTypeChange,
    modifyTweakParamsOneBranchForAllFoci,
    modifyTweakParamsOneBranchPerFoci,
    modifyTweakParamsOneBranchPerSubset,

    -- * Modifying tweaks
    modifyTweak,
    modifyTweakFromParams,

    -- * Helper to build optics
    selectP,
  )
where

import Control.Applicative (Alternative)
import Control.Monad
import Cooked.Skeleton
import Cooked.Tweak.Common
import Cooked.Tweak.Query
import Cooked.Tweak.Update
import Data.Either (isRight)
import Data.Either.Combinators (fromRight')
import Data.List (subsequences)
import Data.Set qualified as Set
import Optics.Core
import Polysemy
import Polysemy.NonDet
import Polysemy.Writer

-- | A modification that can fail is sometimes best expressed by explicitly
-- stating which property the foci should satisfy to be eligible for a
-- modification that cannot fail. '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.
--
-- Note that 'selectP' is not a lawful prism: its build side is 'id', so
-- reviewing a value that does not satisfy @prop@ breaks the
-- @preview o (review o b) ≡ Just b@ law. We nevertheless keep it as a 'Prism''
-- (rather than the lawful but read-only @filtered@, which is an @AffineFold@)
-- because we need the write capability: composing a traversal
-- with a prism stays a traversal, whereas composing it with an @AffineFold@
-- collapses to a read-only fold. This is safe in the intended
-- @overTweak (optic % selectP prop) mod@ pattern, where the unlawful build side
-- is never exercised: we only ever reach foci that already satisfy @prop@.
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 -> Bool) -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter a -> Bool
prop (Maybe a -> Maybe a) -> (a -> Maybe a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just)

-- | 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.
--
-- This function is the most general building block for both strategies: its
-- first argument selects, per transaction, which foci are modified together,
-- so it can realise strategy (a), strategy (b), or anything in between. The
-- @overMods...@ helpers defined below specialise it to common cases. The
-- meaning of each argument and of the return value is documented on the
-- parameters themselves below.
--
-- __Shared setup for the examples__
--
-- Assume the optic has three foci, which we denote by @a, b, c :: x@, with
-- indices @1, 2, 3 :: Integer@ respectively.
--
-- __Example 1: modify every focus in a single transaction__
--
-- Choosing @(: [])@ for the @[is] -> [[is]]@ argument yields the single
-- grouping @[[1, 2, 3]]@, so all foci are modified together. Assuming the
-- modification does not itself branch (@changes@ returns exactly one result per
-- focus), this produces exactly /one/ modified transaction, in which @a@, @b@,
-- and @c@ are all modified. This is the grouping used by the
-- 'OneBranchForAllFoci' 'Branching' of 'modifyTweak'.
--
-- __Example 2: one modification per transaction__
--
-- Now additionally assume that @changes@, of type @is -> x -> Sem effs (x,
-- l)@, branches into 2, 3, and 5 results on @a@, @b@, and @c@ respectively;
-- call those @a1, a2@ and @b1, b2, b3@ and @c1, c2, c3, c4, c5@. Choosing @map
-- (: [])@ for the @[is] -> [[is]]@ argument tries every modification on a
-- separate transaction, since
--
-- > map (: []) [1, 2, 3] = [[1], [2], [3]]  .
--
-- Thus there will be 2 + 3 + 5 = 10 modified transactions: for each element of
--
-- > [a1, a2, b1, b2, b3, c1, c2, c3, c4, c5]
--
-- you get one modified transaction that includes that value in place of the
-- original focus. This is the grouping used by the 'OneBranchPerFoci'
-- 'Branching' of 'modifyTweak'.
--
-- __Example 3: all combinations of modifications__
--
-- In the same setting, if you want to combine all possible modifications of one
-- focus with all possible modifications of the other foci, choose @tail .
-- subsequences@ for the @[is] -> [[is]]@ argument. This is the grouping used by
-- the 'OneBranchPerSubset' 'Branching' of 'modifyTweak'. We have
--
-- > tail (subsequences [1, 2, 3])
-- >   == [ [1], [2], [3],
-- >        [1, 2], [1, 3], [2, 3],
-- >        [1, 2, 3]
-- >      ]
--
-- This corresponds to the following 71 modified transactions, represented by
-- the list of modified foci they contain:
--
-- > [ -- one modified focus (the 10 cases from Example 2)
-- >   [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!
--
-- Note that if @changes@ branches to no result for a /targeted/ focus (one
-- whose index occurs in a grouping), that entire grouping branch is dropped,
-- since there is no possible value to put in place of that focus.
modifyTweak ::
  ( Ord is,
    Is k A_Traversal,
    Members '[Tweak, NonDet] effs
  ) =>
  -- | Function that explains which subsets of targeted indexes will be
  -- simultaneously subject to being transformed. If you want to transform all
  -- foci in a single transaction (assuming the transformation itself does not
  -- branch), use @(: [])@. On the other end of the spectrum, if you want each
  -- focus to be transformed separately in their own transaction, use @fmap (:
  -- [])@. Everything in between is of course possible.
  ([is] -> [[is]]) ->
  -- | Optic targeting the various foci which should be subject to being
  -- transformed. This optic can be built manually, but can also be enlarged
  -- using convenience functions such as 'elementsOf'.
  Optic' k (WithIx is) TxSkel x ->
  -- | Function that describes how the foci and their indexes can be transformed
  -- within the structure. Bear in mind that @effs@ contains @NonDet@ so this
  -- transformation can already branch.
  (is -> x -> Sem effs (x, l)) ->
  -- | Returns the list of all foci modified in the transaction, as they were
  -- before the modification was applied, represented by their label. In most
  -- cases, the label will be the element itself, but other use cases are
  -- allowed as the label is arbitrary data.
  Sem effs [l]
modifyTweak :: forall is k (effs :: EffectRow) x l.
(Ord 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]
modifyTweak [is] -> [[is]]
groupings Optic' k (WithIx is) TxSkel x
optic is -> x -> Sem effs (x, l)
changes = do
  -- The 'castOptic' call below is necessary: a polymorphic optic kind @k@
  -- constrained only by @Is k A_Traversal@ does not resolve @Is k A_Fold@
  -- ('itoListOf') or @Is k A_Setter@ ('ioverTweak') at the use site, so we
  -- concretise the kind to 'A_Traversal', for which those instances exist.
  let tOptic :: Optic A_Traversal (WithIx is) TxSkel TxSkel x x
tOptic = forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic @A_Traversal Optic' k (WithIx is) TxSkel x
optic
  -- We retrieve all the sets of indexes that should be subject to modification
  -- in a separate computation, removing the empty groupings in the process,
  -- which would yield an unmodified transaction. NOTE: removing the empty
  -- groupings is a design decision, not a necessity.
  [[is]]
indexes <- Optic' A_Getter '[] TxSkel [[is]] -> Sem effs [[is]]
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_Getter '[] TxSkel [[is]] -> Sem effs [[is]])
-> Optic' A_Getter '[] TxSkel [[is]] -> Sem effs [[is]]
forall a b. (a -> b) -> a -> b
$ (TxSkel -> [[is]]) -> Optic' A_Getter '[] TxSkel [[is]]
forall s a. (s -> a) -> Getter s a
to ((TxSkel -> [[is]]) -> Optic' A_Getter '[] TxSkel [[is]])
-> (TxSkel -> [[is]]) -> Optic' A_Getter '[] TxSkel [[is]]
forall a b. (a -> b) -> a -> b
$ ([is] -> Bool) -> [[is]] -> [[is]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([is] -> Bool) -> [is] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [is] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[is]] -> [[is]]) -> (TxSkel -> [[is]]) -> TxSkel -> [[is]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [is] -> [[is]]
groupings ([is] -> [[is]]) -> (TxSkel -> [is]) -> TxSkel -> [[is]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((is, x) -> is) -> [(is, x)] -> [is]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (is, x) -> is
forall a b. (a, b) -> a
fst ([(is, x)] -> [is]) -> (TxSkel -> [(is, x)]) -> TxSkel -> [is]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic A_Traversal (WithIx is) TxSkel TxSkel x x
-> TxSkel -> [(is, x)]
forall k (is :: IxList) i s a.
(Is k A_Fold, HasSingleIndex is i) =>
Optic' k is s a -> s -> [(i, a)]
itoListOf Optic A_Traversal (WithIx is) TxSkel TxSkel x x
tOptic
  -- We make a separate branch for each of those groupings, in which we apply
  -- the modifications sequentially, for each of the targeted foci in the
  -- grouping.
  [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]]
indexes
      [[is]] -> ([is] -> Sem effs [l]) -> [Sem effs [l]]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \([is] -> Set is
forall a. Ord a => [a] -> Set a
Set.fromList -> Set is
grouping) -> do
        -- Before browsing through the target foci, we restrict the optics with
        -- the foci present in the grouping
        (([l], ()) -> [l]) -> Sem effs ([l], ()) -> Sem effs [l]
forall a b. (a -> b) -> Sem effs a -> Sem effs b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([l], ()) -> [l]
forall a b. (a, b) -> a
fst (Sem effs ([l], ()) -> Sem effs [l])
-> Sem effs ([l], ()) -> Sem effs [l]
forall a b. (a -> b) -> a -> b
$ Sem (Writer [l] : effs) () -> Sem effs ([l], ())
forall o (r :: EffectRow) a.
Monoid o =>
Sem (Writer o : r) a -> Sem r (o, a)
runWriter (Sem (Writer [l] : effs) () -> Sem effs ([l], ()))
-> Sem (Writer [l] : effs) () -> Sem effs ([l], ())
forall a b. (a -> b) -> a -> b
$ Optic A_Traversal (WithIx is) TxSkel TxSkel x x
-> (is -> x -> Sem (Writer [l] : effs) x)
-> Sem (Writer [l] : effs) ()
forall (effs :: EffectRow) k is a.
(Member Tweak effs, Is k A_Traversal) =>
Optic' k (WithIx is) TxSkel a
-> (is -> a -> Sem effs a) -> Sem effs ()
itraverseTweak ((is -> Bool)
-> Optic A_Traversal (WithIx is) TxSkel TxSkel x x
-> Optic A_Traversal (WithIx is) TxSkel TxSkel x x
forall k (is :: IxList) i s t a.
(Is k A_Traversal, HasSingleIndex is i) =>
(i -> Bool) -> Optic k is s t a a -> IxTraversal i s t a a
indices (is -> Set is -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set is
grouping) Optic A_Traversal (WithIx is) TxSkel TxSkel x x
tOptic) ((is -> x -> Sem (Writer [l] : effs) x)
 -> Sem (Writer [l] : effs) ())
-> (is -> x -> Sem (Writer [l] : effs) x)
-> Sem (Writer [l] : effs) ()
forall a b. (a -> b) -> a -> b
$ \is
index x
el -> do
          -- For each of the foci, we perform the modification
          (x
el', l
lbl) <- Sem effs (x, l) -> Sem (Writer [l] : effs) (x, l)
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
raise (Sem effs (x, l) -> Sem (Writer [l] : effs) (x, l))
-> Sem effs (x, l) -> Sem (Writer [l] : effs) (x, l)
forall a b. (a -> b) -> a -> b
$ is -> x -> Sem effs (x, l)
changes is
index x
el
          -- We store the computed label
          [l] -> Sem (Writer [l] : effs) ()
forall o (r :: EffectRow). Member (Writer o) r => o -> Sem r ()
tell [l
lbl]
          -- We return the modified foci
          x -> Sem (Writer [l] : effs) x
forall a. a -> Sem (Writer [l] : effs) a
forall (m :: * -> *) a. Monad m => a -> m a
return x
el'

-- | How to combine the branches generated when several foci are eligible for
-- modification in the same skeleton. See 'modifyTweak'.
data Branching
  = -- | Modify all eligible foci together, yielding a single modified skeleton.
    OneBranchForAllFoci
  | -- | Modify exactly one eligible focus per branch.
    OneBranchPerFoci
  | -- | Modify every non-empty subset of the eligible foci, yielding one branch
    -- per subset (the power set, minus the empty set).
    OneBranchPerSubset
  | -- | Create a new branch for all the subsets computed by the given function
    -- applied on the focused indexes.
    Manual (forall is. [is] -> [[is]])

-- | The set of parameters piloting the modification tweak
data ModifyTweakParams k k' is is' f a b c where
  ModifyTweakParams ::
    { -- | The branching policy to apply when several foci are targeted
      forall k (is :: IxList) a k' (is' :: IxList) b c (f :: * -> *).
ModifyTweakParams k k' is is' f a b c -> Branching
branching :: Branching,
      -- | A type-preserving optic traversing the 'TxSkel' and pinpointing a first
      -- layer of elements. Being type-preserving, it only chooses /where/ to act.
      forall k (is :: IxList) a k' (is' :: IxList) b c (f :: * -> *).
ModifyTweakParams k k' is is' f a b c -> Optic' k is TxSkel a
outerOptic :: Optic' k is TxSkel a,
      -- | A second, type-changing 'AffineTraversal' reaching from within each
      -- selected element to the inner focus that is actually modified. It carries
      -- the @b -> c@ type change that the outer optic cannot, and its
      -- affine-ness (0 or 1 focus) acts as an additional selection layer.
      forall k (is :: IxList) a k' (is' :: IxList) b c (f :: * -> *).
ModifyTweakParams k k' is is' f a b c -> Optic k' is' a a b c
innerOptic :: Optic k' is' a a b c,
      -- | The modifying function, which can possibly fail through @f@, further
      -- selecting elements to modify.
      forall k (is :: IxList) a k' (is' :: IxList) b c (f :: * -> *).
ModifyTweakParams k k' is is' f a b c -> b -> f c
modification :: b -> f c,
      -- | A selection function based on the indexes of the selected foci. This is
      -- the last layer of selection, if all the others are insufficient.
      forall k (is :: IxList) a k' (is' :: IxList) b c (f :: * -> *).
ModifyTweakParams k k' is is' f a b c -> Int -> Bool
selection :: Int -> Bool
    } ->
    ModifyTweakParams k k' is is' f a b c

-- | A standard 'ModifyTweakParams' without the index filtering
modifyTweakParamsAllIndexes ::
  Branching ->
  Optic' k is TxSkel a ->
  Optic k' is' a a b c ->
  (b -> f c) ->
  ModifyTweakParams k k' is is' f a b c
modifyTweakParamsAllIndexes :: forall k (is :: IxList) a k' (is' :: IxList) b c (f :: * -> *).
Branching
-> Optic' k is TxSkel a
-> Optic k' is' a a b c
-> (b -> f c)
-> ModifyTweakParams k k' is is' f a b c
modifyTweakParamsAllIndexes Branching
branching Optic' k is TxSkel a
opticOut Optic k' is' a a b c
opticIn b -> f c
mChange =
  Branching
-> Optic' k is TxSkel a
-> Optic k' is' a a b c
-> (b -> f c)
-> (Int -> Bool)
-> ModifyTweakParams k k' is is' f a b c
forall k (is :: IxList) a k' (is' :: IxList) b c (f :: * -> *).
Branching
-> Optic' k is TxSkel a
-> Optic k' is' a a b c
-> (b -> f c)
-> (Int -> Bool)
-> ModifyTweakParams k k' is is' f a b c
ModifyTweakParams Branching
branching Optic' k is TxSkel a
opticOut Optic k' is' a a b c
opticIn b -> f c
mChange (Bool -> Int -> Bool
forall a b. a -> b -> a
const Bool
True)

-- | A standard 'ModifyTweakParams' without any index filtering or type changing
-- inner optic
modifyTweakParamsNoTypeChange ::
  Branching ->
  Optic' k is TxSkel a ->
  (a -> f a) ->
  ModifyTweakParams k An_Iso is NoIx f a a a
modifyTweakParamsNoTypeChange :: forall k (is :: IxList) a (f :: * -> *).
Branching
-> Optic' k is TxSkel a
-> (a -> f a)
-> ModifyTweakParams k An_Iso is '[] f a a a
modifyTweakParamsNoTypeChange Branching
branching Optic' k is TxSkel a
optic =
  Branching
-> Optic' k is TxSkel a
-> Optic An_Iso '[] a a a a
-> (a -> f a)
-> ModifyTweakParams k An_Iso is '[] f a a a
forall k (is :: IxList) a k' (is' :: IxList) b c (f :: * -> *).
Branching
-> Optic' k is TxSkel a
-> Optic k' is' a a b c
-> (b -> f c)
-> ModifyTweakParams k k' is is' f a b c
modifyTweakParamsAllIndexes Branching
branching Optic' k is TxSkel a
optic Optic An_Iso '[] a a a a
forall a. Iso' a a
simple

-- | A standard 'ModifyTweakParams' without any index filtering or type changing
-- inner optic, modifying all foci in the same transaction.
modifyTweakParamsOneBranchForAllFoci ::
  Optic' k is TxSkel a ->
  (a -> f a) ->
  ModifyTweakParams k An_Iso is NoIx f a a a
modifyTweakParamsOneBranchForAllFoci :: forall k (is :: IxList) a (f :: * -> *).
Optic' k is TxSkel a
-> (a -> f a) -> ModifyTweakParams k An_Iso is '[] f a a a
modifyTweakParamsOneBranchForAllFoci =
  Branching
-> Optic' k is TxSkel a
-> (a -> f a)
-> ModifyTweakParams k An_Iso is '[] f a a a
forall k (is :: IxList) a (f :: * -> *).
Branching
-> Optic' k is TxSkel a
-> (a -> f a)
-> ModifyTweakParams k An_Iso is '[] f a a a
modifyTweakParamsNoTypeChange Branching
OneBranchForAllFoci

-- | A standard 'ModifyTweakParams' without any index filtering or type changing
-- inner optic, branching on each focus.
modifyTweakParamsOneBranchPerFoci ::
  Optic' k is TxSkel a ->
  (a -> f a) ->
  ModifyTweakParams k An_Iso is NoIx f a a a
modifyTweakParamsOneBranchPerFoci :: forall k (is :: IxList) a (f :: * -> *).
Optic' k is TxSkel a
-> (a -> f a) -> ModifyTweakParams k An_Iso is '[] f a a a
modifyTweakParamsOneBranchPerFoci =
  Branching
-> Optic' k is TxSkel a
-> (a -> f a)
-> ModifyTweakParams k An_Iso is '[] f a a a
forall k (is :: IxList) a (f :: * -> *).
Branching
-> Optic' k is TxSkel a
-> (a -> f a)
-> ModifyTweakParams k An_Iso is '[] f a a a
modifyTweakParamsNoTypeChange Branching
OneBranchPerFoci

-- | A standard 'ModifyTweakParams' without any index filtering or type changing
-- inner optic, branching on each subset of foci.
modifyTweakParamsOneBranchPerSubset ::
  Optic' k is TxSkel a ->
  (a -> f a) ->
  ModifyTweakParams k An_Iso is NoIx f a a a
modifyTweakParamsOneBranchPerSubset :: forall k (is :: IxList) a (f :: * -> *).
Optic' k is TxSkel a
-> (a -> f a) -> ModifyTweakParams k An_Iso is '[] f a a a
modifyTweakParamsOneBranchPerSubset =
  Branching
-> Optic' k is TxSkel a
-> (a -> f a)
-> ModifyTweakParams k An_Iso is '[] f a a a
forall k (is :: IxList) a (f :: * -> *).
Branching
-> Optic' k is TxSkel a
-> (a -> f a)
-> ModifyTweakParams k An_Iso is '[] f a a a
modifyTweakParamsNoTypeChange Branching
OneBranchPerSubset

-- | The most convenient and expressive way to build a focusing-and-modifying
-- 'Tweak'. It targets foci in a 'TxSkel' through /two/ optics and applies a
-- (possibly type-changing, possibly failing) modification to them, branching
-- over the eligible foci according to the requested 'Branching' strategy.
--
-- == Why two optics?
--
-- The underlying engine ('modifyTweak') can only apply /type-preserving/
-- modifications: each modified focus is written back into the 'TxSkel' in
-- place, so the skeleton's overall shape is fixed and the outer optic must be
-- an @'Optic'' ... TxSkel a@. That optic can therefore only decide /where/ in
-- the skeleton to act; it cannot express a change of type.
--
-- The modification we actually want to perform is finer-grained and
-- /type-changing/: within each selected element @a@, an inner part of type @b@
-- is replaced by a value of type @c@. This type change cannot ride on the
-- outer, type-preserving optic, which is exactly why a second optic is needed.
-- @opticIn@ localises and carries the type change inside each selected element,
-- and 'traverseOf' folds it back into a type-preserving operation @a -> f a@,
-- so that the outer traversal stays type-preserving while the /inner/ focus
-- still changes from @b@ to @c@.
--
-- The second optic serves a second purpose: being an 'AffineTraversal' (zero
-- or one focus), it doubles as an extra selection layer. We guard on
-- 'matching', so an element is only eligible when its inner focus actually
-- exists there. Together with the failure allowed by @f@ in @change@
-- and the index predicate @select@, this gives several independent layers of
-- selection: outer optic, inner-optic existence, modification success, and
-- index.
modifyTweakFromParams ::
  ( Members '[Tweak, NonDet] effs,
    Is k A_Traversal,
    Is k' An_AffineTraversal,
    Foldable f,
    Alternative f
  ) =>
  -- | The parameters piloting the modifications
  ModifyTweakParams k k' is is' f a b c ->
  -- | Returns the list of inner foci (as they were /before/ modification) that
  -- were modified.
  Sem effs [b]
modifyTweakFromParams :: forall (effs :: EffectRow) k k' (f :: * -> *) (is :: IxList)
       (is' :: IxList) a b c.
(Members '[Tweak, NonDet] effs, Is k A_Traversal,
 Is k' An_AffineTraversal, Foldable f, Alternative f) =>
ModifyTweakParams k k' is is' f a b c -> Sem effs [b]
modifyTweakFromParams (ModifyTweakParams Branching
branching (forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic @A_Traversal -> Optic A_Traversal is TxSkel TxSkel a a
opticOut) (forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic @An_AffineTraversal -> Optic An_AffineTraversal is' a a b c
opticIn) b -> f c
change Int -> Bool
select) =
  let -- This turns the inner, type-changing modification into a type-preserving
      -- @a -> f a@ operation. The @guard@ fails (in @f@) when the element has
      -- no inner focus, so the outer engine only ever sees type-preserving
      -- work, and 'traverseOf' rebuilds the same @a@ with its inner @b@
      -- replaced by a @c@.
      mChange :: a -> f a
mChange a
a = Bool -> f ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Either a b -> Bool
forall a b. Either a b -> Bool
isRight (Either a b -> Bool) -> Either a b -> Bool
forall a b. (a -> b) -> a -> b
$ Optic An_AffineTraversal is' a a b c -> a -> Either a b
forall k (is :: IxList) s t a b.
Is k An_AffineTraversal =>
Optic k is s t a b -> s -> Either t a
matching Optic An_AffineTraversal is' a a b c
opticIn a
a) f () -> f a -> f a
forall a b. f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Optic An_AffineTraversal is' a a b c -> (b -> f c) -> a -> f a
forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf Optic An_AffineTraversal is' a a b c
opticIn b -> f c
change a
a
   in ([Int] -> [[Int]])
-> Optic' A_Traversal (WithIx Int) TxSkel a
-> (Int -> a -> Sem effs (a, b))
-> Sem effs [b]
forall is k (effs :: EffectRow) x l.
(Ord 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]
modifyTweak
        ( case Branching
branching of
            Branching
OneBranchForAllFoci -> ([Int] -> [[Int]] -> [[Int]]
forall a. a -> [a] -> [a]
: [])
            Branching
OneBranchPerFoci -> (Int -> [Int]) -> [Int] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [])
            Branching
OneBranchPerSubset -> [[Int]] -> [[Int]]
forall a. HasCallStack => [a] -> [a]
tail ([[Int]] -> [[Int]]) -> ([Int] -> [[Int]]) -> [Int] -> [[Int]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [[Int]]
forall a. [a] -> [[a]]
subsequences
            Manual forall a. [a] -> [[a]]
f -> [Int] -> [[Int]]
forall a. [a] -> [[a]]
f
        )
        -- 'selectF' keeps only the outer foci where @mChange@ is non-empty, and
        -- @select@ further restricts them by index.
        (Optic A_Traversal is TxSkel TxSkel a a
-> (Int -> Bool) -> Optic' A_Traversal (WithIx Int) TxSkel a
forall k (is :: IxList) s t a.
Is k A_Traversal =>
Optic k is s t a a -> (Int -> Bool) -> IxTraversal Int s t a a
elementsOf (Optic A_Traversal is TxSkel TxSkel a a
opticOut Optic A_Traversal is TxSkel TxSkel a a
-> Optic A_Prism '[] a a a a
-> Optic A_Traversal is TxSkel TxSkel a a
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (a -> Bool) -> Optic A_Prism '[] a a a a
forall a. (a -> Bool) -> Prism' a a
selectP (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Bool
forall a. f a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (f a -> Bool) -> (a -> f a) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
mChange)) Int -> Bool
select)
        -- We pair each non-deterministically modified element with the
        -- original inner focus. 'matching' (not 'preview') is required
        -- here because @opticIn@ is type-changing; the 'fromRight'' is safe
        -- because 'selectF'/the @guard@ already guaranteed a focus.
        (\Int
_ a
a -> (,Either a b -> b
forall a b. Either a b -> b
fromRight' (Either a b -> b) -> Either a b -> b
forall a b. (a -> b) -> a -> b
$ Optic An_AffineTraversal is' a a b c -> a -> Either a b
forall k (is :: IxList) s t a b.
Is k An_AffineTraversal =>
Optic k is s t a b -> s -> Either t a
matching Optic An_AffineTraversal is' a a b c
opticIn a
a) (a -> (a, b)) -> Sem effs a -> Sem effs (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Sem effs a) -> Sem effs a
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum (a -> Sem effs a
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Sem effs a) -> f a -> f (Sem effs a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
mChange a
a))