{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cursor.Brick.Tree where

import Brick.Types
import Brick.Widgets.Core
import Cursor.Tree
import qualified Data.List.NonEmpty as NE

verticalPaddedTreeCursorWidgetM ::
  forall a b n m.
  Monad m =>
  (a -> m (Widget n)) ->
  (b -> m (Widget n)) ->
  Int ->
  TreeCursor a b ->
  m (Widget n)
verticalPaddedTreeCursorWidgetM :: (a -> m (Widget n))
-> (b -> m (Widget n)) -> Int -> TreeCursor a b -> m (Widget n)
verticalPaddedTreeCursorWidgetM a -> m (Widget n)
goA b -> m (Widget n)
goB Int
padding = ([CTree b] -> b -> [CTree b] -> Widget n -> m (Widget n))
-> (a -> CForest b -> m (Widget n))
-> TreeCursor a b
-> m (Widget n)
forall a b n (m :: * -> *).
Monad m =>
([CTree b] -> b -> [CTree b] -> Widget n -> m (Widget n))
-> (a -> CForest b -> m (Widget n))
-> TreeCursor a b
-> m (Widget n)
treeCursorWidgetM [CTree b] -> b -> [CTree b] -> Widget n -> m (Widget n)
wrap a -> CForest b -> m (Widget n)
cur
  where
    goCTree :: CTree b -> m (Widget n)
    goCTree :: CTree b -> m (Widget n)
goCTree (CNode b
b CForest b
cf) = do
      Widget n
top <- b -> m (Widget n)
goB b
b
      Widget n
bot <- CForest b -> m (Widget n)
goCForest CForest b
cf
      Widget n -> m (Widget n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Widget n -> m (Widget n)) -> Widget n -> m (Widget n)
forall a b. (a -> b) -> a -> b
$ Widget n
top Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
padding) Widget n
bot
    goCForest :: CForest b -> m (Widget n)
    goCForest :: CForest b -> m (Widget n)
goCForest = \case
      CForest b
EmptyCForest -> Widget n -> m (Widget n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Widget n
forall n. Widget n
emptyWidget
      ClosedForest NonEmpty (Tree b)
_ -> Widget n -> m (Widget n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Widget n
forall n. Widget n
emptyWidget
      OpenForest NonEmpty (CTree b)
nect -> ([Widget n] -> Widget n) -> m [Widget n] -> m (Widget n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox (m [Widget n] -> m (Widget n)) -> m [Widget n] -> m (Widget n)
forall a b. (a -> b) -> a -> b
$ (CTree b -> m (Widget n)) -> [CTree b] -> m [Widget n]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse CTree b -> m (Widget n)
goCTree ([CTree b] -> m [Widget n]) -> [CTree b] -> m [Widget n]
forall a b. (a -> b) -> a -> b
$ NonEmpty (CTree b) -> [CTree b]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (CTree b)
nect
    wrap :: [CTree b] -> b -> [CTree b] -> Widget n -> m (Widget n)
    wrap :: [CTree b] -> b -> [CTree b] -> Widget n -> m (Widget n)
wrap [CTree b]
lefts b
above [CTree b]
rights Widget n
curW = do
      Widget n
top <- b -> m (Widget n)
goB b
above
      Widget n
bot <-
        [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox
          ([Widget n] -> Widget n) -> m [Widget n] -> m (Widget n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [m (Widget n)] -> m [Widget n]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
            ( [[m (Widget n)]] -> [m (Widget n)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ (CTree b -> m (Widget n)) -> [CTree b] -> [m (Widget n)]
forall a b. (a -> b) -> [a] -> [b]
map CTree b -> m (Widget n)
goCTree [CTree b]
lefts,
                  [Widget n -> m (Widget n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Widget n
curW],
                  (CTree b -> m (Widget n)) -> [CTree b] -> [m (Widget n)]
forall a b. (a -> b) -> [a] -> [b]
map CTree b -> m (Widget n)
goCTree [CTree b]
rights
                ]
            )
      Widget n -> m (Widget n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Widget n -> m (Widget n)) -> Widget n -> m (Widget n)
forall a b. (a -> b) -> a -> b
$ Widget n
top Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
padding) Widget n
bot
    cur :: a -> CForest b -> m (Widget n)
    cur :: a -> CForest b -> m (Widget n)
cur a
a CForest b
cf = do
      Widget n
top <- a -> m (Widget n)
goA a
a
      Widget n
bot <- CForest b -> m (Widget n)
goCForest CForest b
cf
      Widget n -> m (Widget n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Widget n -> m (Widget n)) -> Widget n -> m (Widget n)
forall a b. (a -> b) -> a -> b
$ Widget n
top Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
padding) Widget n
bot

verticalPaddedTreeCursorWidget ::
  forall a b n.
  (a -> Widget n) ->
  (b -> Widget n) ->
  Int ->
  TreeCursor a b ->
  Widget n
verticalPaddedTreeCursorWidget :: (a -> Widget n)
-> (b -> Widget n) -> Int -> TreeCursor a b -> Widget n
verticalPaddedTreeCursorWidget a -> Widget n
goA b -> Widget n
goB Int
padding = ([CTree b] -> b -> [CTree b] -> Widget n -> Widget n)
-> (a -> CForest b -> Widget n) -> TreeCursor a b -> Widget n
forall a b n.
([CTree b] -> b -> [CTree b] -> Widget n -> Widget n)
-> (a -> CForest b -> Widget n) -> TreeCursor a b -> Widget n
treeCursorWidget [CTree b] -> b -> [CTree b] -> Widget n -> Widget n
wrap a -> CForest b -> Widget n
cur
  where
    goCTree :: CTree b -> Widget n
    goCTree :: CTree b -> Widget n
goCTree (CNode b
b CForest b
cf) = b -> Widget n
goB b
b Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
padding) (CForest b -> Widget n
goCForest CForest b
cf)
    goCForest :: CForest b -> Widget n
    goCForest :: CForest b -> Widget n
goCForest = \case
      CForest b
EmptyCForest -> Widget n
forall n. Widget n
emptyWidget
      ClosedForest NonEmpty (Tree b)
_ -> Widget n
forall n. Widget n
emptyWidget
      OpenForest NonEmpty (CTree b)
nect -> [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ (CTree b -> Widget n) -> [CTree b] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map CTree b -> Widget n
goCTree ([CTree b] -> [Widget n]) -> [CTree b] -> [Widget n]
forall a b. (a -> b) -> a -> b
$ NonEmpty (CTree b) -> [CTree b]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (CTree b)
nect
    wrap :: [CTree b] -> b -> [CTree b] -> Widget n -> Widget n
    wrap :: [CTree b] -> b -> [CTree b] -> Widget n -> Widget n
wrap [CTree b]
lefts b
above [CTree b]
rights Widget n
curW =
      b -> Widget n
goB b
above
        Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft
          (Int -> Padding
Pad Int
2)
          ( [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$
              [[Widget n]] -> [Widget n]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ (CTree b -> Widget n) -> [CTree b] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map CTree b -> Widget n
goCTree [CTree b]
lefts,
                  [Widget n
curW],
                  (CTree b -> Widget n) -> [CTree b] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map CTree b -> Widget n
goCTree [CTree b]
rights
                ]
          )
    cur :: a -> CForest b -> Widget n
    cur :: a -> CForest b -> Widget n
cur a
a CForest b
cf = a -> Widget n
goA a
a Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
padding) (CForest b -> Widget n
goCForest CForest b
cf)

treeCursorWidgetM ::
  forall a b n m.
  Monad m =>
  ([CTree b] -> b -> [CTree b] -> Widget n -> m (Widget n)) ->
  (a -> CForest b -> m (Widget n)) ->
  TreeCursor a b ->
  m (Widget n)
treeCursorWidgetM :: ([CTree b] -> b -> [CTree b] -> Widget n -> m (Widget n))
-> (a -> CForest b -> m (Widget n))
-> TreeCursor a b
-> m (Widget n)
treeCursorWidgetM = ([CTree b] -> b -> [CTree b] -> Widget n -> m (Widget n))
-> (a -> CForest b -> m (Widget n))
-> TreeCursor a b
-> m (Widget n)
forall a b (m :: * -> *) c.
Monad m =>
([CTree b] -> b -> [CTree b] -> c -> m c)
-> (a -> CForest b -> m c) -> TreeCursor a b -> m c
traverseTreeCursor

treeCursorWidget ::
  forall a b n.
  ([CTree b] -> b -> [CTree b] -> Widget n -> Widget n) ->
  (a -> CForest b -> Widget n) ->
  TreeCursor a b ->
  Widget n
treeCursorWidget :: ([CTree b] -> b -> [CTree b] -> Widget n -> Widget n)
-> (a -> CForest b -> Widget n) -> TreeCursor a b -> Widget n
treeCursorWidget = ([CTree b] -> b -> [CTree b] -> Widget n -> Widget n)
-> (a -> CForest b -> Widget n) -> TreeCursor a b -> Widget n
forall a b c.
([CTree b] -> b -> [CTree b] -> c -> c)
-> (a -> CForest b -> c) -> TreeCursor a b -> c
foldTreeCursor