{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo     #-}

module Potato.Flow.Vty.Layer (
  LayerWidgetConfig(..)
  , LayerWidget(..)
  , holdLayerWidget
) where

import           Relude

import           Potato.Flow
import           Potato.Flow.Controller
import           Potato.Flow.Vty.Attrs
import           Potato.Flow.Vty.Input
import           Potato.Reflex.Vty.Helpers
import           Potato.Reflex.Vty.Widget
import Potato.Flow.Vty.PotatoReader
import Potato.Flow.Vty.Common
import Potato.Reflex.Vty.Widget.ScrollBar


import qualified Potato.Data.Text.Zipper
import           Control.Monad.Fix
import           Data.Align
import           Data.Dependent.Sum          (DSum ((:=>)))
import qualified Data.IntMap.Strict          as IM
import qualified Data.List                   as L
import qualified Data.Sequence               as Seq
import qualified Data.Text                   as T
import           Data.Text.Zipper
import qualified Data.Text.Zipper            as TZ
import           Data.These

import qualified Graphics.Vty                as V
import           Reflex
import           Reflex.Network
import           Reflex.Potato.Helpers
import           Reflex.Vty



-- | simple conversion function
-- potato-flow does not want to depend on reflex an has a coppy of TextZipper library but they are pretty much the same
coerceZipper :: Potato.Data.Text.Zipper.TextZipper -> TZ.TextZipper
coerceZipper :: TextZipper -> TextZipper
coerceZipper (Potato.Data.Text.Zipper.TextZipper [Text]
a Text
b Text
c [Text]
d) = [Text] -> Text -> Text -> [Text] -> TextZipper
TZ.TextZipper [Text]
a Text
b Text
c [Text]
d

--moveChar :: Char
--moveChar = '≡'
hiddenChar :: Char
hiddenChar :: Char
hiddenChar = Char
'-'
visibleChar :: Char
visibleChar :: Char
visibleChar = Char
'e'
lockedChar :: Char
lockedChar :: Char
lockedChar = Char
'@'
unlockedChar :: Char
unlockedChar :: Char
unlockedChar = Char
'a'
expandChar :: Char
expandChar :: Char
expandChar = Char
'»'
closeChar :: Char
closeChar :: Char
closeChar = Char
'⇊'

{-# INLINE if' #-}
if' :: Bool -> a -> a -> a
if' :: forall a. Bool -> a -> a -> a
if' Bool
True  a
x a
_ = a
x
if' Bool
False a
_ a
y = a
y


data LayerWidgetConfig t = LayerWidgetConfig {
  forall t. LayerWidgetConfig t -> Dynamic t LayersState
_layerWidgetConfig_layers    :: Dynamic t LayersState
  , forall t.
LayerWidgetConfig t -> Dynamic t LayersViewHandlerRenderOutput
_layerWidgetConfig_layersView    :: Dynamic t LayersViewHandlerRenderOutput
  , forall t. LayerWidgetConfig t -> Dynamic t Selection
_layerWidgetConfig_selection :: Dynamic t Selection
}

data LayerWidget t = LayerWidget {
  forall t. LayerWidget t -> Event t LMouseData
_layerWidget_mouse :: Event t LMouseData
  , forall t. LayerWidget t -> Event t ()
_layerWidget_newFolderEv :: Event t ()
}

layerContents :: forall t m. (MonadWidget t m, HasPotato t m)
  => LayerWidgetConfig t
  -> Dynamic t (Int, Int)
  -> m (Event t LMouseData)
layerContents :: forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
LayerWidgetConfig t
-> Dynamic t (Int, Int) -> m (Event t LMouseData)
layerContents LayerWidgetConfig {Dynamic t LayersViewHandlerRenderOutput
Dynamic t LayersState
Dynamic t Selection
_layerWidgetConfig_selection :: Dynamic t Selection
_layerWidgetConfig_layersView :: Dynamic t LayersViewHandlerRenderOutput
_layerWidgetConfig_layers :: Dynamic t LayersState
_layerWidgetConfig_selection :: forall t. LayerWidgetConfig t -> Dynamic t Selection
_layerWidgetConfig_layersView :: forall t.
LayerWidgetConfig t -> Dynamic t LayersViewHandlerRenderOutput
_layerWidgetConfig_layers :: forall t. LayerWidgetConfig t -> Dynamic t LayersState
..} Dynamic t (Int, Int)
scrollDyn = do


  Behavior t PotatoStyle
potatostylebeh <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall t. PotatoConfig t -> Behavior t PotatoStyle
_potatoConfig_style forall t (m :: * -> *). HasPotato t m => m (PotatoConfig t)
askPotato
  PotatoStyle {Attr
RenderHandleColor -> Attr
_potatoStyle_textfield_cursor :: PotatoStyle -> Attr
_potatoStyle_textfield_modifying :: PotatoStyle -> Attr
_potatoStyle_textfield_normal :: PotatoStyle -> Attr
_potatoStyle_canvas_oob :: PotatoStyle -> Attr
_potatoStyle_layers_softSelected :: PotatoStyle -> Attr
_potatoStyle_selected :: PotatoStyle -> Attr
_potatoStyle_normal :: PotatoStyle -> Attr
_potatoStyle_makeCanvasManipulator :: PotatoStyle -> RenderHandleColor -> Attr
_potatoStyle_canvasCursor :: PotatoStyle -> Attr
_potatoStyle_textfield_cursor :: Attr
_potatoStyle_textfield_modifying :: Attr
_potatoStyle_textfield_normal :: Attr
_potatoStyle_canvas_oob :: Attr
_potatoStyle_layers_softSelected :: Attr
_potatoStyle_selected :: Attr
_potatoStyle_normal :: Attr
_potatoStyle_makeCanvasManipulator :: RenderHandleColor -> Attr
_potatoStyle_canvasCursor :: Attr
..} <- forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t PotatoStyle
potatostylebeh

  Dynamic t Int
regionWidthDyn <- forall {k} (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Int)
displayWidth
  Dynamic t Int
regionHeightDyn <- forall {k} (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Int)
displayHeight


  let
    padBottom :: Int
padBottom = Int
0
    listRegionDyn :: Dynamic t (Int, Int)
listRegionDyn = forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> (a -> b -> c) -> f c
ffor2 Dynamic t Int
regionWidthDyn Dynamic t Int
regionHeightDyn (,)


    makeLayerImage :: Int -> LayersHandlerRenderEntry -> V.Image
    makeLayerImage :: Int -> LayersHandlerRenderEntry -> Image
makeLayerImage Int
width LayersHandlerRenderEntry
lhrentry = case LayersHandlerRenderEntry
lhrentry of
      LayersHandlerRenderEntryDummy Int
ident -> Image
r where
        r :: Image
r = Attr -> Text -> Image
V.text' Attr
lg_layer_selected forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
L.take Int
width
          forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
ident Char
' '
          forall a. Semigroup a => a -> a -> a
<> forall a. Int -> a -> [a]
replicate Int
10 Char
'*'
      LayersHandlerRenderEntryNormal LayersHandlerRenderEntrySelectedState
selected LayersHandlerRenderEntryDots
mdots LayersHandlerRenderEntryRenaming
mrenaming lentry :: LayerEntry
lentry@LayerEntry{Bool
LockHiddenState
SuperOwl
_layerEntry_lockState :: LayerEntry -> LockHiddenState
_layerEntry_hideState :: LayerEntry -> LockHiddenState
_layerEntry_isCollapsed :: LayerEntry -> Bool
_layerEntry_superOwl :: LayerEntry -> SuperOwl
_layerEntry_superOwl :: SuperOwl
_layerEntry_isCollapsed :: Bool
_layerEntry_hideState :: LockHiddenState
_layerEntry_lockState :: LockHiddenState
..} -> Image
r where
        ident :: Int
ident = LayerEntry -> Int
layerEntry_depth LayerEntry
lentry
        sowl :: SuperOwl
sowl = SuperOwl
_layerEntry_superOwl
        rid :: Int
rid = SuperOwl -> Int
_superOwl_id SuperOwl
sowl
        label :: Text
label = forall o. HasOwlItem o => o -> Text
hasOwlItem_name SuperOwl
sowl

        attr :: Attr
attr = case LayersHandlerRenderEntrySelectedState
selected of
          LayersHandlerRenderEntrySelectedState
LHRESS_Selected -> Attr
_potatoStyle_selected
          LayersHandlerRenderEntrySelectedState
LHRESS_InheritSelected -> Attr
_potatoStyle_selected
          LayersHandlerRenderEntrySelectedState
LHRESS_ChildSelected -> Attr
_potatoStyle_layers_softSelected
          LayersHandlerRenderEntrySelectedState
_ -> Attr
_potatoStyle_normal

        -- TODO correct styles so they aren't confused with selected styles (you should add colors)
        attrrenamingbg :: Attr
attrrenamingbg = Attr
_potatoStyle_layers_softSelected
        attrrenamingcur :: Attr
attrrenamingcur = Attr
_potatoStyle_selected

        identn :: Int
identn = case LayersHandlerRenderEntryDots
mdots of
          LayersHandlerRenderEntryDots
Nothing -> Int
ident
          Just Int
x -> Int
x forall a. Num a => a -> a -> a
- Int
1

        icon :: [Char]
icon = case OwlItem -> OwlSubItem
_owlItem_subItem (SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl) of 
          OwlSubItemFolder Seq Int
_ -> [Char]
"𐃛"
          OwlSubItemBox SBox
_ -> [Char]
"⧈"
          OwlSubItemLine SAutoLine
_ -> [Char]
"⤡"
          OwlSubItemTextArea STextArea
_ -> [Char]
"𐂂"

        t1 :: Image
t1 = Attr -> Text -> Image
V.text' Attr
attr forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$

          -- render identation and possible drop depth
          forall a. Int -> a -> [a]
replicate Int
identn Char
' '
          forall a. Semigroup a => a -> a -> a
<> forall a. Int -> a -> [a]
replicate (forall a. Ord a => a -> a -> a
min Int
1 (Int
ident forall a. Num a => a -> a -> a
- Int
identn)) Char
'|'
          forall a. Semigroup a => a -> a -> a
<> forall a. Int -> a -> [a]
replicate (forall a. Ord a => a -> a -> a
max Int
0 (Int
ident forall a. Num a => a -> a -> a
- Int
identn forall a. Num a => a -> a -> a
- Int
1)) Char
' '

          -- render folder hide lock icons
          -- <> [moveChar]
          forall a. Semigroup a => a -> a -> a
<> forall a. Bool -> a -> a -> a
if' (LayerEntry -> Bool
layerEntry_isFolder LayerEntry
lentry) (forall a. Bool -> a -> a -> a
if' Bool
_layerEntry_isCollapsed [Char
expandChar] [Char
closeChar]) [Char
' ']
          forall a. Semigroup a => a -> a -> a
<> forall a. Bool -> a -> a -> a
if' (LockHiddenState -> Bool
lockHiddenStateToBool LockHiddenState
_layerEntry_hideState) [Char
hiddenChar] [Char
visibleChar]
          forall a. Semigroup a => a -> a -> a
<> forall a. Bool -> a -> a -> a
if' (LockHiddenState -> Bool
lockHiddenStateToBool LockHiddenState
_layerEntry_lockState) [Char
lockedChar] [Char
unlockedChar]
          forall a. Semigroup a => a -> a -> a
<> [Char]
" " 
          forall a. Semigroup a => a -> a -> a
<> [Char]
icon
          forall a. Semigroup a => a -> a -> a
<> [Char]
" "

        t2 :: Image
t2 = case LayersHandlerRenderEntryRenaming
mrenaming of
          LayersHandlerRenderEntryRenaming
Nothing -> Attr -> Text -> Image
V.text' Attr
attr Text
label
          Just TextZipper
renaming -> Image
img where
            dls :: DisplayLines Attr
dls = forall tag. Int -> tag -> tag -> TextZipper -> DisplayLines tag
TZ.displayLines Int
999999 Attr
attrrenamingbg Attr
attrrenamingcur (TextZipper -> TextZipper
coerceZipper TextZipper
renaming)
            img :: Image
img = [Image] -> Image
V.vertCat forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Span Attr]] -> [Image]
images forall a b. (a -> b) -> a -> b
$ forall tag. DisplayLines tag -> [[Span tag]]
TZ._displayLines_spans DisplayLines Attr
dls

        r :: Image
r = Image
t1 Image -> Image -> Image
V.<|> Image
t2

    layerImages :: Behavior t [V.Image]
    layerImages :: Behavior t [Image]
layerImages = forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Image] -> Image
V.vertCat)
      forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c d.
Applicative f =>
f a -> f b -> f c -> (a -> b -> c -> d) -> f d
ffor3 Dynamic t (Int, Int)
listRegionDyn (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LayersViewHandlerRenderOutput -> Seq LayersHandlerRenderEntry
_layersViewHandlerRenderOutput_entries Dynamic t LayersViewHandlerRenderOutput
_layerWidgetConfig_layersView) Dynamic t (Int, Int)
scrollDyn forall a b. (a -> b) -> a -> b
$ \(Int
w,Int
h) Seq LayersHandlerRenderEntry
lhrentries (Int, Int)
scroll ->
        forall a b. (a -> b) -> [a] -> [b]
map (Int -> LayersHandlerRenderEntry -> Image
makeLayerImage Int
w) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
L.take (forall a. Ord a => a -> a -> a
max Int
0 (Int
h forall a. Num a => a -> a -> a
- Int
padBottom)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
L.drop (forall a b. (a, b) -> b
snd (Int, Int)
scroll) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq LayersHandlerRenderEntry
lhrentries
  forall {k} (t :: k) (m :: * -> *).
HasImageWriter t m =>
Behavior t [Image] -> m ()
tellImages Behavior t [Image]
layerImages

  Event t LMouseData
layerInpEv_d3 <- forall t (m :: * -> *).
(Reflex t, MonadFix m, MonadHold t m, HasInput t m) =>
Dynamic t (Int, Int) -> Bool -> m (Event t LMouseData)
makeLMouseDataInputEv Dynamic t (Int, Int)
scrollDyn Bool
True
  return Event t LMouseData
layerInpEv_d3

holdLayerWidget :: forall t m. (MonadWidget t m, HasPotato t m)
  => LayerWidgetConfig t
  -> m (LayerWidget t)
holdLayerWidget :: forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
LayerWidgetConfig t -> m (LayerWidget t)
holdLayerWidget lwc :: LayerWidgetConfig t
lwc@LayerWidgetConfig {Dynamic t LayersViewHandlerRenderOutput
Dynamic t LayersState
Dynamic t Selection
_layerWidgetConfig_selection :: Dynamic t Selection
_layerWidgetConfig_layersView :: Dynamic t LayersViewHandlerRenderOutput
_layerWidgetConfig_layers :: Dynamic t LayersState
_layerWidgetConfig_selection :: forall t. LayerWidgetConfig t -> Dynamic t Selection
_layerWidgetConfig_layersView :: forall t.
LayerWidgetConfig t -> Dynamic t LayersViewHandlerRenderOutput
_layerWidgetConfig_layers :: forall t. LayerWidgetConfig t -> Dynamic t LayersState
..} = do




  Behavior t PotatoStyle
potatostylebeh <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall t. PotatoConfig t -> Behavior t PotatoStyle
_potatoConfig_style forall t (m :: * -> *). HasPotato t m => m (PotatoConfig t)
askPotato
  PotatoStyle {Attr
RenderHandleColor -> Attr
_potatoStyle_textfield_cursor :: Attr
_potatoStyle_textfield_modifying :: Attr
_potatoStyle_textfield_normal :: Attr
_potatoStyle_canvas_oob :: Attr
_potatoStyle_layers_softSelected :: Attr
_potatoStyle_selected :: Attr
_potatoStyle_normal :: Attr
_potatoStyle_makeCanvasManipulator :: RenderHandleColor -> Attr
_potatoStyle_canvasCursor :: Attr
_potatoStyle_textfield_cursor :: PotatoStyle -> Attr
_potatoStyle_textfield_modifying :: PotatoStyle -> Attr
_potatoStyle_textfield_normal :: PotatoStyle -> Attr
_potatoStyle_canvas_oob :: PotatoStyle -> Attr
_potatoStyle_layers_softSelected :: PotatoStyle -> Attr
_potatoStyle_selected :: PotatoStyle -> Attr
_potatoStyle_normal :: PotatoStyle -> Attr
_potatoStyle_makeCanvasManipulator :: PotatoStyle -> RenderHandleColor -> Attr
_potatoStyle_canvasCursor :: PotatoStyle -> Attr
..} <- forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t PotatoStyle
potatostylebeh

  Dynamic t Int
regionWidthDyn <- forall {k} (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Int)
displayWidth
  --regionHeightDyn <- displayHeight

  (Event t LMouseData
layerInpEv, Event t ()
newFolderEv) <- forall t (m :: * -> *) a.
(HasDisplayRegion t m, MonadFix m) =>
Layout t m a -> m a
initLayout forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
col forall a b. (a -> b) -> a -> b
$ mdo
    -- layer contents and scroll bar
    Event t LMouseData
layerInpEv_d1 <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
 HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
row forall a b. (a -> b) -> a -> b
$ mdo

      -- the layer list itself
      (Event t LMouseData
layerInpEv_d2, Dynamic t Int
listRegionHeightDyn) <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
 HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
0 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
col forall a b. (a -> b) -> a -> b
$ do
        Dynamic t Int
listRegionHeightDyn_d1 <- forall {k} (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Int)
displayHeight
        Event t LMouseData
layerInpEv_d3 <- forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
LayerWidgetConfig t
-> Dynamic t (Int, Int) -> m (Event t LMouseData)
layerContents LayerWidgetConfig t
lwc (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
y -> (Int
0,Int
y)) Dynamic t Int
vScrollDyn)
        return (Event t LMouseData
layerInpEv_d3, Dynamic t Int
listRegionHeightDyn_d1)

      -- the vertical scroll bar
      Dynamic t Int
vScrollDyn <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
 HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
1 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
col forall a b. (a -> b) -> a -> b
$ do
        let
          contentSizeDyn :: Dynamic t Int
contentSizeDyn = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. Num a => a -> a -> a
+Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Seq a -> Int
Seq.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayersViewHandlerRenderOutput -> Seq LayersHandlerRenderEntry
_layersViewHandlerRenderOutput_entries) Dynamic t LayersViewHandlerRenderOutput
_layerWidgetConfig_layersView
        forall t (m :: * -> *) a.
MonadWidget t m =>
Int -> Dynamic t Int -> m (Dynamic t Int)
vScrollBar Int
1 Dynamic t Int
contentSizeDyn

      forall (m :: * -> *) a. Monad m => a -> m a
return Event t LMouseData
layerInpEv_d2

    -- TODO horizontal scroll bar somedays

    -- buttons at the bottom
    (Event t ()
newFolderEv_d1, Dynamic t Int
heightDyn) <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
 HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
heightDyn forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
row forall a b. (a -> b) -> a -> b
$ do
      (Event t Int
buttonsEv, Dynamic t Int
heightDyn_d1) <- forall t (m :: * -> *).
(MonadFix m, MonadHold t m, HasDisplayRegion t m,
 HasImageWriter t m, HasInput t m, HasTheme t m) =>
Dynamic t [Text]
-> Maybe (Dynamic t Int) -> m (Event t Int, Dynamic t Int)
buttonList (forall {k} (t :: k) a. Reflex t => a -> Dynamic t a
constDyn [Text
"new folder"]) (forall a. a -> Maybe a
Just Dynamic t Int
regionWidthDyn)
      -- TODO new layer/delete buttons how here
      -- TODO other folder options too maybe?
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall t. Reflex t => Int -> Event t Int -> Event t ()
ffilterButtonIndex Int
0 Event t Int
buttonsEv, Dynamic t Int
heightDyn_d1)

    forall (m :: * -> *) a. Monad m => a -> m a
return (Event t LMouseData
layerInpEv_d1, Event t ()
newFolderEv_d1)


  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ LayerWidget {
      _layerWidget_mouse :: Event t LMouseData
_layerWidget_mouse = Event t LMouseData
layerInpEv
      , _layerWidget_newFolderEv :: Event t ()
_layerWidget_newFolderEv = Event t ()
newFolderEv
    }