module Chiasma.Ui.ViewTree where

import Control.Lens (anyOf, cosmos, ix, mapMOf, transformM)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (ExceptT (ExceptT), runExceptT)
import Control.Monad.Trans.Writer (WriterT, runWriterT, tell)
import Data.Composition ((.:))
import Data.Semigroup (Sum (Sum))
import Exon (exon)
import Prelude hiding (ix, tell)

import Chiasma.Data.Ident (Ident)
import Chiasma.Lens.Tree (LeafIndexTree (..), _litTree, leafDataTraversal)
import Chiasma.Ui.Data.TreeModError (TreeModError (AmbiguousLayout, AmbiguousPane, LayoutMissing, PaneMissing))
import Chiasma.Ui.Data.View (
  Pane (Pane),
  PaneView,
  Tree (Tree),
  TreeSub (TreeLeaf, TreeNode),
  View (View),
  ViewTree,
  ViewTreeSub,
  )
import Chiasma.Ui.Data.ViewState (ViewState (ViewState))
import Chiasma.Ui.Pane (paneSetOpen, paneToggleOpen)

modCounted :: Monad m => (a -> m a) -> a -> WriterT (Sum Int) m a
modCounted :: forall (m :: * -> *) a.
Monad m =>
(a -> m a) -> a -> WriterT (Sum Int) m a
modCounted a -> m a
f a
a = do
  Sum Int -> WriterT (Sum Int) m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (Int -> Sum Int
forall a. a -> Sum a
Sum Int
1)
  m a -> WriterT (Sum Int) m a
forall (m :: * -> *) a. Monad m => m a -> WriterT (Sum Int) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT (Sum Int) m a) -> m a -> WriterT (Sum Int) m a
forall a b. (a -> b) -> a -> b
$ a -> m a
f a
a

treeToggleOpen :: ViewTree -> ViewTree
treeToggleOpen :: Tree LayoutView (View Pane) -> Tree LayoutView (View Pane)
treeToggleOpen (Tree LayoutView
l [ViewTreeSub]
sub) =
  LayoutView -> [ViewTreeSub] -> Tree LayoutView (View Pane)
forall l p. l -> [TreeSub l p] -> Tree l p
Tree LayoutView
l ((Bool, [ViewTreeSub]) -> [ViewTreeSub]
forall a b. (a, b) -> b
snd ((Bool, [ViewTreeSub]) -> [ViewTreeSub])
-> (Bool, [ViewTreeSub]) -> [ViewTreeSub]
forall a b. (a -> b) -> a -> b
$ (Bool -> ViewTreeSub -> (Bool, ViewTreeSub))
-> Bool -> [ViewTreeSub] -> (Bool, [ViewTreeSub])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Bool -> ViewTreeSub -> (Bool, ViewTreeSub)
forall {l}.
Bool -> TreeSub l (View Pane) -> (Bool, TreeSub l (View Pane))
toggle Bool
False [ViewTreeSub]
sub)
  where
    toggle :: Bool -> TreeSub l (View Pane) -> (Bool, TreeSub l (View Pane))
toggle Bool
False (TreeLeaf View Pane
p) = (Bool
True, View Pane -> TreeSub l (View Pane)
forall l p. p -> TreeSub l p
TreeLeaf (View Pane -> View Pane
paneToggleOpen View Pane
p))
    toggle Bool
a TreeSub l (View Pane)
b = (Bool
a, TreeSub l (View Pane)
b)

modifyTreeUniqueM :: Monad m => (ViewTree -> m ViewTree) -> Ident -> ViewTree -> ExceptT TreeModError m ViewTree
modifyTreeUniqueM :: forall (m :: * -> *).
Monad m =>
(Tree LayoutView (View Pane) -> m (Tree LayoutView (View Pane)))
-> Ident
-> Tree LayoutView (View Pane)
-> ExceptT TreeModError m (Tree LayoutView (View Pane))
modifyTreeUniqueM Tree LayoutView (View Pane) -> m (Tree LayoutView (View Pane))
f Ident
ident Tree LayoutView (View Pane)
tree = do
  let st :: WriterT (Sum Int) m (Tree LayoutView (View Pane))
st = ((Tree LayoutView (View Pane)
 -> WriterT (Sum Int) m (Tree LayoutView (View Pane)))
-> Tree LayoutView (View Pane)
-> WriterT (Sum Int) m (Tree LayoutView (View Pane))
forall (m :: * -> *) a.
(Monad m, Plated a) =>
(a -> m a) -> a -> m a
transformM ((Tree LayoutView (View Pane)
  -> WriterT (Sum Int) m (Tree LayoutView (View Pane)))
 -> Tree LayoutView (View Pane)
 -> WriterT (Sum Int) m (Tree LayoutView (View Pane)))
-> (Tree LayoutView (View Pane)
    -> WriterT (Sum Int) m (Tree LayoutView (View Pane)))
-> Tree LayoutView (View Pane)
-> WriterT (Sum Int) m (Tree LayoutView (View Pane))
forall a b. (a -> b) -> a -> b
$ LensLike
  (WrappedMonad (WriterT (Sum Int) m))
  (Tree LayoutView (View Pane))
  (Tree LayoutView (View Pane))
  (Tree LayoutView (View Pane))
  (Tree LayoutView (View Pane))
-> (Tree LayoutView (View Pane)
    -> WriterT (Sum Int) m (Tree LayoutView (View Pane)))
-> Tree LayoutView (View Pane)
-> WriterT (Sum Int) m (Tree LayoutView (View Pane))
forall (m :: * -> *) s t a b.
LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t
mapMOf (Index (Tree LayoutView (View Pane))
-> Traversal'
     (Tree LayoutView (View Pane))
     (IxValue (Tree LayoutView (View Pane)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Tree LayoutView (View Pane))
Ident
ident) ((Tree LayoutView (View Pane) -> m (Tree LayoutView (View Pane)))
-> Tree LayoutView (View Pane)
-> WriterT (Sum Int) m (Tree LayoutView (View Pane))
forall (m :: * -> *) a.
Monad m =>
(a -> m a) -> a -> WriterT (Sum Int) m a
modCounted Tree LayoutView (View Pane) -> m (Tree LayoutView (View Pane))
f)) Tree LayoutView (View Pane)
tree
  (Tree LayoutView (View Pane)
result, Sum Int
count) <- m (Tree LayoutView (View Pane), Sum Int)
-> ExceptT TreeModError m (Tree LayoutView (View Pane), Sum Int)
forall (m :: * -> *) a. Monad m => m a -> ExceptT TreeModError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Tree LayoutView (View Pane), Sum Int)
 -> ExceptT TreeModError m (Tree LayoutView (View Pane), Sum Int))
-> m (Tree LayoutView (View Pane), Sum Int)
-> ExceptT TreeModError m (Tree LayoutView (View Pane), Sum Int)
forall a b. (a -> b) -> a -> b
$ WriterT (Sum Int) m (Tree LayoutView (View Pane))
-> m (Tree LayoutView (View Pane), Sum Int)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT (Sum Int) m (Tree LayoutView (View Pane))
st
  case Int
count of
    Int
1 -> Tree LayoutView (View Pane)
-> ExceptT TreeModError m (Tree LayoutView (View Pane))
forall a. a -> ExceptT TreeModError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tree LayoutView (View Pane)
result
    Int
0 -> m (Either TreeModError (Tree LayoutView (View Pane)))
-> ExceptT TreeModError m (Tree LayoutView (View Pane))
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (Either TreeModError (Tree LayoutView (View Pane))
-> m (Either TreeModError (Tree LayoutView (View Pane)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TreeModError -> Either TreeModError (Tree LayoutView (View Pane))
forall a b. a -> Either a b
Left (Ident -> TreeModError
LayoutMissing Ident
ident)))
    Int
n -> m (Either TreeModError (Tree LayoutView (View Pane)))
-> ExceptT TreeModError m (Tree LayoutView (View Pane))
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (Either TreeModError (Tree LayoutView (View Pane))
-> m (Either TreeModError (Tree LayoutView (View Pane)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TreeModError -> Either TreeModError (Tree LayoutView (View Pane))
forall a b. a -> Either a b
Left (Ident -> Int -> TreeModError
AmbiguousLayout Ident
ident Int
n)))

toggleLayout1 :: Ident -> ViewTree -> Either TreeModError ViewTree
toggleLayout1 :: Ident
-> Tree LayoutView (View Pane)
-> Either TreeModError (Tree LayoutView (View Pane))
toggleLayout1 Ident
ident Tree LayoutView (View Pane)
tree =
  Identity (Either TreeModError (Tree LayoutView (View Pane)))
-> Either TreeModError (Tree LayoutView (View Pane))
forall a. Identity a -> a
runIdentity (Identity (Either TreeModError (Tree LayoutView (View Pane)))
 -> Either TreeModError (Tree LayoutView (View Pane)))
-> Identity (Either TreeModError (Tree LayoutView (View Pane)))
-> Either TreeModError (Tree LayoutView (View Pane))
forall a b. (a -> b) -> a -> b
$ ExceptT TreeModError Identity (Tree LayoutView (View Pane))
-> Identity (Either TreeModError (Tree LayoutView (View Pane)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT TreeModError Identity (Tree LayoutView (View Pane))
 -> Identity (Either TreeModError (Tree LayoutView (View Pane))))
-> ExceptT TreeModError Identity (Tree LayoutView (View Pane))
-> Identity (Either TreeModError (Tree LayoutView (View Pane)))
forall a b. (a -> b) -> a -> b
$ (Tree LayoutView (View Pane)
 -> Identity (Tree LayoutView (View Pane)))
-> Ident
-> Tree LayoutView (View Pane)
-> ExceptT TreeModError Identity (Tree LayoutView (View Pane))
forall (m :: * -> *).
Monad m =>
(Tree LayoutView (View Pane) -> m (Tree LayoutView (View Pane)))
-> Ident
-> Tree LayoutView (View Pane)
-> ExceptT TreeModError m (Tree LayoutView (View Pane))
modifyTreeUniqueM (Tree LayoutView (View Pane)
-> Identity (Tree LayoutView (View Pane))
forall a. a -> Identity a
Identity (Tree LayoutView (View Pane)
 -> Identity (Tree LayoutView (View Pane)))
-> (Tree LayoutView (View Pane) -> Tree LayoutView (View Pane))
-> Tree LayoutView (View Pane)
-> Identity (Tree LayoutView (View Pane))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree LayoutView (View Pane) -> Tree LayoutView (View Pane)
treeToggleOpen) Ident
ident Tree LayoutView (View Pane)
tree

modifyPaneUniqueM :: Monad m => (PaneView -> m PaneView) -> Ident -> ViewTree -> ExceptT TreeModError m ViewTree
modifyPaneUniqueM :: forall (m :: * -> *).
Monad m =>
(View Pane -> m (View Pane))
-> Ident
-> Tree LayoutView (View Pane)
-> ExceptT TreeModError m (Tree LayoutView (View Pane))
modifyPaneUniqueM View Pane -> m (View Pane)
f Ident
ident Tree LayoutView (View Pane)
tree = do
  let st :: WriterT (Sum Int) m (LeafIndexTree LayoutView (View Pane))
st = ((LeafIndexTree LayoutView (View Pane)
 -> WriterT (Sum Int) m (LeafIndexTree LayoutView (View Pane)))
-> LeafIndexTree LayoutView (View Pane)
-> WriterT (Sum Int) m (LeafIndexTree LayoutView (View Pane))
forall (m :: * -> *) a.
(Monad m, Plated a) =>
(a -> m a) -> a -> m a
transformM ((LeafIndexTree LayoutView (View Pane)
  -> WriterT (Sum Int) m (LeafIndexTree LayoutView (View Pane)))
 -> LeafIndexTree LayoutView (View Pane)
 -> WriterT (Sum Int) m (LeafIndexTree LayoutView (View Pane)))
-> (LeafIndexTree LayoutView (View Pane)
    -> WriterT (Sum Int) m (LeafIndexTree LayoutView (View Pane)))
-> LeafIndexTree LayoutView (View Pane)
-> WriterT (Sum Int) m (LeafIndexTree LayoutView (View Pane))
forall a b. (a -> b) -> a -> b
$ LensLike
  (WrappedMonad (WriterT (Sum Int) m))
  (LeafIndexTree LayoutView (View Pane))
  (LeafIndexTree LayoutView (View Pane))
  (View Pane)
  (View Pane)
-> (View Pane -> WriterT (Sum Int) m (View Pane))
-> LeafIndexTree LayoutView (View Pane)
-> WriterT (Sum Int) m (LeafIndexTree LayoutView (View Pane))
forall (m :: * -> *) s t a b.
LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t
mapMOf (Index (LeafIndexTree LayoutView (View Pane))
-> Traversal'
     (LeafIndexTree LayoutView (View Pane))
     (IxValue (LeafIndexTree LayoutView (View Pane)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (LeafIndexTree LayoutView (View Pane))
Ident
ident) ((View Pane -> m (View Pane))
-> View Pane -> WriterT (Sum Int) m (View Pane)
forall (m :: * -> *) a.
Monad m =>
(a -> m a) -> a -> WriterT (Sum Int) m a
modCounted View Pane -> m (View Pane)
f)) (Tree LayoutView (View Pane) -> LeafIndexTree LayoutView (View Pane)
forall l p. Tree l p -> LeafIndexTree l p
LeafIndexTree Tree LayoutView (View Pane)
tree)
  (LeafIndexTree LayoutView (View Pane)
result, Sum Int
count) <- m (LeafIndexTree LayoutView (View Pane), Sum Int)
-> ExceptT
     TreeModError m (LeafIndexTree LayoutView (View Pane), Sum Int)
forall (m :: * -> *) a. Monad m => m a -> ExceptT TreeModError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (LeafIndexTree LayoutView (View Pane), Sum Int)
 -> ExceptT
      TreeModError m (LeafIndexTree LayoutView (View Pane), Sum Int))
-> m (LeafIndexTree LayoutView (View Pane), Sum Int)
-> ExceptT
     TreeModError m (LeafIndexTree LayoutView (View Pane), Sum Int)
forall a b. (a -> b) -> a -> b
$ WriterT (Sum Int) m (LeafIndexTree LayoutView (View Pane))
-> m (LeafIndexTree LayoutView (View Pane), Sum Int)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT (Sum Int) m (LeafIndexTree LayoutView (View Pane))
st
  case Int
count of
    Int
1 -> Tree LayoutView (View Pane)
-> ExceptT TreeModError m (Tree LayoutView (View Pane))
forall a. a -> ExceptT TreeModError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tree LayoutView (View Pane)
 -> ExceptT TreeModError m (Tree LayoutView (View Pane)))
-> Tree LayoutView (View Pane)
-> ExceptT TreeModError m (Tree LayoutView (View Pane))
forall a b. (a -> b) -> a -> b
$ (.litTree) LeafIndexTree LayoutView (View Pane)
result
    Int
0 -> m (Either TreeModError (Tree LayoutView (View Pane)))
-> ExceptT TreeModError m (Tree LayoutView (View Pane))
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (Either TreeModError (Tree LayoutView (View Pane))
-> m (Either TreeModError (Tree LayoutView (View Pane)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TreeModError -> Either TreeModError (Tree LayoutView (View Pane))
forall a b. a -> Either a b
Left (Ident -> TreeModError
PaneMissing Ident
ident)))
    Int
n -> m (Either TreeModError (Tree LayoutView (View Pane)))
-> ExceptT TreeModError m (Tree LayoutView (View Pane))
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (Either TreeModError (Tree LayoutView (View Pane))
-> m (Either TreeModError (Tree LayoutView (View Pane)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TreeModError -> Either TreeModError (Tree LayoutView (View Pane))
forall a b. a -> Either a b
Left (Ident -> Int -> TreeModError
AmbiguousPane Ident
ident Int
n)))

modifyPane :: (PaneView -> PaneView) -> Ident -> ViewTree -> Either TreeModError ViewTree
modifyPane :: (View Pane -> View Pane)
-> Ident
-> Tree LayoutView (View Pane)
-> Either TreeModError (Tree LayoutView (View Pane))
modifyPane View Pane -> View Pane
modification Ident
ident Tree LayoutView (View Pane)
tree =
  Identity (Either TreeModError (Tree LayoutView (View Pane)))
-> Either TreeModError (Tree LayoutView (View Pane))
forall a. Identity a -> a
runIdentity (Identity (Either TreeModError (Tree LayoutView (View Pane)))
 -> Either TreeModError (Tree LayoutView (View Pane)))
-> Identity (Either TreeModError (Tree LayoutView (View Pane)))
-> Either TreeModError (Tree LayoutView (View Pane))
forall a b. (a -> b) -> a -> b
$ ExceptT TreeModError Identity (Tree LayoutView (View Pane))
-> Identity (Either TreeModError (Tree LayoutView (View Pane)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT TreeModError Identity (Tree LayoutView (View Pane))
 -> Identity (Either TreeModError (Tree LayoutView (View Pane))))
-> ExceptT TreeModError Identity (Tree LayoutView (View Pane))
-> Identity (Either TreeModError (Tree LayoutView (View Pane)))
forall a b. (a -> b) -> a -> b
$ (View Pane -> Identity (View Pane))
-> Ident
-> Tree LayoutView (View Pane)
-> ExceptT TreeModError Identity (Tree LayoutView (View Pane))
forall (m :: * -> *).
Monad m =>
(View Pane -> m (View Pane))
-> Ident
-> Tree LayoutView (View Pane)
-> ExceptT TreeModError m (Tree LayoutView (View Pane))
modifyPaneUniqueM (View Pane -> Identity (View Pane)
forall a. a -> Identity a
Identity (View Pane -> Identity (View Pane))
-> (View Pane -> View Pane) -> View Pane -> Identity (View Pane)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. View Pane -> View Pane
modification) Ident
ident Tree LayoutView (View Pane)
tree

openPane :: Ident -> ViewTree -> Either TreeModError ViewTree
openPane :: Ident
-> Tree LayoutView (View Pane)
-> Either TreeModError (Tree LayoutView (View Pane))
openPane =
  (View Pane -> View Pane)
-> Ident
-> Tree LayoutView (View Pane)
-> Either TreeModError (Tree LayoutView (View Pane))
modifyPane View Pane -> View Pane
paneSetOpen

hasOpenPanes :: ViewTree -> Bool
hasOpenPanes :: Tree LayoutView (View Pane) -> Bool
hasOpenPanes Tree LayoutView (View Pane)
tree =
  Getting Any (LeafIndexTree LayoutView (View Pane)) (View Pane)
-> LeafIndexTree LayoutView (View Pane) -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((LeafIndexTree LayoutView (View Pane)
 -> Const Any (LeafIndexTree LayoutView (View Pane)))
-> LeafIndexTree LayoutView (View Pane)
-> Const Any (LeafIndexTree LayoutView (View Pane))
forall a. Plated a => Fold a a
Fold
  (LeafIndexTree LayoutView (View Pane))
  (LeafIndexTree LayoutView (View Pane))
cosmos ((LeafIndexTree LayoutView (View Pane)
  -> Const Any (LeafIndexTree LayoutView (View Pane)))
 -> LeafIndexTree LayoutView (View Pane)
 -> Const Any (LeafIndexTree LayoutView (View Pane)))
-> Getting Any (LeafIndexTree LayoutView (View Pane)) (View Pane)
-> Getting Any (LeafIndexTree LayoutView (View Pane)) (View Pane)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree LayoutView (View Pane)
 -> Const Any (Tree LayoutView (View Pane)))
-> LeafIndexTree LayoutView (View Pane)
-> Const Any (LeafIndexTree LayoutView (View Pane))
forall c l p. HasLeafIndexTree c l p => Lens' c (Tree l p)
Lens'
  (LeafIndexTree LayoutView (View Pane))
  (Tree LayoutView (View Pane))
_litTree ((Tree LayoutView (View Pane)
  -> Const Any (Tree LayoutView (View Pane)))
 -> LeafIndexTree LayoutView (View Pane)
 -> Const Any (LeafIndexTree LayoutView (View Pane)))
-> ((View Pane -> Const Any (View Pane))
    -> Tree LayoutView (View Pane)
    -> Const Any (Tree LayoutView (View Pane)))
-> Getting Any (LeafIndexTree LayoutView (View Pane)) (View Pane)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (View Pane -> Const Any (View Pane))
-> Tree LayoutView (View Pane)
-> Const Any (Tree LayoutView (View Pane))
forall l p (f :: * -> *).
Applicative f =>
(p -> f p) -> Tree l p -> f (Tree l p)
leafDataTraversal ((View Pane -> Const Any (View Pane))
 -> Tree LayoutView (View Pane)
 -> Const Any (Tree LayoutView (View Pane)))
-> ((View Pane -> Const Any (View Pane))
    -> View Pane -> Const Any (View Pane))
-> (View Pane -> Const Any (View Pane))
-> Tree LayoutView (View Pane)
-> Const Any (Tree LayoutView (View Pane))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (View Pane -> Bool) -> Traversal' (View Pane) (View Pane)
forall a. (a -> Bool) -> Traversal' a a
filtered View Pane -> Bool
isOpen) (Tree LayoutView (View Pane) -> LeafIndexTree LayoutView (View Pane)
forall l p. Tree l p -> LeafIndexTree l p
LeafIndexTree Tree LayoutView (View Pane)
tree)
  where
    isOpen :: View Pane -> Bool
isOpen (View Ident
_ ViewState
_ ViewGeometry
_ (Pane Bool
open Bool
_ Maybe Text
_)) = Bool
open

depthTraverseTree ::
  ∀ a.
  Monoid a =>
  (a -> ViewTree -> (a, ViewTree)) ->
  (PaneView -> (a, PaneView)) ->
  ViewTree ->
  (a, ViewTree)
depthTraverseTree :: forall a.
Monoid a =>
(a
 -> Tree LayoutView (View Pane) -> (a, Tree LayoutView (View Pane)))
-> (View Pane -> (a, View Pane))
-> Tree LayoutView (View Pane)
-> (a, Tree LayoutView (View Pane))
depthTraverseTree a
-> Tree LayoutView (View Pane) -> (a, Tree LayoutView (View Pane))
transformNode View Pane -> (a, View Pane)
transformLeaf =
  Tree LayoutView (View Pane) -> (a, Tree LayoutView (View Pane))
recur
  where
    recur :: ViewTree -> (a, ViewTree)
    recur :: Tree LayoutView (View Pane) -> (a, Tree LayoutView (View Pane))
recur (Tree LayoutView
l [ViewTreeSub]
sub) =
      (a
 -> Tree LayoutView (View Pane) -> (a, Tree LayoutView (View Pane)))
-> (a, Tree LayoutView (View Pane))
-> (a, Tree LayoutView (View Pane))
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a
-> Tree LayoutView (View Pane) -> (a, Tree LayoutView (View Pane))
transformNode ((a, Tree LayoutView (View Pane))
 -> (a, Tree LayoutView (View Pane)))
-> ([(a, ViewTreeSub)] -> (a, Tree LayoutView (View Pane)))
-> [(a, ViewTreeSub)]
-> (a, Tree LayoutView (View Pane))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> a)
-> ([ViewTreeSub] -> Tree LayoutView (View Pane))
-> ([a], [ViewTreeSub])
-> (a, Tree LayoutView (View Pane))
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [a] -> a
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (LayoutView -> [ViewTreeSub] -> Tree LayoutView (View Pane)
forall l p. l -> [TreeSub l p] -> Tree l p
Tree LayoutView
l) (([a], [ViewTreeSub]) -> (a, Tree LayoutView (View Pane)))
-> ([(a, ViewTreeSub)] -> ([a], [ViewTreeSub]))
-> [(a, ViewTreeSub)]
-> (a, Tree LayoutView (View Pane))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, ViewTreeSub)] -> ([a], [ViewTreeSub])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(a, ViewTreeSub)] -> (a, Tree LayoutView (View Pane)))
-> [(a, ViewTreeSub)] -> (a, Tree LayoutView (View Pane))
forall a b. (a -> b) -> a -> b
$ (ViewTreeSub -> (a, ViewTreeSub)
recSub (ViewTreeSub -> (a, ViewTreeSub))
-> [ViewTreeSub] -> [(a, ViewTreeSub)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ViewTreeSub]
sub)
    recSub :: ViewTreeSub -> (a, ViewTreeSub)
    recSub :: ViewTreeSub -> (a, ViewTreeSub)
recSub (TreeNode Tree LayoutView (View Pane)
t) =
      (Tree LayoutView (View Pane) -> ViewTreeSub)
-> (a, Tree LayoutView (View Pane)) -> (a, ViewTreeSub)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Tree LayoutView (View Pane) -> ViewTreeSub
forall l p. Tree l p -> TreeSub l p
TreeNode ((a, Tree LayoutView (View Pane)) -> (a, ViewTreeSub))
-> (a, Tree LayoutView (View Pane)) -> (a, ViewTreeSub)
forall a b. (a -> b) -> a -> b
$ Tree LayoutView (View Pane) -> (a, Tree LayoutView (View Pane))
recur Tree LayoutView (View Pane)
t
    recSub (TreeLeaf View Pane
l) =
      (View Pane -> ViewTreeSub) -> (a, View Pane) -> (a, ViewTreeSub)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second View Pane -> ViewTreeSub
forall l p. p -> TreeSub l p
TreeLeaf ((a, View Pane) -> (a, ViewTreeSub))
-> (a, View Pane) -> (a, ViewTreeSub)
forall a b. (a -> b) -> a -> b
$ View Pane -> (a, View Pane)
transformLeaf View Pane
l

data ToggleStatus =
  Minimized
  |
  Opened
  |
  Pristine
  |
  Multiple Int
  |
  Consistent
  deriving stock (ToggleStatus -> ToggleStatus -> Bool
(ToggleStatus -> ToggleStatus -> Bool)
-> (ToggleStatus -> ToggleStatus -> Bool) -> Eq ToggleStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ToggleStatus -> ToggleStatus -> Bool
== :: ToggleStatus -> ToggleStatus -> Bool
$c/= :: ToggleStatus -> ToggleStatus -> Bool
/= :: ToggleStatus -> ToggleStatus -> Bool
Eq, Int -> ToggleStatus -> ShowS
[ToggleStatus] -> ShowS
ToggleStatus -> String
(Int -> ToggleStatus -> ShowS)
-> (ToggleStatus -> String)
-> ([ToggleStatus] -> ShowS)
-> Show ToggleStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ToggleStatus -> ShowS
showsPrec :: Int -> ToggleStatus -> ShowS
$cshow :: ToggleStatus -> String
show :: ToggleStatus -> String
$cshowList :: [ToggleStatus] -> ShowS
showList :: [ToggleStatus] -> ShowS
Show)

instance Semigroup ToggleStatus where
  ToggleStatus
Pristine <> :: ToggleStatus -> ToggleStatus -> ToggleStatus
<> ToggleStatus
a = ToggleStatus
a
  ToggleStatus
a <> ToggleStatus
Pristine = ToggleStatus
a
  Multiple Int
a <> Multiple Int
b = Int -> ToggleStatus
Multiple (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b)
  Multiple Int
a <> ToggleStatus
_ = Int -> ToggleStatus
Multiple (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  ToggleStatus
_ <> Multiple Int
a = Int -> ToggleStatus
Multiple (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  ToggleStatus
_ <> ToggleStatus
_ = Int -> ToggleStatus
Multiple Int
2

instance Monoid ToggleStatus where
  mempty :: ToggleStatus
mempty = ToggleStatus
Pristine

data ToggleResult a =
  Success a
  |
  NotFound
  |
  Ambiguous Int
  deriving stock (ToggleResult a -> ToggleResult a -> Bool
(ToggleResult a -> ToggleResult a -> Bool)
-> (ToggleResult a -> ToggleResult a -> Bool)
-> Eq (ToggleResult a)
forall a. Eq a => ToggleResult a -> ToggleResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ToggleResult a -> ToggleResult a -> Bool
== :: ToggleResult a -> ToggleResult a -> Bool
$c/= :: forall a. Eq a => ToggleResult a -> ToggleResult a -> Bool
/= :: ToggleResult a -> ToggleResult a -> Bool
Eq, Int -> ToggleResult a -> ShowS
[ToggleResult a] -> ShowS
ToggleResult a -> String
(Int -> ToggleResult a -> ShowS)
-> (ToggleResult a -> String)
-> ([ToggleResult a] -> ShowS)
-> Show (ToggleResult a)
forall a. Show a => Int -> ToggleResult a -> ShowS
forall a. Show a => [ToggleResult a] -> ShowS
forall a. Show a => ToggleResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ToggleResult a -> ShowS
showsPrec :: Int -> ToggleResult a -> ShowS
$cshow :: forall a. Show a => ToggleResult a -> String
show :: ToggleResult a -> String
$cshowList :: forall a. Show a => [ToggleResult a] -> ShowS
showList :: [ToggleResult a] -> ShowS
Show, (forall a b. (a -> b) -> ToggleResult a -> ToggleResult b)
-> (forall a b. a -> ToggleResult b -> ToggleResult a)
-> Functor ToggleResult
forall a b. a -> ToggleResult b -> ToggleResult a
forall a b. (a -> b) -> ToggleResult a -> ToggleResult b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ToggleResult a -> ToggleResult b
fmap :: forall a b. (a -> b) -> ToggleResult a -> ToggleResult b
$c<$ :: forall a b. a -> ToggleResult b -> ToggleResult a
<$ :: forall a b. a -> ToggleResult b -> ToggleResult a
Functor)

instance Semigroup (ToggleResult a) where
  ToggleResult a
NotFound <> :: ToggleResult a -> ToggleResult a -> ToggleResult a
<> ToggleResult a
a = ToggleResult a
a
  ToggleResult a
a <> ToggleResult a
NotFound = ToggleResult a
a
  Ambiguous Int
a <> Ambiguous Int
b = Int -> ToggleResult a
forall a. Int -> ToggleResult a
Ambiguous (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b)
  Ambiguous Int
a <> ToggleResult a
_ = Int -> ToggleResult a
forall a. Int -> ToggleResult a
Ambiguous (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  ToggleResult a
_ <> Ambiguous Int
a = Int -> ToggleResult a
forall a. Int -> ToggleResult a
Ambiguous (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  ToggleResult a
_ <> ToggleResult a
_ = Int -> ToggleResult a
forall a. Int -> ToggleResult a
Ambiguous Int
2

instance Monoid (ToggleResult a) where
  mempty :: ToggleResult a
mempty = ToggleResult a
forall a. ToggleResult a
NotFound

instance Applicative ToggleResult where
  pure :: forall a. a -> ToggleResult a
pure = a -> ToggleResult a
forall a. a -> ToggleResult a
Success
  (Success a -> b
f) <*> :: forall a b.
ToggleResult (a -> b) -> ToggleResult a -> ToggleResult b
<*> ToggleResult a
fa = (a -> b) -> ToggleResult a -> ToggleResult b
forall a b. (a -> b) -> ToggleResult a -> ToggleResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ToggleResult a
fa
  ToggleResult (a -> b)
NotFound <*> ToggleResult a
_ = ToggleResult b
forall a. ToggleResult a
NotFound
  Ambiguous Int
n <*> ToggleResult a
_ = Int -> ToggleResult b
forall a. Int -> ToggleResult a
Ambiguous Int
n

instance Monad ToggleResult where
    Success a
a >>= :: forall a b.
ToggleResult a -> (a -> ToggleResult b) -> ToggleResult b
>>= a -> ToggleResult b
f = a -> ToggleResult b
f a
a
    ToggleResult a
NotFound >>= a -> ToggleResult b
_ = ToggleResult b
forall a. ToggleResult a
NotFound
    Ambiguous Int
n >>= a -> ToggleResult b
_ = Int -> ToggleResult b
forall a. Int -> ToggleResult a
Ambiguous Int
n

toggleResultEither :: ToggleResult a -> Either Text a
toggleResultEither :: forall a. ToggleResult a -> Either Text a
toggleResultEither = \case
  Success a
a -> a -> Either Text a
forall a b. b -> Either a b
Right a
a
  ToggleResult a
NotFound -> Text -> Either Text a
forall a b. a -> Either a b
Left Text
"not found"
  Ambiguous Int
n -> Text -> Either Text a
forall a b. a -> Either a b
Left [exon|ambiguous: #{show n}|]

openPinnedSubs :: ToggleStatus -> ViewTree -> (ToggleStatus, ViewTree)
openPinnedSubs :: ToggleStatus
-> Tree LayoutView (View Pane)
-> (ToggleStatus, Tree LayoutView (View Pane))
openPinnedSubs ToggleStatus
Pristine Tree LayoutView (View Pane)
t =
  (ToggleStatus
Pristine, Tree LayoutView (View Pane)
t)
openPinnedSubs ToggleStatus
Opened (Tree LayoutView
l [ViewTreeSub]
sub) =
  (ToggleStatus
Opened, LayoutView -> [ViewTreeSub] -> Tree LayoutView (View Pane)
forall l p. l -> [TreeSub l p] -> Tree l p
Tree LayoutView
l (ViewTreeSub -> ViewTreeSub
openPinnedPane (ViewTreeSub -> ViewTreeSub) -> [ViewTreeSub] -> [ViewTreeSub]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ViewTreeSub]
sub))
  where
    openPinnedPane :: ViewTreeSub -> ViewTreeSub
    openPinnedPane :: ViewTreeSub -> ViewTreeSub
openPinnedPane (TreeLeaf (View Ident
i ViewState
s ViewGeometry
g (Pane Bool
False Bool
True Maybe Text
cwd))) =
      View Pane -> ViewTreeSub
forall l p. p -> TreeSub l p
TreeLeaf (View Pane -> ViewTreeSub) -> View Pane -> ViewTreeSub
forall a b. (a -> b) -> a -> b
$ Ident -> ViewState -> ViewGeometry -> Pane -> View Pane
forall a. Ident -> ViewState -> ViewGeometry -> a -> View a
View Ident
i ViewState
s ViewGeometry
g (Bool -> Bool -> Maybe Text -> Pane
Pane Bool
True Bool
True Maybe Text
cwd)
    openPinnedPane ViewTreeSub
v =
      ViewTreeSub
v
openPinnedSubs ToggleStatus
a Tree LayoutView (View Pane)
t =
  (ToggleStatus
a, Tree LayoutView (View Pane)
t)

checkToggleResult ::
  ToggleStatus ->
  a ->
  ToggleResult a
checkToggleResult :: forall a. ToggleStatus -> a -> ToggleResult a
checkToggleResult =
  ToggleStatus -> a -> ToggleResult a
forall a. ToggleStatus -> a -> ToggleResult a
checkResult
  where
    checkResult :: ToggleStatus -> a -> ToggleResult a
checkResult ToggleStatus
Pristine a
_ = ToggleResult a
forall a. ToggleResult a
NotFound
    checkResult (Multiple Int
n) a
_ = Int -> ToggleResult a
forall a. Int -> ToggleResult a
Ambiguous Int
n
    checkResult ToggleStatus
_ a
result = a -> ToggleResult a
forall a. a -> ToggleResult a
Success a
result

togglePaneView :: Ident -> PaneView -> (ToggleStatus, PaneView)
togglePaneView :: Ident -> View Pane -> (ToggleStatus, View Pane)
togglePaneView Ident
ident (View Ident
i ViewState
s ViewGeometry
g (Pane Bool
False Bool
p Maybe Text
c)) | Ident
ident Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
i =
  (ToggleStatus
Opened, Ident -> ViewState -> ViewGeometry -> Pane -> View Pane
forall a. Ident -> ViewState -> ViewGeometry -> a -> View a
View Ident
i ViewState
s ViewGeometry
g (Bool -> Bool -> Maybe Text -> Pane
Pane Bool
True Bool
p Maybe Text
c))
togglePaneView Ident
ident (View Ident
i (ViewState Bool
minimized) ViewGeometry
g (Pane Bool
True Bool
p Maybe Text
c)) | Ident
ident Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
i =
  (ToggleStatus
Minimized, Ident -> ViewState -> ViewGeometry -> Pane -> View Pane
forall a. Ident -> ViewState -> ViewGeometry -> a -> View a
View Ident
i (Bool -> ViewState
ViewState (Bool -> Bool
not Bool
minimized)) ViewGeometry
g (Bool -> Bool -> Maybe Text -> Pane
Pane Bool
False Bool
p Maybe Text
c))
togglePaneView Ident
_ View Pane
v =
  (ToggleStatus
Pristine, View Pane
v)

togglePaneNode :: Ident -> ViewTreeSub -> (ToggleStatus, ViewTreeSub)
togglePaneNode :: Ident -> ViewTreeSub -> (ToggleStatus, ViewTreeSub)
togglePaneNode Ident
ident (TreeLeaf View Pane
v) =
  (View Pane -> ViewTreeSub)
-> (ToggleStatus, View Pane) -> (ToggleStatus, ViewTreeSub)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second View Pane -> ViewTreeSub
forall l p. p -> TreeSub l p
TreeLeaf (Ident -> View Pane -> (ToggleStatus, View Pane)
togglePaneView Ident
ident View Pane
v)
togglePaneNode Ident
_ ViewTreeSub
t =
  (ToggleStatus
Pristine, ViewTreeSub
t)

togglePane :: Ident -> ViewTree -> ToggleResult ViewTree
togglePane :: Ident
-> Tree LayoutView (View Pane)
-> ToggleResult (Tree LayoutView (View Pane))
togglePane Ident
ident =
  (ToggleStatus
 -> Tree LayoutView (View Pane)
 -> ToggleResult (Tree LayoutView (View Pane)))
-> (ToggleStatus, Tree LayoutView (View Pane))
-> ToggleResult (Tree LayoutView (View Pane))
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ToggleStatus
-> Tree LayoutView (View Pane)
-> ToggleResult (Tree LayoutView (View Pane))
forall a. ToggleStatus -> a -> ToggleResult a
checkToggleResult ((ToggleStatus, Tree LayoutView (View Pane))
 -> ToggleResult (Tree LayoutView (View Pane)))
-> (Tree LayoutView (View Pane)
    -> (ToggleStatus, Tree LayoutView (View Pane)))
-> Tree LayoutView (View Pane)
-> ToggleResult (Tree LayoutView (View Pane))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ToggleStatus
 -> Tree LayoutView (View Pane)
 -> (ToggleStatus, Tree LayoutView (View Pane)))
-> (View Pane -> (ToggleStatus, View Pane))
-> Tree LayoutView (View Pane)
-> (ToggleStatus, Tree LayoutView (View Pane))
forall a.
Monoid a =>
(a
 -> Tree LayoutView (View Pane) -> (a, Tree LayoutView (View Pane)))
-> (View Pane -> (a, View Pane))
-> Tree LayoutView (View Pane)
-> (a, Tree LayoutView (View Pane))
depthTraverseTree ToggleStatus
-> Tree LayoutView (View Pane)
-> (ToggleStatus, Tree LayoutView (View Pane))
openPinnedSubs (Ident -> View Pane -> (ToggleStatus, View Pane)
togglePaneView Ident
ident)

togglePaneOpenTraversal' ::
  Traversal' a ViewTree ->
  Ident ->
  a ->
  ToggleResult a
togglePaneOpenTraversal' :: forall a.
Traversal' a (Tree LayoutView (View Pane))
-> Ident -> a -> ToggleResult a
togglePaneOpenTraversal' Traversal' a (Tree LayoutView (View Pane))
lens =
  LensLike
  (WrappedMonad ToggleResult)
  a
  a
  (Tree LayoutView (View Pane))
  (Tree LayoutView (View Pane))
-> (Tree LayoutView (View Pane)
    -> ToggleResult (Tree LayoutView (View Pane)))
-> a
-> ToggleResult a
forall (m :: * -> *) s t a b.
LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t
mapMOf LensLike
  (WrappedMonad ToggleResult)
  a
  a
  (Tree LayoutView (View Pane))
  (Tree LayoutView (View Pane))
Traversal' a (Tree LayoutView (View Pane))
lens ((Tree LayoutView (View Pane)
  -> ToggleResult (Tree LayoutView (View Pane)))
 -> a -> ToggleResult a)
-> (Ident
    -> Tree LayoutView (View Pane)
    -> ToggleResult (Tree LayoutView (View Pane)))
-> Ident
-> a
-> ToggleResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident
-> Tree LayoutView (View Pane)
-> ToggleResult (Tree LayoutView (View Pane))
togglePane

ensurePaneViewOpen :: Ident -> PaneView -> (ToggleStatus, PaneView)
ensurePaneViewOpen :: Ident -> View Pane -> (ToggleStatus, View Pane)
ensurePaneViewOpen Ident
ident (View Ident
i ViewState
s ViewGeometry
g (Pane Bool
False Bool
p Maybe Text
c)) | Ident
ident Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
i =
  (ToggleStatus
Opened, Ident -> ViewState -> ViewGeometry -> Pane -> View Pane
forall a. Ident -> ViewState -> ViewGeometry -> a -> View a
View Ident
i ViewState
s ViewGeometry
g (Bool -> Bool -> Maybe Text -> Pane
Pane Bool
True Bool
p Maybe Text
c))
ensurePaneViewOpen Ident
ident v :: View Pane
v@(View Ident
i ViewState
_ ViewGeometry
_ Pane
_) | Ident
ident Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
i =
  (ToggleStatus
Consistent, View Pane
v)
ensurePaneViewOpen Ident
_ View Pane
v =
  (ToggleStatus
Pristine, View Pane
v)

ensurePaneOpen :: Ident -> ViewTree -> ToggleResult ViewTree
ensurePaneOpen :: Ident
-> Tree LayoutView (View Pane)
-> ToggleResult (Tree LayoutView (View Pane))
ensurePaneOpen Ident
ident =
  (ToggleStatus
 -> Tree LayoutView (View Pane)
 -> ToggleResult (Tree LayoutView (View Pane)))
-> (ToggleStatus, Tree LayoutView (View Pane))
-> ToggleResult (Tree LayoutView (View Pane))
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ToggleStatus
-> Tree LayoutView (View Pane)
-> ToggleResult (Tree LayoutView (View Pane))
forall a. ToggleStatus -> a -> ToggleResult a
checkToggleResult ((ToggleStatus, Tree LayoutView (View Pane))
 -> ToggleResult (Tree LayoutView (View Pane)))
-> (Tree LayoutView (View Pane)
    -> (ToggleStatus, Tree LayoutView (View Pane)))
-> Tree LayoutView (View Pane)
-> ToggleResult (Tree LayoutView (View Pane))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ToggleStatus
 -> Tree LayoutView (View Pane)
 -> (ToggleStatus, Tree LayoutView (View Pane)))
-> (View Pane -> (ToggleStatus, View Pane))
-> Tree LayoutView (View Pane)
-> (ToggleStatus, Tree LayoutView (View Pane))
forall a.
Monoid a =>
(a
 -> Tree LayoutView (View Pane) -> (a, Tree LayoutView (View Pane)))
-> (View Pane -> (a, View Pane))
-> Tree LayoutView (View Pane)
-> (a, Tree LayoutView (View Pane))
depthTraverseTree ToggleStatus
-> Tree LayoutView (View Pane)
-> (ToggleStatus, Tree LayoutView (View Pane))
openPinnedSubs (Ident -> View Pane -> (ToggleStatus, View Pane)
ensurePaneViewOpen Ident
ident)

ensurePaneOpenTraversal ::
  Traversal a (ToggleResult a) ViewTree (ToggleResult ViewTree) ->
  Ident ->
  a ->
  ToggleResult a
ensurePaneOpenTraversal :: forall a.
Traversal
  a
  (ToggleResult a)
  (Tree LayoutView (View Pane))
  (ToggleResult (Tree LayoutView (View Pane)))
-> Ident -> a -> ToggleResult a
ensurePaneOpenTraversal Traversal
  a
  (ToggleResult a)
  (Tree LayoutView (View Pane))
  (ToggleResult (Tree LayoutView (View Pane)))
lens =
  ASetter
  a
  (ToggleResult a)
  (Tree LayoutView (View Pane))
  (ToggleResult (Tree LayoutView (View Pane)))
-> (Tree LayoutView (View Pane)
    -> ToggleResult (Tree LayoutView (View Pane)))
-> a
-> ToggleResult a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  a
  (ToggleResult a)
  (Tree LayoutView (View Pane))
  (ToggleResult (Tree LayoutView (View Pane)))
Traversal
  a
  (ToggleResult a)
  (Tree LayoutView (View Pane))
  (ToggleResult (Tree LayoutView (View Pane)))
lens ((Tree LayoutView (View Pane)
  -> ToggleResult (Tree LayoutView (View Pane)))
 -> a -> ToggleResult a)
-> (Ident
    -> Tree LayoutView (View Pane)
    -> ToggleResult (Tree LayoutView (View Pane)))
-> Ident
-> a
-> ToggleResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident
-> Tree LayoutView (View Pane)
-> ToggleResult (Tree LayoutView (View Pane))
ensurePaneOpen

ensurePaneOpenTraversal' ::
  Traversal' a ViewTree ->
  Ident ->
  a ->
  ToggleResult a
ensurePaneOpenTraversal' :: forall a.
Traversal' a (Tree LayoutView (View Pane))
-> Ident -> a -> ToggleResult a
ensurePaneOpenTraversal' Traversal' a (Tree LayoutView (View Pane))
lens =
  LensLike
  (WrappedMonad ToggleResult)
  a
  a
  (Tree LayoutView (View Pane))
  (Tree LayoutView (View Pane))
-> (Tree LayoutView (View Pane)
    -> ToggleResult (Tree LayoutView (View Pane)))
-> a
-> ToggleResult a
forall (m :: * -> *) s t a b.
LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t
mapMOf LensLike
  (WrappedMonad ToggleResult)
  a
  a
  (Tree LayoutView (View Pane))
  (Tree LayoutView (View Pane))
Traversal' a (Tree LayoutView (View Pane))
lens ((Tree LayoutView (View Pane)
  -> ToggleResult (Tree LayoutView (View Pane)))
 -> a -> ToggleResult a)
-> (Ident
    -> Tree LayoutView (View Pane)
    -> ToggleResult (Tree LayoutView (View Pane)))
-> Ident
-> a
-> ToggleResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident
-> Tree LayoutView (View Pane)
-> ToggleResult (Tree LayoutView (View Pane))
ensurePaneOpen

skipFold ::
  Traversable t =>
  (a -> (ToggleStatus, a)) ->
  ToggleStatus ->
  t a ->
  (ToggleStatus, t a)
skipFold :: forall (t :: * -> *) a.
Traversable t =>
(a -> (ToggleStatus, a))
-> ToggleStatus -> t a -> (ToggleStatus, t a)
skipFold a -> (ToggleStatus, a)
f =
  (ToggleStatus -> a -> (ToggleStatus, a))
-> ToggleStatus -> t a -> (ToggleStatus, t a)
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL ToggleStatus -> a -> (ToggleStatus, a)
skipper
  where
    skipper :: ToggleStatus -> a -> (ToggleStatus, a)
skipper ToggleStatus
Pristine a
a =
      a -> (ToggleStatus, a)
f a
a
    skipper ToggleStatus
status a
a =
      (ToggleStatus
status, a
a)

isOpenPaneNode :: ViewTreeSub -> Bool
isOpenPaneNode :: ViewTreeSub -> Bool
isOpenPaneNode =
  Getting Any ViewTreeSub Bool
-> (Bool -> Bool) -> ViewTreeSub -> Bool
forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf ((View Pane -> Const Any (View Pane))
-> ViewTreeSub -> Const Any ViewTreeSub
#_TreeLeaf ((View Pane -> Const Any (View Pane))
 -> ViewTreeSub -> Const Any ViewTreeSub)
-> ((Bool -> Const Any Bool) -> View Pane -> Const Any (View Pane))
-> Getting Any ViewTreeSub Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pane -> Const Any Pane) -> View Pane -> Const Any (View Pane)
#extra ((Pane -> Const Any Pane) -> View Pane -> Const Any (View Pane))
-> ((Bool -> Const Any Bool) -> Pane -> Const Any Pane)
-> (Bool -> Const Any Bool)
-> View Pane
-> Const Any (View Pane)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Any Bool) -> Pane -> Const Any Pane
#open) Bool -> Bool
forall a. a -> a
id

openPinnedPaneView :: PaneView -> (ToggleStatus, PaneView)
openPinnedPaneView :: View Pane -> (ToggleStatus, View Pane)
openPinnedPaneView (View Ident
i ViewState
s ViewGeometry
g (Pane Bool
False Bool
True Maybe Text
c)) =
  (ToggleStatus
Opened, Ident -> ViewState -> ViewGeometry -> Pane -> View Pane
forall a. Ident -> ViewState -> ViewGeometry -> a -> View a
View Ident
i ViewState
s ViewGeometry
g (Bool -> Bool -> Maybe Text -> Pane
Pane Bool
True Bool
True Maybe Text
c))
openPinnedPaneView View Pane
v =
  (ToggleStatus
Pristine, View Pane
v)

openFirstPinnedPaneNode :: ViewTreeSub -> (ToggleStatus, ViewTreeSub)
openFirstPinnedPaneNode :: ViewTreeSub -> (ToggleStatus, ViewTreeSub)
openFirstPinnedPaneNode (TreeLeaf View Pane
v) =
  (View Pane -> ViewTreeSub)
-> (ToggleStatus, View Pane) -> (ToggleStatus, ViewTreeSub)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second View Pane -> ViewTreeSub
forall l p. p -> TreeSub l p
TreeLeaf (View Pane -> (ToggleStatus, View Pane)
openPinnedPaneView View Pane
v)
openFirstPinnedPaneNode ViewTreeSub
a =
  (ToggleStatus
Pristine, ViewTreeSub
a)

openPaneView :: PaneView -> (ToggleStatus, PaneView)
openPaneView :: View Pane -> (ToggleStatus, View Pane)
openPaneView (View Ident
i ViewState
s ViewGeometry
g (Pane Bool
False Bool
p Maybe Text
c)) =
  (ToggleStatus
Opened, Ident -> ViewState -> ViewGeometry -> Pane -> View Pane
forall a. Ident -> ViewState -> ViewGeometry -> a -> View a
View Ident
i ViewState
s ViewGeometry
g (Bool -> Bool -> Maybe Text -> Pane
Pane Bool
True Bool
p Maybe Text
c))
openPaneView View Pane
v =
  (ToggleStatus
Pristine, View Pane
v)

openFirstPaneNode :: ViewTreeSub -> (ToggleStatus, ViewTreeSub)
openFirstPaneNode :: ViewTreeSub -> (ToggleStatus, ViewTreeSub)
openFirstPaneNode (TreeLeaf View Pane
v) =
  (View Pane -> ViewTreeSub)
-> (ToggleStatus, View Pane) -> (ToggleStatus, ViewTreeSub)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second View Pane -> ViewTreeSub
forall l p. p -> TreeSub l p
TreeLeaf (View Pane -> (ToggleStatus, View Pane)
openPaneView View Pane
v)
openFirstPaneNode ViewTreeSub
a =
  (ToggleStatus
Pristine, ViewTreeSub
a)

-- TODO recurse when opening pane
toggleLayoutNode :: Ident -> ToggleStatus -> ViewTree -> (ToggleStatus, ViewTree)
toggleLayoutNode :: Ident
-> ToggleStatus
-> Tree LayoutView (View Pane)
-> (ToggleStatus, Tree LayoutView (View Pane))
toggleLayoutNode Ident
ident ToggleStatus
previous (Tree v :: LayoutView
v@(View Ident
i (ViewState Bool
minimized) ViewGeometry
g Layout
l) [ViewTreeSub]
sub) | Ident
ident Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
i =
  (ToggleStatus -> ToggleStatus)
-> (ToggleStatus, Tree LayoutView (View Pane))
-> (ToggleStatus, Tree LayoutView (View Pane))
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ToggleStatus
previous <>) (if Bool
open then (ToggleStatus, Tree LayoutView (View Pane))
toggleMinimized else (ToggleStatus, Tree LayoutView (View Pane))
openPane')
  where
    open :: Bool
open =
      (ViewTreeSub -> Bool) -> [ViewTreeSub] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ViewTreeSub -> Bool
isOpenPaneNode [ViewTreeSub]
sub
    toggleMinimized :: (ToggleStatus, Tree LayoutView (View Pane))
toggleMinimized =
      (ToggleStatus
Minimized, LayoutView -> [ViewTreeSub] -> Tree LayoutView (View Pane)
forall l p. l -> [TreeSub l p] -> Tree l p
Tree (Ident -> ViewState -> ViewGeometry -> Layout -> LayoutView
forall a. Ident -> ViewState -> ViewGeometry -> a -> View a
View Ident
i (Bool -> ViewState
ViewState (Bool -> Bool
not Bool
minimized)) ViewGeometry
g Layout
l) [ViewTreeSub]
sub)
    openPane' :: (ToggleStatus, Tree LayoutView (View Pane))
openPane' =
      ([ViewTreeSub] -> Tree LayoutView (View Pane))
-> (ToggleStatus, [ViewTreeSub])
-> (ToggleStatus, Tree LayoutView (View Pane))
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (LayoutView -> [ViewTreeSub] -> Tree LayoutView (View Pane)
forall l p. l -> [TreeSub l p] -> Tree l p
Tree LayoutView
v) ((ToggleStatus -> [ViewTreeSub] -> (ToggleStatus, [ViewTreeSub]))
-> (ToggleStatus, [ViewTreeSub]) -> (ToggleStatus, [ViewTreeSub])
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ToggleStatus -> [ViewTreeSub] -> (ToggleStatus, [ViewTreeSub])
regularIfPristine (ToggleStatus, [ViewTreeSub])
openFirstPinned)
    openFirstPinned :: (ToggleStatus, [ViewTreeSub])
openFirstPinned =
      (ViewTreeSub -> (ToggleStatus, ViewTreeSub))
-> ToggleStatus -> [ViewTreeSub] -> (ToggleStatus, [ViewTreeSub])
forall (t :: * -> *) a.
Traversable t =>
(a -> (ToggleStatus, a))
-> ToggleStatus -> t a -> (ToggleStatus, t a)
skipFold ViewTreeSub -> (ToggleStatus, ViewTreeSub)
openFirstPinnedPaneNode ToggleStatus
Pristine [ViewTreeSub]
sub
    openFirstRegular :: (ToggleStatus, [ViewTreeSub])
openFirstRegular =
      (ViewTreeSub -> (ToggleStatus, ViewTreeSub))
-> ToggleStatus -> [ViewTreeSub] -> (ToggleStatus, [ViewTreeSub])
forall (t :: * -> *) a.
Traversable t =>
(a -> (ToggleStatus, a))
-> ToggleStatus -> t a -> (ToggleStatus, t a)
skipFold ViewTreeSub -> (ToggleStatus, ViewTreeSub)
openFirstPaneNode ToggleStatus
Pristine [ViewTreeSub]
sub
    regularIfPristine :: ToggleStatus -> [ViewTreeSub] -> (ToggleStatus, [ViewTreeSub])
regularIfPristine ToggleStatus
Pristine [ViewTreeSub]
_ =
      (ToggleStatus, [ViewTreeSub])
openFirstRegular
    regularIfPristine ToggleStatus
status [ViewTreeSub]
a =
      (ToggleStatus
status, [ViewTreeSub]
a)
toggleLayoutNode Ident
_ ToggleStatus
a Tree LayoutView (View Pane)
t =
  (ToggleStatus
a, Tree LayoutView (View Pane)
t)

toggleLayout :: Ident -> ViewTree -> ToggleResult ViewTree
toggleLayout :: Ident
-> Tree LayoutView (View Pane)
-> ToggleResult (Tree LayoutView (View Pane))
toggleLayout Ident
ident =
  (ToggleStatus
 -> Tree LayoutView (View Pane)
 -> ToggleResult (Tree LayoutView (View Pane)))
-> (ToggleStatus, Tree LayoutView (View Pane))
-> ToggleResult (Tree LayoutView (View Pane))
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ToggleStatus
-> Tree LayoutView (View Pane)
-> ToggleResult (Tree LayoutView (View Pane))
forall a. ToggleStatus -> a -> ToggleResult a
checkToggleResult ((ToggleStatus, Tree LayoutView (View Pane))
 -> ToggleResult (Tree LayoutView (View Pane)))
-> (Tree LayoutView (View Pane)
    -> (ToggleStatus, Tree LayoutView (View Pane)))
-> Tree LayoutView (View Pane)
-> ToggleResult (Tree LayoutView (View Pane))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ToggleStatus
 -> Tree LayoutView (View Pane)
 -> (ToggleStatus, Tree LayoutView (View Pane)))
-> (View Pane -> (ToggleStatus, View Pane))
-> Tree LayoutView (View Pane)
-> (ToggleStatus, Tree LayoutView (View Pane))
forall a.
Monoid a =>
(a
 -> Tree LayoutView (View Pane) -> (a, Tree LayoutView (View Pane)))
-> (View Pane -> (a, View Pane))
-> Tree LayoutView (View Pane)
-> (a, Tree LayoutView (View Pane))
depthTraverseTree ((ToggleStatus
 -> Tree LayoutView (View Pane)
 -> (ToggleStatus, Tree LayoutView (View Pane)))
-> (ToggleStatus, Tree LayoutView (View Pane))
-> (ToggleStatus, Tree LayoutView (View Pane))
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ToggleStatus
-> Tree LayoutView (View Pane)
-> (ToggleStatus, Tree LayoutView (View Pane))
openPinnedSubs ((ToggleStatus, Tree LayoutView (View Pane))
 -> (ToggleStatus, Tree LayoutView (View Pane)))
-> (ToggleStatus
    -> Tree LayoutView (View Pane)
    -> (ToggleStatus, Tree LayoutView (View Pane)))
-> ToggleStatus
-> Tree LayoutView (View Pane)
-> (ToggleStatus, Tree LayoutView (View Pane))
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: Ident
-> ToggleStatus
-> Tree LayoutView (View Pane)
-> (ToggleStatus, Tree LayoutView (View Pane))
toggleLayoutNode Ident
ident) (ToggleStatus
Pristine,)

toggleLayoutOpenTraversal' ::
  Traversal' a ViewTree ->
  Ident ->
  a ->
  ToggleResult a
toggleLayoutOpenTraversal' :: forall a.
Traversal' a (Tree LayoutView (View Pane))
-> Ident -> a -> ToggleResult a
toggleLayoutOpenTraversal' Traversal' a (Tree LayoutView (View Pane))
lens =
  LensLike
  (WrappedMonad ToggleResult)
  a
  a
  (Tree LayoutView (View Pane))
  (Tree LayoutView (View Pane))
-> (Tree LayoutView (View Pane)
    -> ToggleResult (Tree LayoutView (View Pane)))
-> a
-> ToggleResult a
forall (m :: * -> *) s t a b.
LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t
mapMOf LensLike
  (WrappedMonad ToggleResult)
  a
  a
  (Tree LayoutView (View Pane))
  (Tree LayoutView (View Pane))
Traversal' a (Tree LayoutView (View Pane))
lens ((Tree LayoutView (View Pane)
  -> ToggleResult (Tree LayoutView (View Pane)))
 -> a -> ToggleResult a)
-> (Ident
    -> Tree LayoutView (View Pane)
    -> ToggleResult (Tree LayoutView (View Pane)))
-> Ident
-> a
-> ToggleResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident
-> Tree LayoutView (View Pane)
-> ToggleResult (Tree LayoutView (View Pane))
toggleLayout