-- TODO FINISH INCOMPLETE
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo     #-}

module Potato.Reflex.Vty.Widget.Windows (

) where

import           Relude

import           Potato.Reflex.Vty.Helpers
import           Potato.Reflex.Vty.Widget

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

import qualified Data.Map as Map
import           Data.Default
import Control.Monad.Fix

type WidgetId = Int

data WindowsAttrs t = WindowsAttrs {

}

data Window = Window {
  Window -> Text
_window_name :: Text
  , Window -> WidgetId
_window_widgetId :: WidgetId
  , Window -> Bool
_window_allowClose :: Bool
  , Window -> Bool
_window_allowMove :: Bool
  , Window -> Bool
_window_allowResize :: Bool
}

-- note, OneWindow can not have tabs added to it
data Tab = OneWindow Window | Tab [Window]

data DockDirection =
  DockDirection_Left
  | DockDirection_Right
  | DockDirection_Top
  | DockDirection_Bottom
  deriving (WidgetId -> DockDirection -> ShowS
[DockDirection] -> ShowS
DockDirection -> String
forall a.
(WidgetId -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DockDirection] -> ShowS
$cshowList :: [DockDirection] -> ShowS
show :: DockDirection -> String
$cshow :: DockDirection -> String
showsPrec :: WidgetId -> DockDirection -> ShowS
$cshowsPrec :: WidgetId -> DockDirection -> ShowS
Show)

data DockedTab = DockedTab {
  DockedTab -> [(WidgetId, Tab)]
_dockedTab_tabs :: [(Int, Tab)] -- left to right, or top to bottom
  , DockedTab -> WidgetId
_dockedTab_size :: Int
  , DockedTab -> DockDirection
_dockedTab_dir :: DockDirection
}

data FreeWindow = FreeWindow {
  FreeWindow -> Window
_freeWindow_window :: Window
  , FreeWindow -> (WidgetId, WidgetId)
_freeWindow_position :: (Int, Int)
  , FreeWindow -> (WidgetId, WidgetId)
_freeWindow_size :: (Int, Int)
}

type WindowWidgetMap t m a = Map WidgetId (m a)
data WindowManagerState t m a = WindowManagerState {
  forall t (m :: * -> *) a. WindowManagerState t m a -> [DockedTab]
_windowManagerState_docked :: [DockedTab]
  , forall t (m :: * -> *) a. WindowManagerState t m a -> [FreeWindow]
_windowManagerState_free :: [FreeWindow]
  , forall t (m :: * -> *) a.
WindowManagerState t m a -> (WidgetId, WidgetId)
_windowManagerState_size :: Dimension
  , forall t (m :: * -> *) a.
WindowManagerState t m a -> WindowWidgetMap t m a
_windowManagerState_widgetMap :: WindowWidgetMap t m a
}

emptyWindowManagerState :: WindowManagerState t m a
emptyWindowManagerState :: forall t (m :: * -> *) a. WindowManagerState t m a
emptyWindowManagerState = WindowManagerState {
    _windowManagerState_docked :: [DockedTab]
_windowManagerState_docked = []
    , _windowManagerState_free :: [FreeWindow]
_windowManagerState_free = []
    , _windowManagerState_size :: (WidgetId, WidgetId)
_windowManagerState_size = (WidgetId
0,WidgetId
0)
    , _windowManagerState_widgetMap :: WindowWidgetMap t m a
_windowManagerState_widgetMap = forall k a. Map k a
Map.empty
  }

-- temp math stuff
type Position = (Int, Int)
type Dimension = (Int, Int)
type PosDim = (Position, Dimension)

makeDynRegion :: (Reflex t) => Dynamic t Position -> Dynamic t Dimension -> Dynamic t Region
makeDynRegion :: forall t.
Reflex t =>
Dynamic t (WidgetId, WidgetId)
-> Dynamic t (WidgetId, WidgetId) -> Dynamic t Region
makeDynRegion Dynamic t (WidgetId, WidgetId)
dp Dynamic t (WidgetId, WidgetId)
dd = forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> (a -> b -> c) -> f c
ffor2 Dynamic t (WidgetId, WidgetId)
dp Dynamic t (WidgetId, WidgetId)
dd forall a b. (a -> b) -> a -> b
$ \(WidgetId
x,WidgetId
y) (WidgetId
w,WidgetId
h) -> WidgetId -> WidgetId -> WidgetId -> WidgetId -> Region
Region WidgetId
x WidgetId
y WidgetId
w WidgetId
h

--(:+) :: (Int, Int) -> (Int, Int) -> (Int, Int)
--(a,b) :+ (x,y) = (a+x, b+y)
--infixl 6 :+
--(-+) :: (Int, Int) -> (Int, Int) -> (Int, Int)
--(a,b) :+ (x,y) = (a-x, b-y)
--infixl 6 -+

computeDockDimensions :: PosDim -> [DockedTab] -> [PosDim]
computeDockDimensions :: PosDim -> [DockedTab] -> [PosDim]
computeDockDimensions PosDim
dim = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL PosDim -> DockedTab -> (PosDim, PosDim)
mapAccumFn PosDim
dim where
  mapAccumFn :: PosDim -> DockedTab -> (PosDim, PosDim)
mapAccumFn ((WidgetId
accx, WidgetId
accy), (WidgetId
accw, WidgetId
acch)) DockedTab
dt = (PosDim
newAccDim, PosDim
dtpd) where
    (PosDim
dtpd, PosDim
newAccDim) = case DockedTab -> DockDirection
_dockedTab_dir DockedTab
dt of
      DockDirection
DockDirection_Left -> (
          ((WidgetId
accx, WidgetId
accy), (WidgetId
dw, WidgetId
acch))
          , ((WidgetId
accxforall a. Num a => a -> a -> a
+WidgetId
dw, WidgetId
accy), (WidgetId
accwforall a. Num a => a -> a -> a
-WidgetId
dw, WidgetId
acch))
        )
      DockDirection
DockDirection_Right -> (
          ((WidgetId
accx forall a. Num a => a -> a -> a
+ WidgetId
accw forall a. Num a => a -> a -> a
- WidgetId
dw, WidgetId
accy), (WidgetId
dw, WidgetId
acch))
          , ((WidgetId
accx, WidgetId
accy), (WidgetId
accwforall a. Num a => a -> a -> a
-WidgetId
dw, WidgetId
acch))
        )
      DockDirection
DockDirection_Top -> (
          ((WidgetId
accx, WidgetId
accy), (WidgetId
accw, WidgetId
dh))
          , ((WidgetId
accx, WidgetId
accyforall a. Num a => a -> a -> a
+WidgetId
dh), (WidgetId
accw, WidgetId
acchforall a. Num a => a -> a -> a
-WidgetId
dh))
        )
      DockDirection
DockDirection_Bottom -> (
          ((WidgetId
accx, WidgetId
accy forall a. Num a => a -> a -> a
+ WidgetId
acch forall a. Num a => a -> a -> a
- WidgetId
dh), (WidgetId
accw, WidgetId
dh))
          , ((WidgetId
accx, WidgetId
accy), (WidgetId
accw, WidgetId
acchforall a. Num a => a -> a -> a
-WidgetId
dh))
        )
      where
        dw :: WidgetId
dw = forall a. Ord a => a -> a -> a
min WidgetId
accw (DockedTab -> WidgetId
_dockedTab_size DockedTab
dt)
        dh :: WidgetId
dh = forall a. Ord a => a -> a -> a
min WidgetId
acch (DockedTab -> WidgetId
_dockedTab_size DockedTab
dt)



data WindowManagerConfig t m a = WindowManagerConfig {
 forall t (m :: * -> *) a.
WindowManagerConfig t m a -> Map WidgetId (m a)
_windowManagerConfig_initialWidgets :: Map WidgetId (m a)

 -- TODO initial widget configuration

 , forall t (m :: * -> *) a.
WindowManagerConfig t m a -> WindowsAttrs t
_windowManagerConfig_style :: WindowsAttrs t

 -- eventually
 --, _windowManagerConfig_addWidget :: Event t
}

data WMCmd = WMCmd_None

{- TODO fix for new layout stuff
windowManager ::
  forall t m a. (Reflex t, Adjustable t m, NotReady t m, PostBuild t m, MonadFix m, MonadHold t m, MonadNodeId m, Monad m)
  => WindowManagerConfig t m a
  ->  m (Event t (NonEmpty a))
windowManager WindowManagerConfig {..} = mdo

  inpEv <- input
  widthDyn <- displayWidth
  heightDyn <- displayHeight
  initialWidth <- sample . current $ widthDyn
  initialHeight <- sample . current $ heightDyn

  let
    cmdev = never
    foldfn :: WMCmd -> WindowManagerState t m a -> WindowManagerState t m a
    foldfn cmd wms@WindowManagerState {..} = r where
      r = wms

    initialState = emptyWindowManagerState {
        _windowManagerState_size = (initialWidth, initialHeight)
      }

  wmsDyn <- foldDyn foldfn initialState cmdev

  -- TODO wrap everything in a VtyWidget so you can capture mouse input for dock manipulation

  -- TODO first render docked widgets

  -- next render floating widgets
  let
    freeWindowFn :: WindowWidgetMap t m a -> Dynamic t Bool -> Dynamic t FreeWindow -> m a
    freeWindowFn wwm focussedDyn freeWindowDyn  = do
      -- TODO change return type to Dynamic t (m a) so that these params can change too
      Window {..} <- sample . current $ fmap _freeWindow_window freeWindowDyn
      let
        child = case Map.lookup _window_widgetId wwm of
          -- TODO pretty sure you should just change to m ()
          Nothing -> return undefined
          Just w -> w
        dynRegion = makeDynRegion (_freeWindow_position <$> freeWindowDyn) (_freeWindow_size <$> freeWindowDyn)
      pane dynRegion focussedDyn $ do
        -- TODO add close button
        -- TODO proper window widget, this is just temp render for testing
        boxTitle (constant roundedBoxStyle) (constant _window_name) child

  let
    freeWindowsDyn = fmap _windowManagerState_free wmsDyn
    -- TODO figure out how to pass in focussedDyn
    fmapFnFreeWindow wms = simpleList freeWindowsDyn (freeWindowFn (_windowManagerState_widgetMap wms) (constDyn False))
  outputEvs <- networkView $ fmap fmapFnFreeWindow wmsDyn


  -- TODO fmap through wmsDyn window stack and render them
  -- TODO fanMap out window events (close/moved)
  return never
-}
-- TODO monad for making initial configuration
{-
dock = do
  free $ widget1
  free $ widget2
  free $ widget3
  dock DockDirection_Left $ do
    addTab $ do
      tab $ widget4
      tab $ widget5
    addTab $ do
      tab $ widget6
      tab $ widget7
  dock DockDirection_Bottom $ do
    addWindow $ widget8
-}