-- | This module exposes tweaks to insert elements within various structures
-- focused in a 'TxSkel'.
module Cooked.Tweak.Insert
  ( -- * Generic insert functions
    insertUsingTweak,
    appendAfterTweak,
    appendBeforeTweak,

    -- * Insert elements in lists
    insertThereTweak,
    insertFirstTweak,
    insertLastTweak,

    -- * Insert elements in sets
    insertInTweak,

    -- * Insert elements in maps
    insertAtTweak,
  )
where

import Cooked.Skeleton
import Cooked.Tweak.Common
import Cooked.Tweak.Guard
import Cooked.Tweak.Update
import Data.Map (Map)
import Data.Set (Set)
import Optics.Core
import Polysemy
import Polysemy.NonDet

-- | Inserts an element in a structure using a custom function
insertUsingTweak ::
  ( Member Tweak effs,
    Is k A_Setter
  ) =>
  Optic' k is TxSkel (f a) ->
  (a -> f a -> f a) ->
  a ->
  Sem effs ()
insertUsingTweak :: forall (effs :: EffectRow) (k :: OpticKind) (is :: IxList)
       (f :: OpticKind -> OpticKind) (a :: OpticKind).
(Member Tweak effs, Is k A_Setter) =>
Optic' k is TxSkel (f a) -> (a -> f a -> f a) -> a -> Sem effs ()
insertUsingTweak Optic' k is TxSkel (f a)
optic a -> f a -> f a
op a
el = Optic' k is TxSkel (f a) -> (f a -> f a) -> Sem effs ()
forall (effs :: EffectRow) (k :: OpticKind) (is :: IxList)
       (a :: OpticKind) (b :: OpticKind).
(Member Tweak effs, Is k A_Setter) =>
Optic k is TxSkel TxSkel a b -> (a -> b) -> Sem effs ()
overTweak Optic' k is TxSkel (f a)
optic (a -> f a -> f a
op a
el)

-- | Appending an element in a Semigroup after the existing element
appendAfterTweak ::
  ( Member Tweak effs,
    Is k A_Setter,
    Semigroup a
  ) =>
  Optic' k is TxSkel a ->
  a ->
  Sem effs ()
appendAfterTweak :: forall (effs :: EffectRow) (k :: OpticKind) (a :: OpticKind)
       (is :: IxList).
(Member Tweak effs, Is k A_Setter, Semigroup a) =>
Optic' k is TxSkel a -> a -> Sem effs ()
appendAfterTweak Optic' k is TxSkel a
optic a
a = Optic' k is TxSkel a -> (a -> a) -> Sem effs ()
forall (effs :: EffectRow) (k :: OpticKind) (is :: IxList)
       (a :: OpticKind) (b :: OpticKind).
(Member Tweak effs, Is k A_Setter) =>
Optic k is TxSkel TxSkel a b -> (a -> b) -> Sem effs ()
overTweak Optic' k is TxSkel a
optic (a -> a -> a
forall (a :: OpticKind). Semigroup a => a -> a -> a
<> a
a)

-- | Appending an element in a Semigroup after the existing element
appendBeforeTweak ::
  ( Member Tweak effs,
    Is k A_Setter,
    Semigroup a
  ) =>
  Optic' k is TxSkel a ->
  a ->
  Sem effs ()
appendBeforeTweak :: forall (effs :: EffectRow) (k :: OpticKind) (a :: OpticKind)
       (is :: IxList).
(Member Tweak effs, Is k A_Setter, Semigroup a) =>
Optic' k is TxSkel a -> a -> Sem effs ()
appendBeforeTweak Optic' k is TxSkel a
optic a
a = Optic' k is TxSkel a -> (a -> a) -> Sem effs ()
forall (effs :: EffectRow) (k :: OpticKind) (is :: IxList)
       (a :: OpticKind) (b :: OpticKind).
(Member Tweak effs, Is k A_Setter) =>
Optic k is TxSkel TxSkel a b -> (a -> b) -> Sem effs ()
overTweak Optic' k is TxSkel a
optic (a
a a -> a -> a
forall (a :: OpticKind). Semigroup a => a -> a -> a
<>)

-- | Inserts an element at a specific position in a list focused in a
-- 'TxSkel'. If the index is beyond or equal to the list length, inserts it at
-- the end of the list.
insertThereTweak ::
  ( Member Tweak effs,
    Is k A_Setter
  ) =>
  Optic' k is TxSkel [a] ->
  Int ->
  a ->
  Sem effs ()
insertThereTweak :: forall (effs :: EffectRow) (k :: OpticKind) (is :: IxList)
       (a :: OpticKind).
(Member Tweak effs, Is k A_Setter) =>
Optic' k is TxSkel [a] -> Int -> a -> Sem effs ()
insertThereTweak Optic' k is TxSkel [a]
optic Int
j =
  Optic' k is TxSkel [a] -> (a -> [a] -> [a]) -> a -> Sem effs ()
forall (effs :: EffectRow) (k :: OpticKind) (is :: IxList)
       (f :: OpticKind -> OpticKind) (a :: OpticKind).
(Member Tweak effs, Is k A_Setter) =>
Optic' k is TxSkel (f a) -> (a -> f a -> f a) -> a -> Sem effs ()
insertUsingTweak Optic' k is TxSkel [a]
optic (Int -> a -> [a] -> [a]
forall {t :: OpticKind} {t :: OpticKind}.
(Eq t, Num t) =>
t -> t -> [t] -> [t]
aux Int
j)
  where
    aux :: t -> t -> [t] -> [t]
aux t
_ t
el [] = [t
el]
    aux t
i t
el (t
x : [t]
xs) | t
i t -> t -> Bool
forall (a :: OpticKind). Eq a => a -> a -> Bool
== t
0 = t
x t -> [t] -> [t]
forall (a :: OpticKind). a -> [a] -> [a]
: t
el t -> [t] -> [t]
forall (a :: OpticKind). a -> [a] -> [a]
: [t]
xs
    aux t
i t
el (t
x : [t]
xs) = t
x t -> [t] -> [t]
forall (a :: OpticKind). a -> [a] -> [a]
: t -> t -> [t] -> [t]
aux t
i t
el [t]
xs

-- | Inserts an element at the first position in a list focused in a 'TxSkel'.
insertFirstTweak ::
  ( Member Tweak effs,
    Is k A_Setter
  ) =>
  Optic' k is TxSkel [a] ->
  a ->
  Sem effs ()
insertFirstTweak :: forall (effs :: EffectRow) (k :: OpticKind) (is :: IxList)
       (a :: OpticKind).
(Member Tweak effs, Is k A_Setter) =>
Optic' k is TxSkel [a] -> a -> Sem effs ()
insertFirstTweak Optic' k is TxSkel [a]
optic = Optic' k is TxSkel [a] -> Int -> a -> Sem effs ()
forall (effs :: EffectRow) (k :: OpticKind) (is :: IxList)
       (a :: OpticKind).
(Member Tweak effs, Is k A_Setter) =>
Optic' k is TxSkel [a] -> Int -> a -> Sem effs ()
insertThereTweak Optic' k is TxSkel [a]
optic Int
0

-- | Inserts an element at the end of a list focused in a 'TxSkel'.
insertLastTweak ::
  ( Member Tweak effs,
    Is k A_Setter
  ) =>
  Optic' k is TxSkel [a] ->
  a ->
  Sem effs ()
insertLastTweak :: forall (effs :: EffectRow) (k :: OpticKind) (is :: IxList)
       (a :: OpticKind).
(Member Tweak effs, Is k A_Setter) =>
Optic' k is TxSkel [a] -> a -> Sem effs ()
insertLastTweak Optic' k is TxSkel [a]
optic = Optic' k is TxSkel [a] -> (a -> [a] -> [a]) -> a -> Sem effs ()
forall (effs :: EffectRow) (k :: OpticKind) (is :: IxList)
       (f :: OpticKind -> OpticKind) (a :: OpticKind).
(Member Tweak effs, Is k A_Setter) =>
Optic' k is TxSkel (f a) -> (a -> f a -> f a) -> a -> Sem effs ()
insertUsingTweak Optic' k is TxSkel [a]
optic (\a
el -> ([a] -> [a] -> [a]
forall (a :: OpticKind). [a] -> [a] -> [a]
++ [a
el]))

-- | Inserts an element in a set focused in a 'TxSkel'. Fails if the element is
-- already present in the set.
insertInTweak ::
  ( Members '[Tweak, NonDet] effs,
    Is k A_Traversal,
    Ord a
  ) =>
  Optic' k is TxSkel (Set a) ->
  a ->
  Sem effs ()
insertInTweak :: forall (effs :: EffectRow) (k :: OpticKind) (a :: OpticKind)
       (is :: IxList).
(Members '[Tweak, NonDet] effs, Is k A_Traversal, Ord a) =>
Optic' k is TxSkel (Set a) -> a -> Sem effs ()
insertInTweak (forall (destKind :: OpticKind) (srcKind :: OpticKind)
       (is :: IxList) (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
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 (Set a) (Set a)
optic) a
a = do
  Optic' A_Traversal is TxSkel () -> Sem effs ()
forall (effs :: EffectRow) (k :: OpticKind) (is :: IxList)
       (a :: OpticKind).
(Members '[Tweak, NonDet] effs, Is k A_Fold) =>
Optic' k is TxSkel a -> Sem effs ()
guardTweak (Optic' A_Traversal is TxSkel () -> Sem effs ())
-> Optic' A_Traversal is TxSkel () -> Sem effs ()
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Optic A_Traversal is TxSkel TxSkel (Set a) (Set a)
optic Optic A_Traversal is TxSkel TxSkel (Set a) (Set a)
-> Optic A_Lens NoIx (Set a) (Set a) (Maybe ()) (Maybe ())
-> Optic A_Traversal is TxSkel TxSkel (Maybe ()) (Maybe ())
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(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
% Index (Set a) -> Lens' (Set a) (Maybe (IxValue (Set a)))
forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at a
Index (Set a)
a Optic A_Traversal is TxSkel TxSkel (Maybe ()) (Maybe ())
-> Optic A_Prism NoIx (Maybe ()) (Maybe ()) () ()
-> Optic' A_Traversal is TxSkel ()
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(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
% Optic A_Prism NoIx (Maybe ()) (Maybe ()) () ()
forall (a :: OpticKind). Prism' (Maybe a) ()
_Nothing
  Optic' A_Traversal is TxSkel Bool -> Bool -> Sem effs ()
forall (effs :: EffectRow) (k :: OpticKind) (is :: IxList)
       (a :: OpticKind).
(Member Tweak effs, Is k A_Setter) =>
Optic' k is TxSkel a -> a -> Sem effs ()
setTweak (Optic A_Traversal is TxSkel TxSkel (Set a) (Set a)
optic Optic A_Traversal is TxSkel TxSkel (Set a) (Set a)
-> Optic A_Lens NoIx (Set a) (Set a) Bool Bool
-> Optic' A_Traversal is TxSkel Bool
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(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
% Index (Set a) -> Optic A_Lens NoIx (Set a) (Set a) Bool Bool
forall (m :: OpticKind). Contains m => Index m -> Lens' m Bool
contains a
Index (Set a)
a) Bool
True

-- | Inserts an element in a map focused in a 'TxSkel'. Fails if the key is
-- already present in the map.
insertAtTweak ::
  ( Members '[Tweak, NonDet] effs,
    Is k A_Traversal,
    Ord k
  ) =>
  Optic' k is TxSkel (Map k v) ->
  k ->
  v ->
  Sem effs ()
insertAtTweak :: forall (effs :: EffectRow) (k :: OpticKind) (is :: IxList)
       (v :: OpticKind).
(Members '[Tweak, NonDet] effs, Is k A_Traversal, Ord k) =>
Optic' k is TxSkel (Map k v) -> k -> v -> Sem effs ()
insertAtTweak (forall (destKind :: OpticKind) (srcKind :: OpticKind)
       (is :: IxList) (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
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 (Map k v) (Map k v)
optic) k
k v
v = do
  Optic' A_Traversal is TxSkel () -> Sem effs ()
forall (effs :: EffectRow) (k :: OpticKind) (is :: IxList)
       (a :: OpticKind).
(Members '[Tweak, NonDet] effs, Is k A_Fold) =>
Optic' k is TxSkel a -> Sem effs ()
guardTweak (Optic' A_Traversal is TxSkel () -> Sem effs ())
-> Optic' A_Traversal is TxSkel () -> Sem effs ()
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Optic A_Traversal is TxSkel TxSkel (Map k v) (Map k v)
optic Optic A_Traversal is TxSkel TxSkel (Map k v) (Map k v)
-> Optic A_Lens NoIx (Map k v) (Map k v) (Maybe v) (Maybe v)
-> Optic A_Traversal is TxSkel TxSkel (Maybe v) (Maybe v)
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(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
% Index (Map k v) -> Lens' (Map k v) (Maybe (IxValue (Map k v)))
forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at k
Index (Map k v)
k Optic A_Traversal is TxSkel TxSkel (Maybe v) (Maybe v)
-> Optic A_Prism NoIx (Maybe v) (Maybe v) () ()
-> Optic' A_Traversal is TxSkel ()
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(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
% Optic A_Prism NoIx (Maybe v) (Maybe v) () ()
forall (a :: OpticKind). Prism' (Maybe a) ()
_Nothing
  Optic A_Traversal is TxSkel TxSkel (Maybe v) (Maybe v)
-> Maybe v -> Sem effs ()
forall (effs :: EffectRow) (k :: OpticKind) (is :: IxList)
       (a :: OpticKind).
(Member Tweak effs, Is k A_Setter) =>
Optic' k is TxSkel a -> a -> Sem effs ()
setTweak (Optic A_Traversal is TxSkel TxSkel (Map k v) (Map k v)
optic Optic A_Traversal is TxSkel TxSkel (Map k v) (Map k v)
-> Optic A_Lens NoIx (Map k v) (Map k v) (Maybe v) (Maybe v)
-> Optic A_Traversal is TxSkel TxSkel (Maybe v) (Maybe v)
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(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
% Index (Map k v) -> Lens' (Map k v) (Maybe (IxValue (Map k v)))
forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at k
Index (Map k v)
k) (v -> Maybe v
forall (a :: OpticKind). a -> Maybe a
Just v
v)