module Chiasma.Lens.Tree where

import Control.Lens (Fold, Index, IxValue, Ixed (ix), Plated (..), cosmos, makeClassy_, preview, transform, lens)
import Data.Data (Data)
import Data.Foldable (foldrM)
import Prelude hiding (ix, transform)

import Chiasma.Data.Ident (Ident, Identifiable (..))
import Chiasma.Ui.Data.View (LayoutView, PaneView, Tree (Tree), TreeSub (TreeNode))
import Chiasma.Ui.Lens.Ident (matchIdentP)

newtype NodeIndexTree l p =
  NodeIndexTree {
    forall l p. NodeIndexTree l p -> Tree l p
nitTree :: Tree l p
  }
  deriving stock (NodeIndexTree l p -> NodeIndexTree l p -> Bool
(NodeIndexTree l p -> NodeIndexTree l p -> Bool)
-> (NodeIndexTree l p -> NodeIndexTree l p -> Bool)
-> Eq (NodeIndexTree l p)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall l p.
(Eq l, Eq p) =>
NodeIndexTree l p -> NodeIndexTree l p -> Bool
$c== :: forall l p.
(Eq l, Eq p) =>
NodeIndexTree l p -> NodeIndexTree l p -> Bool
== :: NodeIndexTree l p -> NodeIndexTree l p -> Bool
$c/= :: forall l p.
(Eq l, Eq p) =>
NodeIndexTree l p -> NodeIndexTree l p -> Bool
/= :: NodeIndexTree l p -> NodeIndexTree l p -> Bool
Eq, Int -> NodeIndexTree l p -> ShowS
[NodeIndexTree l p] -> ShowS
NodeIndexTree l p -> String
(Int -> NodeIndexTree l p -> ShowS)
-> (NodeIndexTree l p -> String)
-> ([NodeIndexTree l p] -> ShowS)
-> Show (NodeIndexTree l p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall l p. (Show l, Show p) => Int -> NodeIndexTree l p -> ShowS
forall l p. (Show l, Show p) => [NodeIndexTree l p] -> ShowS
forall l p. (Show l, Show p) => NodeIndexTree l p -> String
$cshowsPrec :: forall l p. (Show l, Show p) => Int -> NodeIndexTree l p -> ShowS
showsPrec :: Int -> NodeIndexTree l p -> ShowS
$cshow :: forall l p. (Show l, Show p) => NodeIndexTree l p -> String
show :: NodeIndexTree l p -> String
$cshowList :: forall l p. (Show l, Show p) => [NodeIndexTree l p] -> ShowS
showList :: [NodeIndexTree l p] -> ShowS
Show)

makeClassy_ ''NodeIndexTree

newtype LeafIndexTree l p =
  LeafIndexTree {
    forall l p. LeafIndexTree l p -> Tree l p
litTree :: Tree l p
  }
  deriving stock (LeafIndexTree l p -> LeafIndexTree l p -> Bool
(LeafIndexTree l p -> LeafIndexTree l p -> Bool)
-> (LeafIndexTree l p -> LeafIndexTree l p -> Bool)
-> Eq (LeafIndexTree l p)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall l p.
(Eq l, Eq p) =>
LeafIndexTree l p -> LeafIndexTree l p -> Bool
$c== :: forall l p.
(Eq l, Eq p) =>
LeafIndexTree l p -> LeafIndexTree l p -> Bool
== :: LeafIndexTree l p -> LeafIndexTree l p -> Bool
$c/= :: forall l p.
(Eq l, Eq p) =>
LeafIndexTree l p -> LeafIndexTree l p -> Bool
/= :: LeafIndexTree l p -> LeafIndexTree l p -> Bool
Eq, Int -> LeafIndexTree l p -> ShowS
[LeafIndexTree l p] -> ShowS
LeafIndexTree l p -> String
(Int -> LeafIndexTree l p -> ShowS)
-> (LeafIndexTree l p -> String)
-> ([LeafIndexTree l p] -> ShowS)
-> Show (LeafIndexTree l p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall l p. (Show l, Show p) => Int -> LeafIndexTree l p -> ShowS
forall l p. (Show l, Show p) => [LeafIndexTree l p] -> ShowS
forall l p. (Show l, Show p) => LeafIndexTree l p -> String
$cshowsPrec :: forall l p. (Show l, Show p) => Int -> LeafIndexTree l p -> ShowS
showsPrec :: Int -> LeafIndexTree l p -> ShowS
$cshow :: forall l p. (Show l, Show p) => LeafIndexTree l p -> String
show :: LeafIndexTree l p -> String
$cshowList :: forall l p. (Show l, Show p) => [LeafIndexTree l p] -> ShowS
showList :: [LeafIndexTree l p] -> ShowS
Show)

makeClassy_ ''LeafIndexTree

plateWrap :: (Data l, Data p) => (Tree l p -> t l p) -> (t l p -> Tree l p) -> Traversal' (t l p) (t l p)
plateWrap :: forall l p (t :: * -> * -> *).
(Data l, Data p) =>
(Tree l p -> t l p)
-> (t l p -> Tree l p) -> Traversal' (t l p) (t l p)
plateWrap Tree l p -> t l p
consWrapper t l p -> Tree l p
unconsWrapper t l p -> f (t l p)
f t l p
wrappedTree =
  Tree l p -> t l p
consWrapper (Tree l p -> t l p) -> f (Tree l p) -> f (t l p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tree l p -> f (Tree l p)) -> Tree l p -> f (Tree l p)
forall a. Plated a => Traversal' a a
Traversal' (Tree l p) (Tree l p)
plate Tree l p -> f (Tree l p)
g (t l p -> Tree l p
unconsWrapper t l p
wrappedTree)
  where
    g :: Tree l p -> f (Tree l p)
g Tree l p
tree' = t l p -> Tree l p
unconsWrapper (t l p -> Tree l p) -> f (t l p) -> f (Tree l p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t l p -> f (t l p)
f (Tree l p -> t l p
consWrapper Tree l p
tree')

instance (Data l, Data p) => Plated (NodeIndexTree l p) where
  plate :: Traversal' (NodeIndexTree l p) (NodeIndexTree l p)
plate = (Tree l p -> NodeIndexTree l p)
-> (NodeIndexTree l p -> Tree l p)
-> Traversal' (NodeIndexTree l p) (NodeIndexTree l p)
forall l p (t :: * -> * -> *).
(Data l, Data p) =>
(Tree l p -> t l p)
-> (t l p -> Tree l p) -> Traversal' (t l p) (t l p)
plateWrap Tree l p -> NodeIndexTree l p
forall l p. Tree l p -> NodeIndexTree l p
NodeIndexTree (.nitTree)

instance (Data l, Data p) => Plated (LeafIndexTree l p) where
  plate :: Traversal' (LeafIndexTree l p) (LeafIndexTree l p)
plate = (Tree l p -> LeafIndexTree l p)
-> (LeafIndexTree l p -> Tree l p)
-> Traversal' (LeafIndexTree l p) (LeafIndexTree l p)
forall l p (t :: * -> * -> *).
(Data l, Data p) =>
(Tree l p -> t l p)
-> (t l p -> Tree l p) -> Traversal' (t l p) (t l p)
plateWrap Tree l p -> LeafIndexTree l p
forall l p. Tree l p -> LeafIndexTree l p
LeafIndexTree (.litTree)

type LayoutIndexTree = NodeIndexTree LayoutView PaneView
type PaneIndexTree = LeafIndexTree LayoutView PaneView

type instance Index (NodeIndexTree _ _) = Ident
type instance Index (LeafIndexTree _ _) = Ident

type instance IxValue (NodeIndexTree l _) = l
type instance IxValue (LeafIndexTree _ p) = p

nodeTraversal :: Traversal' (Tree l p) l
nodeTraversal :: forall l p (f :: * -> *).
Applicative f =>
(l -> f l) -> Tree l p -> f (Tree l p)
nodeTraversal = ([TreeSub l p] -> f [TreeSub l p]) -> Tree l p -> f (Tree l p)
#treeSubs (([TreeSub l p] -> f [TreeSub l p]) -> Tree l p -> f (Tree l p))
-> ((l -> f l) -> [TreeSub l p] -> f [TreeSub l p])
-> (l -> f l)
-> Tree l p
-> f (Tree l p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TreeSub l p -> f (TreeSub l p))
-> [TreeSub l p] -> f [TreeSub l p]
forall s t a b. Each s t a b => Traversal s t a b
Traversal [TreeSub l p] [TreeSub l p] (TreeSub l p) (TreeSub l p)
each ((TreeSub l p -> f (TreeSub l p))
 -> [TreeSub l p] -> f [TreeSub l p])
-> ((l -> f l) -> TreeSub l p -> f (TreeSub l p))
-> (l -> f l)
-> [TreeSub l p]
-> f [TreeSub l p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree l p -> f (Tree l p)) -> TreeSub l p -> f (TreeSub l p)
#_TreeNode ((Tree l p -> f (Tree l p)) -> TreeSub l p -> f (TreeSub l p))
-> ((l -> f l) -> Tree l p -> f (Tree l p))
-> (l -> f l)
-> TreeSub l p
-> f (TreeSub l p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (l -> f l) -> Tree l p -> f (Tree l p)
#treeData

nodeByIdentTraversal :: Identifiable l => Ident -> Traversal' (Tree l p) l
nodeByIdentTraversal :: forall l p. Identifiable l => Ident -> Traversal' (Tree l p) l
nodeByIdentTraversal Ident
ident = (l -> f l) -> Tree l p -> f (Tree l p)
forall l p (f :: * -> *).
Applicative f =>
(l -> f l) -> Tree l p -> f (Tree l p)
nodeTraversal ((l -> f l) -> Tree l p -> f (Tree l p))
-> ((l -> f l) -> l -> f l)
-> (l -> f l)
-> Tree l p
-> f (Tree l p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Prism' l l
forall a. Identifiable a => Ident -> Prism' a a
matchIdentP Ident
ident

leafDataTraversal :: Traversal' (Tree l p) p
leafDataTraversal :: forall l p (f :: * -> *).
Applicative f =>
(p -> f p) -> Tree l p -> f (Tree l p)
leafDataTraversal = ([TreeSub l p] -> f [TreeSub l p]) -> Tree l p -> f (Tree l p)
#treeSubs (([TreeSub l p] -> f [TreeSub l p]) -> Tree l p -> f (Tree l p))
-> ((p -> f p) -> [TreeSub l p] -> f [TreeSub l p])
-> (p -> f p)
-> Tree l p
-> f (Tree l p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TreeSub l p -> f (TreeSub l p))
-> [TreeSub l p] -> f [TreeSub l p]
forall s t a b. Each s t a b => Traversal s t a b
Traversal [TreeSub l p] [TreeSub l p] (TreeSub l p) (TreeSub l p)
each ((TreeSub l p -> f (TreeSub l p))
 -> [TreeSub l p] -> f [TreeSub l p])
-> ((p -> f p) -> TreeSub l p -> f (TreeSub l p))
-> (p -> f p)
-> [TreeSub l p]
-> f [TreeSub l p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p -> f p) -> TreeSub l p -> f (TreeSub l p)
#_TreeLeaf

leafByIdentTraversal :: Identifiable p => Ident -> Traversal' (Tree l p) p
leafByIdentTraversal :: forall p l. Identifiable p => Ident -> Traversal' (Tree l p) p
leafByIdentTraversal Ident
ident = (p -> f p) -> Tree l p -> f (Tree l p)
forall l p (f :: * -> *).
Applicative f =>
(p -> f p) -> Tree l p -> f (Tree l p)
leafDataTraversal ((p -> f p) -> Tree l p -> f (Tree l p))
-> ((p -> f p) -> p -> f p)
-> (p -> f p)
-> Tree l p
-> f (Tree l p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Prism' p p
forall a. Identifiable a => Ident -> Prism' a a
matchIdentP Ident
ident

instance Identifiable l => Ixed (NodeIndexTree l p) where
  ix :: Index (NodeIndexTree l p)
-> Traversal' (NodeIndexTree l p) (IxValue (NodeIndexTree l p))
ix Index (NodeIndexTree l p)
ident = (Tree l p -> f (Tree l p))
-> NodeIndexTree l p -> f (NodeIndexTree l p)
forall c l p. HasNodeIndexTree c l p => Lens' c (Tree l p)
Lens' (NodeIndexTree l p) (Tree l p)
_nitTree ((Tree l p -> f (Tree l p))
 -> NodeIndexTree l p -> f (NodeIndexTree l p))
-> ((l -> f l) -> Tree l p -> f (Tree l p))
-> (l -> f l)
-> NodeIndexTree l p
-> f (NodeIndexTree l p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Traversal' (Tree l p) l
forall l p. Identifiable l => Ident -> Traversal' (Tree l p) l
nodeByIdentTraversal Index (NodeIndexTree l p)
Ident
ident

nodesByIdentRecursive :: (Identifiable l, Data l, Data p) => Ident -> Fold (NodeIndexTree l p) l
nodesByIdentRecursive :: forall l p.
(Identifiable l, Data l, Data p) =>
Ident -> Fold (NodeIndexTree l p) l
nodesByIdentRecursive Ident
ident = (NodeIndexTree l p -> f (NodeIndexTree l p))
-> NodeIndexTree l p -> f (NodeIndexTree l p)
forall a. Plated a => Fold a a
Fold (NodeIndexTree l p) (NodeIndexTree l p)
cosmos ((NodeIndexTree l p -> f (NodeIndexTree l p))
 -> NodeIndexTree l p -> f (NodeIndexTree l p))
-> ((l -> f l) -> NodeIndexTree l p -> f (NodeIndexTree l p))
-> (l -> f l)
-> NodeIndexTree l p
-> f (NodeIndexTree l p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (NodeIndexTree l p)
-> Traversal' (NodeIndexTree l p) (IxValue (NodeIndexTree l p))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (NodeIndexTree l p)
Ident
ident

nodesIdent ::
  ∀ l p .
  Identifiable l =>
  Data l =>
  Data p =>
  Ident ->
  Fold (Tree l p) l
nodesIdent :: forall l p.
(Identifiable l, Data l, Data p) =>
Ident -> Fold (Tree l p) l
nodesIdent Ident
ident = (Tree l p -> NodeIndexTree l p)
-> (Tree l p -> NodeIndexTree l p -> Tree l p)
-> Lens
     (Tree l p) (Tree l p) (NodeIndexTree l p) (NodeIndexTree l p)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Tree l p -> NodeIndexTree l p
forall a b. Coercible a b => a -> b
coerce ((NodeIndexTree l p -> Tree l p)
-> Tree l p -> NodeIndexTree l p -> Tree l p
forall a b. a -> b -> a
const (.nitTree)) ((NodeIndexTree l p -> f (NodeIndexTree l p))
 -> Tree l p -> f (Tree l p))
-> ((l -> f l) -> NodeIndexTree l p -> f (NodeIndexTree l p))
-> (l -> f l)
-> Tree l p
-> f (Tree l p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Fold (NodeIndexTree l p) l
forall l p.
(Identifiable l, Data l, Data p) =>
Ident -> Fold (NodeIndexTree l p) l
nodesByIdentRecursive Ident
ident

nodeByIdent ::
  ∀ l p .
  Identifiable l =>
  Data l =>
  Data p =>
  Ident ->
  Tree l p ->
  Maybe l
nodeByIdent :: forall l p.
(Identifiable l, Data l, Data p) =>
Ident -> Tree l p -> Maybe l
nodeByIdent Ident
ident = Getting (First l) (Tree l p) l -> Tree l p -> Maybe l
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Ident -> Fold (Tree l p) l
forall l p.
(Identifiable l, Data l, Data p) =>
Ident -> Fold (Tree l p) l
nodesIdent Ident
ident)

nodesByIdent ::
  ∀ l p .
  Identifiable l =>
  Data l =>
  Data p =>
  Ident ->
  Tree l p ->
  [l]
nodesByIdent :: forall l p.
(Identifiable l, Data l, Data p) =>
Ident -> Tree l p -> [l]
nodesByIdent Ident
ident = Getting (Endo [l]) (Tree l p) l -> Tree l p -> [l]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (Ident -> Fold (Tree l p) l
forall l p.
(Identifiable l, Data l, Data p) =>
Ident -> Fold (Tree l p) l
nodesIdent Ident
ident)

instance Identifiable p => Ixed (LeafIndexTree l p) where
  ix :: Index (LeafIndexTree l p)
-> Traversal' (LeafIndexTree l p) (IxValue (LeafIndexTree l p))
ix Index (LeafIndexTree l p)
ident = (Tree l p -> f (Tree l p))
-> LeafIndexTree l p -> f (LeafIndexTree l p)
forall c l p. HasLeafIndexTree c l p => Lens' c (Tree l p)
Lens' (LeafIndexTree l p) (Tree l p)
_litTree ((Tree l p -> f (Tree l p))
 -> LeafIndexTree l p -> f (LeafIndexTree l p))
-> ((p -> f p) -> Tree l p -> f (Tree l p))
-> (p -> f p)
-> LeafIndexTree l p
-> f (LeafIndexTree l p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Traversal' (Tree l p) p
forall p l. Identifiable p => Ident -> Traversal' (Tree l p) p
leafByIdentTraversal Index (LeafIndexTree l p)
Ident
ident

leavesByIdentRecursive ::
  ∀ l p .
  Identifiable p =>
  Data l =>
  Data p =>
  Ident ->
  Fold (LeafIndexTree l p) p
leavesByIdentRecursive :: forall l p.
(Identifiable p, Data l, Data p) =>
Ident -> Fold (LeafIndexTree l p) p
leavesByIdentRecursive Ident
ident = (LeafIndexTree l p -> f (LeafIndexTree l p))
-> LeafIndexTree l p -> f (LeafIndexTree l p)
forall a. Plated a => Fold a a
Fold (LeafIndexTree l p) (LeafIndexTree l p)
cosmos ((LeafIndexTree l p -> f (LeafIndexTree l p))
 -> LeafIndexTree l p -> f (LeafIndexTree l p))
-> ((p -> f p) -> LeafIndexTree l p -> f (LeafIndexTree l p))
-> (p -> f p)
-> LeafIndexTree l p
-> f (LeafIndexTree l p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (LeafIndexTree l p)
-> Traversal' (LeafIndexTree l p) (IxValue (LeafIndexTree l p))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (LeafIndexTree l p)
Ident
ident

leavesIdent ::
  ∀ l p .
  Identifiable p =>
  Data l =>
  Data p =>
  Ident ->
  Fold (Tree l p) p
leavesIdent :: forall l p.
(Identifiable p, Data l, Data p) =>
Ident -> Fold (Tree l p) p
leavesIdent Ident
ident = (Tree l p -> LeafIndexTree l p)
-> (Tree l p -> LeafIndexTree l p -> Tree l p)
-> Lens
     (Tree l p) (Tree l p) (LeafIndexTree l p) (LeafIndexTree l p)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Tree l p -> LeafIndexTree l p
forall a b. Coercible a b => a -> b
coerce ((LeafIndexTree l p -> Tree l p)
-> Tree l p -> LeafIndexTree l p -> Tree l p
forall a b. a -> b -> a
const (.litTree)) ((LeafIndexTree l p -> f (LeafIndexTree l p))
 -> Tree l p -> f (Tree l p))
-> ((p -> f p) -> LeafIndexTree l p -> f (LeafIndexTree l p))
-> (p -> f p)
-> Tree l p
-> f (Tree l p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Fold (LeafIndexTree l p) p
forall l p.
(Identifiable p, Data l, Data p) =>
Ident -> Fold (LeafIndexTree l p) p
leavesByIdentRecursive Ident
ident

leafByIdent ::
  ∀ l p .
  Identifiable p =>
  Data l =>
  Data p =>
  Ident ->
  Tree l p ->
  Maybe p
leafByIdent :: forall l p.
(Identifiable p, Data l, Data p) =>
Ident -> Tree l p -> Maybe p
leafByIdent Ident
ident = Getting (First p) (Tree l p) p -> Tree l p -> Maybe p
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Ident -> Fold (Tree l p) p
forall l p.
(Identifiable p, Data l, Data p) =>
Ident -> Fold (Tree l p) p
leavesIdent Ident
ident)

leavesByIdent ::
  ∀ l p .
  Identifiable p =>
  Data l =>
  Data p =>
  Ident ->
  Tree l p ->
  [p]
leavesByIdent :: forall l p.
(Identifiable p, Data l, Data p) =>
Ident -> Tree l p -> [p]
leavesByIdent Ident
ident = Getting (Endo [p]) (Tree l p) p -> Tree l p -> [p]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (Ident -> Fold (Tree l p) p
forall l p.
(Identifiable p, Data l, Data p) =>
Ident -> Fold (Tree l p) p
leavesIdent Ident
ident)

modifyLeafByIdent :: (Identifiable p, Data l, Data p) => Ident -> (p -> p) -> Tree l p -> Tree l p
modifyLeafByIdent :: forall p l.
(Identifiable p, Data l, Data p) =>
Ident -> (p -> p) -> Tree l p -> Tree l p
modifyLeafByIdent Ident
ident p -> p
f Tree l p
tree' =
  (.litTree) (LeafIndexTree l p -> Tree l p) -> LeafIndexTree l p -> Tree l p
forall a b. (a -> b) -> a -> b
$ ((LeafIndexTree l p -> LeafIndexTree l p)
-> LeafIndexTree l p -> LeafIndexTree l p
forall a. Plated a => (a -> a) -> a -> a
transform ((LeafIndexTree l p -> LeafIndexTree l p)
 -> LeafIndexTree l p -> LeafIndexTree l p)
-> (LeafIndexTree l p -> LeafIndexTree l p)
-> LeafIndexTree l p
-> LeafIndexTree l p
forall a b. (a -> b) -> a -> b
$ ASetter (LeafIndexTree l p) (LeafIndexTree l p) p p
-> (p -> p) -> LeafIndexTree l p -> LeafIndexTree l p
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Index (LeafIndexTree l p)
-> Traversal' (LeafIndexTree l p) (IxValue (LeafIndexTree l p))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (LeafIndexTree l p)
Ident
ident) p -> p
f) (Tree l p -> LeafIndexTree l p
forall l p. Tree l p -> LeafIndexTree l p
LeafIndexTree Tree l p
tree')

subtreesWithLayout :: ∀ l p m. Monad m => ((l, TreeSub l p) -> m (l, TreeSub l p)) -> Tree l p -> m (Tree l p)
subtreesWithLayout :: forall l p (m :: * -> *).
Monad m =>
((l, TreeSub l p) -> m (l, TreeSub l p))
-> Tree l p -> m (Tree l p)
subtreesWithLayout (l, TreeSub l p) -> m (l, TreeSub l p)
f (Tree l
l0 [TreeSub l p]
sub) = do
  (l
newL, [TreeSub l p]
newSub) <- (TreeSub l p -> (l, [TreeSub l p]) -> m (l, [TreeSub l p]))
-> (l, [TreeSub l p]) -> [TreeSub l p] -> m (l, [TreeSub l p])
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM TreeSub l p -> (l, [TreeSub l p]) -> m (l, [TreeSub l p])
applySub (l
l0, []) [TreeSub l p]
sub
  Tree l p -> m (Tree l p)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (l -> [TreeSub l p] -> Tree l p
forall l p. l -> [TreeSub l p] -> Tree l p
Tree l
newL [TreeSub l p]
newSub)
  where
    prependSub :: [a] -> (a, a) -> (a, [a])
prependSub [a]
s (a
newL, a
newN) = (a
newL, a
newN a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
s)
    applySub :: TreeSub l p -> (l, [TreeSub l p]) -> m (l, [TreeSub l p])
    applySub :: TreeSub l p -> (l, [TreeSub l p]) -> m (l, [TreeSub l p])
applySub (TreeNode Tree l p
t) (l
l, [TreeSub l p]
s) = do
      (l, TreeSub l p)
recur <- (\Tree l p
rsub -> (l
l, Tree l p -> TreeSub l p
forall l p. Tree l p -> TreeSub l p
TreeNode Tree l p
rsub)) (Tree l p -> (l, TreeSub l p))
-> m (Tree l p) -> m (l, TreeSub l p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((l, TreeSub l p) -> m (l, TreeSub l p))
-> Tree l p -> m (Tree l p)
forall l p (m :: * -> *).
Monad m =>
((l, TreeSub l p) -> m (l, TreeSub l p))
-> Tree l p -> m (Tree l p)
subtreesWithLayout (l, TreeSub l p) -> m (l, TreeSub l p)
f Tree l p
t
      (((l, TreeSub l p) -> (l, [TreeSub l p]))
-> m (l, TreeSub l p) -> m (l, [TreeSub l p])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([TreeSub l p] -> (l, TreeSub l p) -> (l, [TreeSub l p])
forall {a} {a}. [a] -> (a, a) -> (a, [a])
prependSub [TreeSub l p]
s) (m (l, TreeSub l p) -> m (l, [TreeSub l p]))
-> ((l, TreeSub l p) -> m (l, TreeSub l p))
-> (l, TreeSub l p)
-> m (l, [TreeSub l p])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (l, TreeSub l p) -> m (l, TreeSub l p)
f) (l, TreeSub l p)
recur
    applySub TreeSub l p
p (l
l, [TreeSub l p]
s) =
      (((l, TreeSub l p) -> (l, [TreeSub l p]))
-> m (l, TreeSub l p) -> m (l, [TreeSub l p])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([TreeSub l p] -> (l, TreeSub l p) -> (l, [TreeSub l p])
forall {a} {a}. [a] -> (a, a) -> (a, [a])
prependSub [TreeSub l p]
s) (m (l, TreeSub l p) -> m (l, [TreeSub l p]))
-> ((l, TreeSub l p) -> m (l, TreeSub l p))
-> (l, TreeSub l p)
-> m (l, [TreeSub l p])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (l, TreeSub l p) -> m (l, TreeSub l p)
f) (l
l, TreeSub l p
p)

subtrees :: ∀ l p m. Monad m => (TreeSub l p -> m (TreeSub l p)) -> Tree l p -> m (Tree l p)
subtrees :: forall l p (m :: * -> *).
Monad m =>
(TreeSub l p -> m (TreeSub l p)) -> Tree l p -> m (Tree l p)
subtrees TreeSub l p -> m (TreeSub l p)
f (Tree l
l [TreeSub l p]
sub) = do
  [TreeSub l p]
newSub <- (TreeSub l p -> m (TreeSub l p))
-> [TreeSub l p] -> m [TreeSub l p]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TreeSub l p -> m (TreeSub l p)
applySub [TreeSub l p]
sub
  pure (l -> [TreeSub l p] -> Tree l p
forall l p. l -> [TreeSub l p] -> Tree l p
Tree l
l [TreeSub l p]
newSub)
  where
    applySub :: TreeSub l p -> m (TreeSub l p)
    applySub :: TreeSub l p -> m (TreeSub l p)
applySub (TreeNode Tree l p
t) = do
      Tree l p
recur <- (TreeSub l p -> m (TreeSub l p)) -> Tree l p -> m (Tree l p)
forall l p (m :: * -> *).
Monad m =>
(TreeSub l p -> m (TreeSub l p)) -> Tree l p -> m (Tree l p)
subtrees TreeSub l p -> m (TreeSub l p)
f Tree l p
t
      TreeSub l p -> m (TreeSub l p)
f (Tree l p -> TreeSub l p
forall l p. Tree l p -> TreeSub l p
TreeNode Tree l p
recur)
    applySub TreeSub l p
p = TreeSub l p -> m (TreeSub l p)
f TreeSub l p
p

treesAndSubs ::
  Monad m =>
  (Tree l p -> m (Tree l p)) ->
  (TreeSub l p -> m (TreeSub l p)) ->
  Tree l p ->
  m (Tree l p)
treesAndSubs :: forall (m :: * -> *) l p.
Monad m =>
(Tree l p -> m (Tree l p))
-> (TreeSub l p -> m (TreeSub l p)) -> Tree l p -> m (Tree l p)
treesAndSubs Tree l p -> m (Tree l p)
ft TreeSub l p -> m (TreeSub l p)
fs (Tree l
l [TreeSub l p]
sub) = do
  [TreeSub l p]
treeResult <- (TreeSub l p -> m (TreeSub l p))
-> [TreeSub l p] -> m [TreeSub l p]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TreeSub l p -> m (TreeSub l p)
applySub [TreeSub l p]
sub
  Tree l p -> m (Tree l p)
ft (l -> [TreeSub l p] -> Tree l p
forall l p. l -> [TreeSub l p] -> Tree l p
Tree l
l [TreeSub l p]
treeResult)
  where
    applySub :: TreeSub l p -> m (TreeSub l p)
applySub (TreeNode Tree l p
t) = do
      Tree l p
recur <- (Tree l p -> m (Tree l p))
-> (TreeSub l p -> m (TreeSub l p)) -> Tree l p -> m (Tree l p)
forall (m :: * -> *) l p.
Monad m =>
(Tree l p -> m (Tree l p))
-> (TreeSub l p -> m (TreeSub l p)) -> Tree l p -> m (Tree l p)
treesAndSubs Tree l p -> m (Tree l p)
ft TreeSub l p -> m (TreeSub l p)
fs Tree l p
t
      TreeSub l p -> m (TreeSub l p)
fs (Tree l p -> TreeSub l p
forall l p. Tree l p -> TreeSub l p
TreeNode Tree l p
recur)
    applySub TreeSub l p
p = TreeSub l p -> m (TreeSub l p)
fs TreeSub l p
p