module Chiasma.Ui.ViewTree where

import Chiasma.Data.Ident (Ident)
import Chiasma.Lens.Tree (
  LeafIndexTree(..),
  _litTree,
  leafDataTraversal,
  )
import Control.Lens (
  Traversal,
  Traversal',
  anyOf,
  cosmos,
  filtered,
  has,
  ix,
  mapMOf,
  over,
  transformM,
  )
import Control.Monad.Error.Class (throwError)
import Control.Monad.Trans.Writer (WriterT, runWriterT, tell)
import Data.Composition ((.:))

import Chiasma.Ui.Data.TreeModError (TreeModError(PaneMissing, AmbiguousPane, LayoutMissing, AmbiguousLayout))
import Chiasma.Ui.Data.View (
  Pane(Pane),
  PaneView,
  Tree(Tree),
  TreeSub(TreeNode, TreeLeaf),
  View(View),
  ViewTree,
  ViewTreeSub,
  )
import qualified Chiasma.Ui.Data.View as Pane (open)
import qualified Chiasma.Ui.Data.View as TreeSub (leafData)
import qualified Chiasma.Ui.Data.View as View (extra)
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 :: (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 (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 :: ViewTree -> ViewTree
treeToggleOpen (Tree LayoutView
l [TreeSub LayoutView PaneView]
sub) =
  LayoutView -> [TreeSub LayoutView PaneView] -> ViewTree
forall l p. l -> [TreeSub l p] -> Tree l p
Tree LayoutView
l ((Bool, [TreeSub LayoutView PaneView])
-> [TreeSub LayoutView PaneView]
forall a b. (a, b) -> b
snd ((Bool, [TreeSub LayoutView PaneView])
 -> [TreeSub LayoutView PaneView])
-> (Bool, [TreeSub LayoutView PaneView])
-> [TreeSub LayoutView PaneView]
forall a b. (a -> b) -> a -> b
$ (Bool
 -> TreeSub LayoutView PaneView
 -> (Bool, TreeSub LayoutView PaneView))
-> Bool
-> [TreeSub LayoutView PaneView]
-> (Bool, [TreeSub LayoutView PaneView])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL Bool
-> TreeSub LayoutView PaneView
-> (Bool, TreeSub LayoutView PaneView)
forall l. Bool -> TreeSub l PaneView -> (Bool, TreeSub l PaneView)
toggle Bool
False [TreeSub LayoutView PaneView]
sub)
  where
    toggle :: Bool -> TreeSub l PaneView -> (Bool, TreeSub l PaneView)
toggle Bool
False (TreeLeaf PaneView
p) = (Bool
True, PaneView -> TreeSub l PaneView
forall l p. p -> TreeSub l p
TreeLeaf (PaneView -> PaneView
paneToggleOpen PaneView
p))
    toggle Bool
a TreeSub l PaneView
b = (Bool
a, TreeSub l PaneView
b)

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

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

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

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

openPane :: Ident -> ViewTree -> Either TreeModError ViewTree
openPane :: Ident -> ViewTree -> Either TreeModError ViewTree
openPane =
  (PaneView -> PaneView)
-> Ident -> ViewTree -> Either TreeModError ViewTree
modifyPane PaneView -> PaneView
paneSetOpen

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

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

data ToggleStatus =
  Minimized
  |
  Opened
  |
  Pristine
  |
  Multiple Int
  |
  Consistent
  deriving (ToggleStatus -> ToggleStatus -> Bool
(ToggleStatus -> ToggleStatus -> Bool)
-> (ToggleStatus -> ToggleStatus -> Bool) -> Eq ToggleStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ToggleStatus -> ToggleStatus -> Bool
$c/= :: ToggleStatus -> ToggleStatus -> Bool
== :: ToggleStatus -> ToggleStatus -> Bool
$c== :: ToggleStatus -> ToggleStatus -> Bool
Eq, Int -> ToggleStatus -> ShowS
[ToggleStatus] -> ShowS
ToggleStatus -> FilePath
(Int -> ToggleStatus -> ShowS)
-> (ToggleStatus -> FilePath)
-> ([ToggleStatus] -> ShowS)
-> Show ToggleStatus
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ToggleStatus] -> ShowS
$cshowList :: [ToggleStatus] -> ShowS
show :: ToggleStatus -> FilePath
$cshow :: ToggleStatus -> FilePath
showsPrec :: Int -> ToggleStatus -> ShowS
$cshowsPrec :: Int -> 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 (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
/= :: ToggleResult a -> ToggleResult a -> Bool
$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
Eq, Int -> ToggleResult a -> ShowS
[ToggleResult a] -> ShowS
ToggleResult a -> FilePath
(Int -> ToggleResult a -> ShowS)
-> (ToggleResult a -> FilePath)
-> ([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 -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ToggleResult a] -> ShowS
$cshowList :: forall a. Show a => [ToggleResult a] -> ShowS
show :: ToggleResult a -> FilePath
$cshow :: forall a. Show a => ToggleResult a -> FilePath
showsPrec :: Int -> ToggleResult a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ToggleResult a -> ShowS
Show, a -> ToggleResult b -> ToggleResult a
(a -> b) -> ToggleResult a -> ToggleResult b
(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
<$ :: a -> ToggleResult b -> ToggleResult a
$c<$ :: forall a b. a -> ToggleResult b -> ToggleResult a
fmap :: (a -> b) -> ToggleResult a -> ToggleResult b
$cfmap :: forall a b. (a -> b) -> ToggleResult a -> ToggleResult b
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 :: a -> ToggleResult a
pure = a -> ToggleResult a
forall a. a -> ToggleResult a
Success
  (Success a -> b
f) <*> :: ToggleResult (a -> b) -> ToggleResult a -> ToggleResult b
<*> ToggleResult a
fa = (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 >>= :: 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

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

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

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

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

togglePaneOpenTraversal' ::
  Traversal' a ViewTree ->
  Ident ->
  a ->
  ToggleResult a
togglePaneOpenTraversal' :: Traversal' a ViewTree -> Ident -> a -> ToggleResult a
togglePaneOpenTraversal' Traversal' a ViewTree
lens =
  LensLike (WrappedMonad ToggleResult) a a ViewTree ViewTree
-> (ViewTree -> ToggleResult ViewTree) -> 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 ViewTree ViewTree
Traversal' a ViewTree
lens ((ViewTree -> ToggleResult ViewTree) -> a -> ToggleResult a)
-> (Ident -> ViewTree -> ToggleResult ViewTree)
-> Ident
-> a
-> ToggleResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> ViewTree -> ToggleResult ViewTree
togglePane

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

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

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

ensurePaneOpenTraversal' ::
  Traversal' a ViewTree ->
  Ident ->
  a ->
  ToggleResult a
ensurePaneOpenTraversal' :: Traversal' a ViewTree -> Ident -> a -> ToggleResult a
ensurePaneOpenTraversal' Traversal' a ViewTree
lens =
  LensLike (WrappedMonad ToggleResult) a a ViewTree ViewTree
-> (ViewTree -> ToggleResult ViewTree) -> 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 ViewTree ViewTree
Traversal' a ViewTree
lens ((ViewTree -> ToggleResult ViewTree) -> a -> ToggleResult a)
-> (Ident -> ViewTree -> ToggleResult ViewTree)
-> Ident
-> a
-> ToggleResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> ViewTree -> ToggleResult ViewTree
ensurePaneOpen

skipFold ::
  Traversable t =>
  (a -> (ToggleStatus, a)) ->
  ToggleStatus ->
  t a ->
  (ToggleStatus, t a)
skipFold :: (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 :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
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 :: TreeSub LayoutView PaneView -> Bool
isOpenPaneNode =
  Getting Any (TreeSub LayoutView PaneView) Bool
-> (Bool -> Bool) -> TreeSub LayoutView PaneView -> Bool
forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf ((PaneView -> Const Any PaneView)
-> TreeSub LayoutView PaneView
-> Const Any (TreeSub LayoutView PaneView)
forall c l p. HasTreeSub c l p => Traversal' c p
TreeSub.leafData ((PaneView -> Const Any PaneView)
 -> TreeSub LayoutView PaneView
 -> Const Any (TreeSub LayoutView PaneView))
-> ((Bool -> Const Any Bool) -> PaneView -> Const Any PaneView)
-> Getting Any (TreeSub LayoutView PaneView) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pane -> Const Any Pane) -> PaneView -> Const Any PaneView
forall c a. HasView c a => Lens' c a
View.extra ((Pane -> Const Any Pane) -> PaneView -> Const Any PaneView)
-> ((Bool -> Const Any Bool) -> Pane -> Const Any Pane)
-> (Bool -> Const Any Bool)
-> PaneView
-> Const Any PaneView
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Any Bool) -> Pane -> Const Any Pane
forall c. HasPane c => Lens' c Bool
Pane.open) Bool -> Bool
forall a. a -> a
id

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

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

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

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

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

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

toggleLayoutOpenTraversal' ::
  Traversal' a ViewTree ->
  Ident ->
  a ->
  ToggleResult a
toggleLayoutOpenTraversal' :: Traversal' a ViewTree -> Ident -> a -> ToggleResult a
toggleLayoutOpenTraversal' Traversal' a ViewTree
lens =
  LensLike (WrappedMonad ToggleResult) a a ViewTree ViewTree
-> (ViewTree -> ToggleResult ViewTree) -> 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 ViewTree ViewTree
Traversal' a ViewTree
lens ((ViewTree -> ToggleResult ViewTree) -> a -> ToggleResult a)
-> (Ident -> ViewTree -> ToggleResult ViewTree)
-> Ident
-> a
-> ToggleResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> ViewTree -> ToggleResult ViewTree
toggleLayout