content: {-# LANGUAGE MultiWayIf #-}
  module Matterhorn.Types.TabbedWindow
    ( TabbedWindow(..)
    , TabbedWindowEntry(..)
    , TabbedWindowTemplate(..)
  
    , tabbedWindow
    , getCurrentTabbedWindowEntry
    , tabbedWindowNextTab
    , tabbedWindowPreviousTab
    , runTabShowHandlerFor
    )
  where
  
  import           Prelude ()
  import           Matterhorn.Prelude
  
  import           Brick ( Widget )
  import           Data.List ( nub, elemIndex )
  import qualified Data.Text as T
  import qualified Graphics.Vty as Vty
  
  
  -- | An entry in a tabbed window corresponding to a tab and its content.
  -- Parameterized over an abstract handle type ('a') for the tabs so we
  -- can give each a unique handle.
  data TabbedWindowEntry s m n a =
      TabbedWindowEntry { tweValue :: a
                        -- ^ The handle for this tab.
                        , tweRender :: a -> s -> Widget n
                        -- ^ The rendering function to use when this tab
                        -- is selected.
                        , tweHandleEvent :: a -> Vty.Event -> m ()
                        -- ^ The event-handling function to use when this
                        -- tab is selected.
                        , tweTitle :: a -> Bool -> T.Text
                        -- ^ Title function for this tab, with a boolean
                        -- indicating whether this is the current tab.
                        , tweShowHandler :: a -> m ()
                        -- ^ A handler to be invoked when this tab is
                        -- shown.
                        }
  
  -- | The definition of a tabbed window. Note that this does not track
  -- the *state* of the window; it merely provides a collection of tab
  -- window entries (see above). To track the state of a tabbed window,
  -- use a TabbedWindow.
  --
  -- Parameterized over an abstract handle type ('a') for the tabs so we
  -- can give each a unique handle.
  data TabbedWindowTemplate s m n a =
      TabbedWindowTemplate { twtEntries :: [TabbedWindowEntry s m n a]
                           -- ^ The entries in tabbed windows with this
                           -- structure.
                           , twtTitle :: a -> Widget n
                           -- ^ The title-rendering function for this kind
                           -- of tabbed window.
                           }
  
  -- | An instantiated tab window. This is based on a template and tracks
  -- the state of the tabbed window (current tab).
  --
  -- Parameterized over an abstract handle type ('a') for the tabs so we
  -- can give each a unique handle.
  data TabbedWindow s m n a =
      TabbedWindow { twValue :: a
                   -- ^ The handle of the currently-selected tab.
                   , twTemplate :: TabbedWindowTemplate s m n a
                   -- ^ The template to use as a basis for rendering the
                   -- window and handling user input.
                   , twWindowWidth :: Int
                   , twWindowHeight :: Int
                   -- ^ Window dimensions
                   }
  
  -- | Construct a new tabbed window from a template. This will raise an
  -- exception if the initially-selected tab does not exist in the window
  -- template, or if the window template has any duplicated tab handles.
  --
  -- Note that the caller is responsible for determining whether to call
  -- the initially-selected tab's on-show handler.
  tabbedWindow :: (Show a, Eq a)
               => a
               -- ^ The handle corresponding to the tab that should be
               -- selected initially.
               -> TabbedWindowTemplate s m n a
               -- ^ The template for the window to construct.
               -> (Int, Int)
               -- ^ The window dimensions (width, height).
               -> TabbedWindow s m n a
  tabbedWindow initialVal t (width, height) =
      let handles = tweValue <$> twtEntries t
      in if | null handles ->
                error "BUG: tabbed window template must provide at least one entry"
            | length handles /= length (nub handles) ->
                error "BUG: tabbed window should have one entry per handle"
            | not (initialVal `elem` handles) ->
                error $ "BUG: tabbed window handle " <>
                        show initialVal <> " not present in template"
            | otherwise ->
                TabbedWindow { twTemplate = t
                             , twValue = initialVal
                             , twWindowWidth = width
                             , twWindowHeight = height
                             }
  
  -- | Get the currently-selected tab entry for a tabbed window. Raise
  -- an exception if the window's selected tab handle is not found in its
  -- template (which is a bug in the tabbed window infrastructure).
  getCurrentTabbedWindowEntry :: (Show a, Eq a)
                              => TabbedWindow s m n a
                              -> TabbedWindowEntry s m n a
  getCurrentTabbedWindowEntry w =
      lookupTabbedWindowEntry (twValue w) w
  
  -- | Run the on-show handler for the window tab entry with the specified
  -- handle.
  runTabShowHandlerFor :: (Eq a, Show a) => a -> TabbedWindow s m n a -> m ()
  runTabShowHandlerFor handle w = do
      let entry = lookupTabbedWindowEntry handle w
      tweShowHandler entry handle
  
  -- | Look up a tabbed window entry by handle. Raises an exception if no
  -- such entry exists.
  lookupTabbedWindowEntry :: (Eq a, Show a)
                          => a
                          -> TabbedWindow s m n a
                          -> TabbedWindowEntry s m n a
  lookupTabbedWindowEntry handle w =
      let matchesVal e = tweValue e == handle
      in case filter matchesVal (twtEntries $ twTemplate w) of
          [e] -> e
          _ -> error $ "BUG: tabbed window entry for " <> show (twValue w) <>
                       " should have matched a single entry"
  
  -- | Switch a tabbed window's selected tab to its next tab, cycling back
  -- to the first tab if the last tab is the selected tab. This also
  -- invokes the on-show handler for the newly-selected tab.
  --
  -- Note that this does nothing if the window has only one tab.
  tabbedWindowNextTab :: (Monad m, Show a, Eq a)
                      => TabbedWindow s m n a
                      -> m (TabbedWindow s m n a)
  tabbedWindowNextTab w | length (twtEntries $ twTemplate w) == 1 = return w
  tabbedWindowNextTab w = do
      let curIdx = case elemIndex (tweValue curEntry) allHandles of
              Nothing ->
                  error $ "BUG: tabbedWindowNextTab: could not find " <>
                          "current handle in handle list"
              Just i -> i
          nextIdx = if curIdx == length allHandles - 1
                    then 0
                    else curIdx + 1
          newHandle = allHandles !! nextIdx
          allHandles = tweValue <$> twtEntries (twTemplate w)
          curEntry = getCurrentTabbedWindowEntry w
          newWin = w { twValue = newHandle }
  
      runTabShowHandlerFor newHandle newWin
      return newWin
  
  -- | Switch a tabbed window's selected tab to its previous tab, cycling
  -- to the last tab if the first tab is the selected tab. This also
  -- invokes the on-show handler for the newly-selected tab.
  --
  -- Note that this does nothing if the window has only one tab.
  tabbedWindowPreviousTab :: (Monad m, Show a, Eq a)
                          => TabbedWindow s m n a
                          -> m (TabbedWindow s m n a)
  tabbedWindowPreviousTab w | length (twtEntries $ twTemplate w) == 1 = return w
  tabbedWindowPreviousTab w = do
      let curIdx = case elemIndex (tweValue curEntry) allHandles of
              Nothing ->
                  error $ "BUG: tabbedWindowPreviousTab: could not find " <>
                          "current handle in handle list"
              Just i -> i
          nextIdx = if curIdx == 0
                    then length allHandles - 1
                    else curIdx - 1
          newHandle = allHandles !! nextIdx
          allHandles = tweValue <$> twtEntries (twTemplate w)
          curEntry = getCurrentTabbedWindowEntry w
          newWin = w { twValue = newHandle }
  
      runTabShowHandlerFor newHandle newWin
      return newWin
  