-- TODO someday we will do dockable widget manager, but this is what yo uget for now

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

module Potato.Flow.Vty.Left (
  LeftWidgetConfig(..)
  , holdLeftWidget
  , LeftWidget(..)
  , MenuButtonsWidget(..)
) where
import           Relude


import           Potato.Flow
import           Potato.Flow.Vty.Info
import           Potato.Flow.Vty.Layer
import           Potato.Flow.Vty.Params
import           Potato.Flow.Vty.PotatoReader
import           Potato.Flow.Vty.Tools
import           Potato.Flow.Vty.ToolOptions
import Potato.Flow.Vty.Common
import           Potato.Reflex.Vty.Helpers
import qualified Data.Text.IO as T

import           Reflex
import           Reflex.Vty
import qualified Graphics.Vty as V


-- could put into a different file but whatever
data MenuButtonsWidget t = MenuButtonsWidget {
  forall t. MenuButtonsWidget t -> Event t ()
_menuButtonsWidget_newEv :: Event t ()
  , forall t. MenuButtonsWidget t -> Event t ()
_menuButtonsWidget_openEv :: Event t ()
  , forall t. MenuButtonsWidget t -> Event t ()
_menuButtonsWidget_saveEv :: Event t ()
  , forall t. MenuButtonsWidget t -> Event t ()
_menuButtonsWidget_saveAsEv :: Event t ()
  , forall t. MenuButtonsWidget t -> Event t ()
_menuButtonsWidget_exportEv :: Event t ()
  , forall t. MenuButtonsWidget t -> Event t ()
_menuButtonsWidget_quitEv :: Event t ()
}

data LeftWidgetConfig t = LeftWidgetConfig {
  -- TODO rename to _leftWidgetConfig_goatW
  forall t. LeftWidgetConfig t -> GoatWidget t
_layersWidgetConfig_goatW :: GoatWidget t
  -- TODO other stuff
}

data LeftWidget t = LeftWidget {
  forall t. LeftWidget t -> LayerWidget t
_leftWidget_layersW :: LayerWidget t
  , forall t. LeftWidget t -> ToolWidget t
_leftWidget_toolsW :: ToolWidget t
  , forall t. LeftWidget t -> ParamsWidget t
_leftWidget_paramsW :: ParamsWidget t
  , forall t. LeftWidget t -> MenuButtonsWidget t
_leftWidget_menuButtonsW :: MenuButtonsWidget t
  , forall t. LeftWidget t -> Event t GoatFocusedArea
_leftWidget_setFocusEvent :: Event t GoatFocusedArea
  -- TODO other stuff
}


hdivider :: forall t m. (MonadWidget t m, HasLayout t m) => m ()
hdivider :: forall t (m :: * -> *). (MonadWidget t m, HasLayout t m) => m ()
hdivider = (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
groutforall 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 :: * -> *).
(HasDisplayRegion t m, HasImageWriter t m, HasTheme t m) =>
Behavior t Char -> m ()
fill (forall {k} (t :: k) a. Reflex t => a -> Behavior t a
constant Char
'-')

-- | Mouse down events for a particular mouse button
mouseFocus
  :: (Reflex t, Monad m, HasInput t m)
  => m (Event t Bool)
mouseFocus :: forall t (m :: * -> *).
(Reflex t, Monad m, HasInput t m) =>
m (Event t Bool)
mouseFocus = do
  Event t VtyEvent
i <- forall {k} (t :: k) (m :: * -> *).
HasInput t m =>
m (Event t VtyEvent)
input
  return $ forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe Event t VtyEvent
i forall a b. (a -> b) -> a -> b
$ \case
    V.EvMouseDown Int
_ Int
_ Button
_ [Modifier]
_ -> forall a. a -> Maybe a
Just Bool
True
    VtyEvent
_ -> forall a. Maybe a
Nothing


holdLeftWidget :: forall t m. (MonadWidget t m, HasPotato t m)
  => LeftWidgetConfig t
  -> m (LeftWidget t)
holdLeftWidget :: forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
LeftWidgetConfig t -> m (LeftWidget t)
holdLeftWidget LeftWidgetConfig {GoatWidget t
_layersWidgetConfig_goatW :: GoatWidget t
_layersWidgetConfig_goatW :: forall t. LeftWidgetConfig t -> GoatWidget t
..} = do

  Dynamic t Int
widthDyn <- forall {k} (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Int)
displayWidth
  -- this will toggle true/fales as you click between left/canvas panels
  -- this only works because you use splitHDrag to split the Left/Canvas panels (it toggles the focus)
  Dynamic t Bool
focusDyn <- forall {k} (t :: k) (m :: * -> *).
HasFocusReader t m =>
m (Dynamic t Bool)
focus
  let

    loseFocusEv :: Event t ()
loseFocusEv = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
ffilter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t Bool
focusDyn

  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


    -- Menu
    -- TODO height should be dynamic but not sure if there's away to do this dynamically because width (from which buttonsHeightDyn) is derived depends on `grout . fixed`. You need to pull width from outside of the `grout . fixed` call to make this work right...
    (MenuButtonsWidget t
menuButtons, Event t Bool
menuFocusEv, Dynamic t Int
buttonsHeightDyn) <- (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
buttonsHeightDyn 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) <- 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", Text
"open", Text
"save", Text
"save as", Text
"export to \"potato.txt\"", Text
"quit"]) (forall a. a -> Maybe a
Just Dynamic t Int
widthDyn)
      let
        exportEv :: Event t ()
exportEv = forall t. Reflex t => Int -> Event t Int -> Event t ()
ffilterButtonIndex Int
4 Event t Int
buttonsEv
        menuButtons' :: MenuButtonsWidget t
menuButtons' = MenuButtonsWidget {
            _menuButtonsWidget_newEv :: Event t ()
_menuButtonsWidget_newEv = forall t. Reflex t => Int -> Event t Int -> Event t ()
ffilterButtonIndex Int
0 Event t Int
buttonsEv
            , _menuButtonsWidget_openEv :: Event t ()
_menuButtonsWidget_openEv = forall t. Reflex t => Int -> Event t Int -> Event t ()
ffilterButtonIndex Int
1 Event t Int
buttonsEv
            , _menuButtonsWidget_saveEv :: Event t ()
_menuButtonsWidget_saveEv = forall t. Reflex t => Int -> Event t Int -> Event t ()
ffilterButtonIndex Int
2 Event t Int
buttonsEv
            , _menuButtonsWidget_saveAsEv :: Event t ()
_menuButtonsWidget_saveAsEv = forall t. Reflex t => Int -> Event t Int -> Event t ()
ffilterButtonIndex Int
3 Event t Int
buttonsEv
            , _menuButtonsWidget_exportEv :: Event t ()
_menuButtonsWidget_exportEv = Event t ()
exportEv
            , _menuButtonsWidget_quitEv :: Event t ()
_menuButtonsWidget_quitEv = forall t. Reflex t => Int -> Event t Int -> Event t ()
ffilterButtonIndex Int
5 Event t Int
buttonsEv
          }
        clickPrintEv :: Event t RenderedCanvasRegion
clickPrintEv = forall {k} (t :: k) b a.
Reflex t =>
Behavior t b -> Event t a -> Event t b
tag (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current forall a b. (a -> b) -> a -> b
$ forall t. GoatWidget t -> Dynamic t RenderedCanvasRegion
_goatWidget_renderedCanvas GoatWidget t
_layersWidgetConfig_goatW) (forall (f :: * -> *) a. Functor f => f a -> f ()
void Event t ()
exportEv)
      -- TODO don't do this here cmon...
      forall t (m :: * -> *).
PerformEvent t m =>
Event t (Performable m ()) -> m ()
performEvent_ forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t RenderedCanvasRegion
clickPrintEv forall a b. (a -> b) -> a -> b
$ \RenderedCanvasRegion
rc -> do
         let t :: Text
t = RenderedCanvasRegion -> Text
renderedCanvasToText RenderedCanvasRegion
rc
         -- TODO at least use filename...
         forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
"potato.txt" Text
t
      Event t Bool
menuFocusEv' <- forall t (m :: * -> *).
(Reflex t, Monad m, HasInput t m) =>
m (Event t Bool)
mouseFocus
      return (MenuButtonsWidget t
menuButtons', Event t Bool
menuFocusEv', Dynamic t Int
heightDyn)



    forall t (m :: * -> *). (MonadWidget t m, HasLayout t m) => m ()
hdivider

    -- Tools
    (ToolWidget t
tools, Event t Bool
toolsFocusEv) <- (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) (forall t. ToolWidget t -> Dynamic t Int
_toolWidget_heightDyn ToolWidget t
tools) forall a b. (a -> b) -> a -> b
$ do
      ToolWidget t
tools' <- forall t (m :: * -> *).
(PostBuild t m, MonadWidget t m) =>
ToolWidgetConfig t -> m (ToolWidget t)
holdToolsWidget forall a b. (a -> b) -> a -> b
$ ToolWidgetConfig {
          _toolWidgetConfig_tool :: Dynamic t Tool
_toolWidgetConfig_tool =  forall t. GoatWidget t -> Dynamic t Tool
_goatWidget_tool GoatWidget t
_layersWidgetConfig_goatW
          , _toolWidgetConfig_widthDyn :: Dynamic t Int
_toolWidgetConfig_widthDyn = Dynamic t Int
widthDyn
        }
      Event t Bool
toolsFocusEv' <- forall t (m :: * -> *).
(Reflex t, Monad m, HasInput t m) =>
m (Event t Bool)
mouseFocus
      return (ToolWidget t
tools', Event t Bool
toolsFocusEv')

    -- ToolsOptions
    -- doesn't do anything right now, just a stub
    (ToolOptionsWidget t
toolOptions, Event t Bool
toolsOptionsFocusEv) <- (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) (forall t. ToolOptionsWidget t -> Dynamic t Int
_toolOptionsWidget_heightDyn ToolOptionsWidget t
toolOptions) forall a b. (a -> b) -> a -> b
$ do
      ToolOptionsWidget t
toolsOptions' <- forall t (m :: * -> *).
(PostBuild t m, MonadWidget t m) =>
ToolOptionsWidgetConfig t -> m (ToolOptionsWidget t)
holdToolOptionsWidget forall a b. (a -> b) -> a -> b
$ ToolOptionsWidgetConfig {
          _toolOptionsWidgetConfig_tool :: Dynamic t Tool
_toolOptionsWidgetConfig_tool =  forall t. GoatWidget t -> Dynamic t Tool
_goatWidget_tool GoatWidget t
_layersWidgetConfig_goatW
          , _toolOptionsWidgetConfig_widthDyn :: Dynamic t Int
_toolOptionsWidgetConfig_widthDyn = Dynamic t Int
widthDyn
        }
      Event t Bool
toolsOptionsFocusEv' <- forall t (m :: * -> *).
(Reflex t, Monad m, HasInput t m) =>
m (Event t Bool)
mouseFocus
      return (ToolOptionsWidget t
toolsOptions', Event t Bool
toolsOptionsFocusEv')

    forall t (m :: * -> *). (MonadWidget t m, HasLayout t m) => m ()
hdivider

    -- Layers
    (LayerWidget t
layers, Event t Bool
layersFocusEv) <- (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
$ do
      LayerWidget t
layers' <- forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
LayerWidgetConfig t -> m (LayerWidget t)
holdLayerWidget forall a b. (a -> b) -> a -> b
$ LayerWidgetConfig {
          _layerWidgetConfig_layers :: Dynamic t LayersState
_layerWidgetConfig_layers = forall t. GoatWidget t -> Dynamic t LayersState
_goatWidget_layers GoatWidget t
_layersWidgetConfig_goatW
          , _layerWidgetConfig_layersView :: Dynamic t LayersViewHandlerRenderOutput
_layerWidgetConfig_layersView = forall t. GoatWidget t -> Dynamic t LayersViewHandlerRenderOutput
_goatWidget_layersHandlerRenderOutput GoatWidget t
_layersWidgetConfig_goatW
          , _layerWidgetConfig_selection :: Dynamic t Selection
_layerWidgetConfig_selection = forall t. GoatWidget t -> Dynamic t Selection
_goatWidget_selection  GoatWidget t
_layersWidgetConfig_goatW
        }
      Event t Bool
layersFocusEv' <- forall t (m :: * -> *).
(Reflex t, Monad m, HasInput t m) =>
m (Event t Bool)
mouseFocus
      return (LayerWidget t
layers', Event t Bool
layersFocusEv')

    forall t (m :: * -> *). (MonadWidget t m, HasLayout t m) => m ()
hdivider

    
{-
    -- Info
    infoFocusEv <- (grout . fixed) 5 $ do
      holdInfoWidget $ InfoWidgetConfig {
          _infoWidgetConfig_selection = _goatWidget_selection _layersWidgetConfig_goatW
        }
      mouseFocus

    hdivider
-}
    let infoFocusEv :: Event t a
infoFocusEv = forall {k} (t :: k) a. Reflex t => Event t a
never

    -- Params
    (ParamsWidget t
params, Event t Bool
paramsFocusEv) <- (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) (forall t. ParamsWidget t -> Dynamic t Int
_paramsWidget_widgetHeight ParamsWidget t
params) forall a b. (a -> b) -> a -> b
$ do
      ParamsWidget t
params' <- forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
ParamsWidgetConfig t -> m (ParamsWidget t)
holdParamsWidget forall a b. (a -> b) -> a -> b
$ ParamsWidgetConfig {
          _paramsWidgetConfig_selectionDyn :: Dynamic t Selection
_paramsWidgetConfig_selectionDyn = forall t. GoatWidget t -> Dynamic t Selection
_goatWidget_selection GoatWidget t
_layersWidgetConfig_goatW
          , _paramsWidgetConfig_canvasDyn :: Dynamic t SCanvas
_paramsWidgetConfig_canvasDyn = forall t. GoatWidget t -> Dynamic t SCanvas
_goatWidget_canvas GoatWidget t
_layersWidgetConfig_goatW
          , _paramsWidgetConfig_defaultParamsDyn :: Dynamic t PotatoDefaultParameters
_paramsWidgetConfig_defaultParamsDyn = forall t. GoatWidget t -> Dynamic t PotatoDefaultParameters
_goatWidget_potatoDefaultParameters GoatWidget t
_layersWidgetConfig_goatW
          , _paramsWidgetConfig_toolDyn :: Dynamic t Tool
_paramsWidgetConfig_toolDyn = forall t. GoatWidget t -> Dynamic t Tool
_goatWidget_tool GoatWidget t
_layersWidgetConfig_goatW
          , _paramsWidgetConfig_loseFocusEv :: Event t ()
_paramsWidgetConfig_loseFocusEv = Event t ()
loseFocusEv
        }
      Event t Bool
paramsFocusEv' <- forall t (m :: * -> *).
(Reflex t, Monad m, HasInput t m) =>
m (Event t Bool)
mouseFocus
      return (ParamsWidget t
params', Event t Bool
paramsFocusEv')

    let 
      refinedFocusEv :: Event t String
refinedFocusEv = forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
        [ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const String
"menu") Event t Bool
menuFocusEv
        , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const String
"tools") Event t Bool
toolsFocusEv
        , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const String
"toolsOptions") Event t Bool
toolsOptionsFocusEv
        , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const String
"layers") Event t Bool
layersFocusEv
        , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const String
"info") forall {a}. Event t a
infoFocusEv
        , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const String
"params") Event t Bool
paramsFocusEv 
        ]

    Dynamic t String
refinedFocusDyn <- forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn String
"none" Event t String
refinedFocusEv

    let      
      setFocusDyn' :: Dynamic t (Maybe GoatFocusedArea)
setFocusDyn' = forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> (a -> b -> c) -> f c
ffor2 Dynamic t Bool
focusDyn Dynamic t String
refinedFocusDyn forall a b. (a -> b) -> a -> b
$ \Bool
f1 String
f2 -> case (Bool
f1, String
f2) of
        (Bool
True, String
"layers") -> forall a. a -> Maybe a
Just GoatFocusedArea
GoatFocusedArea_Layers
        (Bool
True, String
_)        -> forall a. a -> Maybe a
Just GoatFocusedArea
GoatFocusedArea_Other
        -- right now, canvas is the only other choice, eventually there migh be more, in which case change this to Nothing
        -- NOTE changing this to Nothing will break the rename via layers -> click on canvas case as currently Goat does not know how to resolve the layer rename handler without an explicit focus change
        (Bool
False, String
_)       -> forall a. a -> Maybe a
Just GoatFocusedArea
GoatFocusedArea_Canvas

    Dynamic t (Maybe GoatFocusedArea)
setFocusDyn <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn Dynamic t (Maybe GoatFocusedArea)
setFocusDyn'


    forall (m :: * -> *) a. Monad m => a -> m a
return LeftWidget {
        _leftWidget_layersW :: LayerWidget t
_leftWidget_layersW = LayerWidget t
layers
        , _leftWidget_toolsW :: ToolWidget t
_leftWidget_toolsW = ToolWidget t
tools
        , _leftWidget_paramsW :: ParamsWidget t
_leftWidget_paramsW = ParamsWidget t
params
        , _leftWidget_menuButtonsW :: MenuButtonsWidget t
_leftWidget_menuButtonsW = MenuButtonsWidget t
menuButtons
        , _leftWidget_setFocusEvent :: Event t GoatFocusedArea
_leftWidget_setFocusEvent = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe forall a. a -> a
id (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (Maybe GoatFocusedArea)
setFocusDyn)
      }