module Chiasma.Ui.ShowTree where

import Chiasma.Data.Ident (identText)
import Chiasma.Ui.Data.View (
  LayoutView,
  Pane (Pane),
  PaneView,
  Tree (Tree),
  TreeSub (TreeLeaf, TreeNode),
  View (View),
  ViewTree,
  )

formatLayout :: LayoutView -> Text
formatLayout :: LayoutView -> Text
formatLayout (View Ident
ident ViewState
_ ViewGeometry
_ Layout
_) = Text
"l: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ident -> Text
identText Ident
ident

formatPane :: PaneView -> Text
formatPane :: PaneView -> Text
formatPane (View Ident
ident ViewState
_ ViewGeometry
_ (Pane Bool
open Bool
_ Maybe Text
_)) =
  Text
"p: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ident -> Text
identText Ident
ident Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
openFrag
  where
    openFrag :: Text
openFrag = Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Bool
open then Text
"open" else Text
"closed"

formatViewTree :: ViewTree -> Tree Text Text
formatViewTree :: ViewTree -> Tree Text Text
formatViewTree = (LayoutView -> Text)
-> (PaneView -> Text) -> ViewTree -> Tree Text Text
forall a b c d. (a -> b) -> (c -> d) -> Tree a c -> Tree b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap LayoutView -> Text
formatLayout PaneView -> Text
formatPane

indent :: [Text] -> [Text]
indent :: [Text] -> [Text]
indent = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text
" " <>)

showTreeSub :: TreeSub Text Text -> [Text]
showTreeSub :: TreeSub Text Text -> [Text]
showTreeSub (TreeNode Tree Text Text
tree) = Tree Text Text -> [Text]
showTree Tree Text Text
tree
showTreeSub (TreeLeaf Text
pane) = [Text
Item [Text]
pane]

showTree :: Tree Text Text -> [Text]
showTree :: Tree Text Text -> [Text]
showTree (Tree Text
l [TreeSub Text Text]
sub) =
  Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
indent ([TreeSub Text Text]
sub [TreeSub Text Text] -> (TreeSub Text Text -> [Text]) -> [Text]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TreeSub Text Text -> [Text]
showTreeSub)

showViewTree :: ViewTree -> [Text]
showViewTree :: ViewTree -> [Text]
showViewTree = Tree Text Text -> [Text]
showTree (Tree Text Text -> [Text])
-> (ViewTree -> Tree Text Text) -> ViewTree -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ViewTree -> Tree Text Text
formatViewTree

printViewTree :: MonadIO m => ViewTree -> m ()
printViewTree :: forall (m :: * -> *). MonadIO m => ViewTree -> m ()
printViewTree =
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (ViewTree -> IO ()) -> ViewTree -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ String -> IO ()
putStrLn ([String] -> IO ()) -> (ViewTree -> [String]) -> ViewTree -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
forall a. ToString a => a -> String
toString ([Text] -> [String])
-> (ViewTree -> [Text]) -> ViewTree -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ViewTree -> [Text]
showViewTree