{-# 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 { TabbedWindowEntry s m n a -> a
tweValue :: a
                      -- ^ The handle for this tab.
                      , TabbedWindowEntry s m n a -> a -> s -> Widget n
tweRender :: a -> s -> Widget n
                      -- ^ The rendering function to use when this tab
                      -- is selected.
                      , TabbedWindowEntry s m n a -> a -> Event -> m ()
tweHandleEvent :: a -> Vty.Event -> m ()
                      -- ^ The event-handling function to use when this
                      -- tab is selected.
                      , TabbedWindowEntry s m n a -> a -> Bool -> Text
tweTitle :: a -> Bool -> T.Text
                      -- ^ Title function for this tab, with a boolean
                      -- indicating whether this is the current tab.
                      , TabbedWindowEntry s m n a -> a -> m ()
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 { TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
twtEntries :: [TabbedWindowEntry s m n a]
                         -- ^ The entries in tabbed windows with this
                         -- structure.
                         , TabbedWindowTemplate s m n a -> a -> Widget n
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 { TabbedWindow s m n a -> a
twValue :: a
                 -- ^ The handle of the currently-selected tab.
                 , TabbedWindow s m n a -> TabbedWindowTemplate s m n a
twTemplate :: TabbedWindowTemplate s m n a
                 -- ^ The template to use as a basis for rendering the
                 -- window and handling user input.
                 , TabbedWindow s m n a -> Int
twWindowWidth :: Int
                 , TabbedWindow s m n a -> 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 :: a
-> TabbedWindowTemplate s m n a
-> (Int, Int)
-> TabbedWindow s m n a
tabbedWindow a
initialVal TabbedWindowTemplate s m n a
t (Int
width, Int
height) =
    let handles :: [a]
handles = TabbedWindowEntry s m n a -> a
forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a
tweValue (TabbedWindowEntry s m n a -> a)
-> [TabbedWindowEntry s m n a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
forall s (m :: * -> *) n a.
TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
twtEntries TabbedWindowTemplate s m n a
t
    in if | [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
handles ->
              [Char] -> TabbedWindow s m n a
forall a. HasCallStack => [Char] -> a
error [Char]
"BUG: tabbed window template must provide at least one entry"
          | [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
handles Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> [a]
forall a. Eq a => [a] -> [a]
nub [a]
handles) ->
              [Char] -> TabbedWindow s m n a
forall a. HasCallStack => [Char] -> a
error [Char]
"BUG: tabbed window should have one entry per handle"
          | Bool -> Bool
not (a
initialVal a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
handles) ->
              [Char] -> TabbedWindow s m n a
forall a. HasCallStack => [Char] -> a
error ([Char] -> TabbedWindow s m n a) -> [Char] -> TabbedWindow s m n a
forall a b. (a -> b) -> a -> b
$ [Char]
"BUG: tabbed window handle " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>
                      a -> [Char]
forall a. Show a => a -> [Char]
show a
initialVal [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" not present in template"
          | Bool
otherwise ->
              TabbedWindow :: forall s (m :: * -> *) n a.
a
-> TabbedWindowTemplate s m n a
-> Int
-> Int
-> TabbedWindow s m n a
TabbedWindow { twTemplate :: TabbedWindowTemplate s m n a
twTemplate = TabbedWindowTemplate s m n a
t
                           , twValue :: a
twValue = a
initialVal
                           , twWindowWidth :: Int
twWindowWidth = Int
width
                           , twWindowHeight :: Int
twWindowHeight = Int
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 :: TabbedWindow s m n a -> TabbedWindowEntry s m n a
getCurrentTabbedWindowEntry TabbedWindow s m n a
w =
    a -> TabbedWindow s m n a -> TabbedWindowEntry s m n a
forall a s (m :: * -> *) n.
(Eq a, Show a) =>
a -> TabbedWindow s m n a -> TabbedWindowEntry s m n a
lookupTabbedWindowEntry (TabbedWindow s m n a -> a
forall s (m :: * -> *) n a. TabbedWindow s m n a -> a
twValue TabbedWindow s m n a
w) TabbedWindow s m n a
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 :: a -> TabbedWindow s m n a -> m ()
runTabShowHandlerFor a
handle TabbedWindow s m n a
w = do
    let entry :: TabbedWindowEntry s m n a
entry = a -> TabbedWindow s m n a -> TabbedWindowEntry s m n a
forall a s (m :: * -> *) n.
(Eq a, Show a) =>
a -> TabbedWindow s m n a -> TabbedWindowEntry s m n a
lookupTabbedWindowEntry a
handle TabbedWindow s m n a
w
    TabbedWindowEntry s m n a -> a -> m ()
forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a -> m ()
tweShowHandler TabbedWindowEntry s m n a
entry a
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 :: a -> TabbedWindow s m n a -> TabbedWindowEntry s m n a
lookupTabbedWindowEntry a
handle TabbedWindow s m n a
w =
    let matchesVal :: TabbedWindowEntry s m n a -> Bool
matchesVal TabbedWindowEntry s m n a
e = TabbedWindowEntry s m n a -> a
forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a
tweValue TabbedWindowEntry s m n a
e a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
handle
    in case (TabbedWindowEntry s m n a -> Bool)
-> [TabbedWindowEntry s m n a] -> [TabbedWindowEntry s m n a]
forall a. (a -> Bool) -> [a] -> [a]
filter TabbedWindowEntry s m n a -> Bool
forall s (m :: * -> *) n. TabbedWindowEntry s m n a -> Bool
matchesVal (TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
forall s (m :: * -> *) n a.
TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
twtEntries (TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a])
-> TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
forall a b. (a -> b) -> a -> b
$ TabbedWindow s m n a -> TabbedWindowTemplate s m n a
forall s (m :: * -> *) n a.
TabbedWindow s m n a -> TabbedWindowTemplate s m n a
twTemplate TabbedWindow s m n a
w) of
        [TabbedWindowEntry s m n a
e] -> TabbedWindowEntry s m n a
e
        [TabbedWindowEntry s m n a]
_ -> [Char] -> TabbedWindowEntry s m n a
forall a. HasCallStack => [Char] -> a
error ([Char] -> TabbedWindowEntry s m n a)
-> [Char] -> TabbedWindowEntry s m n a
forall a b. (a -> b) -> a -> b
$ [Char]
"BUG: tabbed window entry for " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> a -> [Char]
forall a. Show a => a -> [Char]
show (TabbedWindow s m n a -> a
forall s (m :: * -> *) n a. TabbedWindow s m n a -> a
twValue TabbedWindow s m n a
w) [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>
                     [Char]
" 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 :: TabbedWindow s m n a -> m (TabbedWindow s m n a)
tabbedWindowNextTab TabbedWindow s m n a
w | [TabbedWindowEntry s m n a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
forall s (m :: * -> *) n a.
TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
twtEntries (TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a])
-> TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
forall a b. (a -> b) -> a -> b
$ TabbedWindow s m n a -> TabbedWindowTemplate s m n a
forall s (m :: * -> *) n a.
TabbedWindow s m n a -> TabbedWindowTemplate s m n a
twTemplate TabbedWindow s m n a
w) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = TabbedWindow s m n a -> m (TabbedWindow s m n a)
forall (m :: * -> *) a. Monad m => a -> m a
return TabbedWindow s m n a
w
tabbedWindowNextTab TabbedWindow s m n a
w = do
    let curIdx :: Int
curIdx = case a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (TabbedWindowEntry s m n a -> a
forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a
tweValue TabbedWindowEntry s m n a
curEntry) [a]
allHandles of
            Maybe Int
Nothing ->
                [Char] -> Int
forall a. HasCallStack => [Char] -> a
error ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ [Char]
"BUG: tabbedWindowNextTab: could not find " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>
                        [Char]
"current handle in handle list"
            Just Int
i -> Int
i
        nextIdx :: Int
nextIdx = if Int
curIdx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
allHandles Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                  then Int
0
                  else Int
curIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        newHandle :: a
newHandle = [a]
allHandles [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
nextIdx
        allHandles :: [a]
allHandles = TabbedWindowEntry s m n a -> a
forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a
tweValue (TabbedWindowEntry s m n a -> a)
-> [TabbedWindowEntry s m n a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
forall s (m :: * -> *) n a.
TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
twtEntries (TabbedWindow s m n a -> TabbedWindowTemplate s m n a
forall s (m :: * -> *) n a.
TabbedWindow s m n a -> TabbedWindowTemplate s m n a
twTemplate TabbedWindow s m n a
w)
        curEntry :: TabbedWindowEntry s m n a
curEntry = TabbedWindow s m n a -> TabbedWindowEntry s m n a
forall a s (m :: * -> *) n.
(Show a, Eq a) =>
TabbedWindow s m n a -> TabbedWindowEntry s m n a
getCurrentTabbedWindowEntry TabbedWindow s m n a
w
        newWin :: TabbedWindow s m n a
newWin = TabbedWindow s m n a
w { twValue :: a
twValue = a
newHandle }

    a -> TabbedWindow s m n a -> m ()
forall a s (m :: * -> *) n.
(Eq a, Show a) =>
a -> TabbedWindow s m n a -> m ()
runTabShowHandlerFor a
newHandle TabbedWindow s m n a
newWin
    TabbedWindow s m n a -> m (TabbedWindow s m n a)
forall (m :: * -> *) a. Monad m => a -> m a
return TabbedWindow s m n a
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 :: TabbedWindow s m n a -> m (TabbedWindow s m n a)
tabbedWindowPreviousTab TabbedWindow s m n a
w | [TabbedWindowEntry s m n a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
forall s (m :: * -> *) n a.
TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
twtEntries (TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a])
-> TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
forall a b. (a -> b) -> a -> b
$ TabbedWindow s m n a -> TabbedWindowTemplate s m n a
forall s (m :: * -> *) n a.
TabbedWindow s m n a -> TabbedWindowTemplate s m n a
twTemplate TabbedWindow s m n a
w) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = TabbedWindow s m n a -> m (TabbedWindow s m n a)
forall (m :: * -> *) a. Monad m => a -> m a
return TabbedWindow s m n a
w
tabbedWindowPreviousTab TabbedWindow s m n a
w = do
    let curIdx :: Int
curIdx = case a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (TabbedWindowEntry s m n a -> a
forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a
tweValue TabbedWindowEntry s m n a
curEntry) [a]
allHandles of
            Maybe Int
Nothing ->
                [Char] -> Int
forall a. HasCallStack => [Char] -> a
error ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ [Char]
"BUG: tabbedWindowPreviousTab: could not find " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>
                        [Char]
"current handle in handle list"
            Just Int
i -> Int
i
        nextIdx :: Int
nextIdx = if Int
curIdx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                  then [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
allHandles Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                  else Int
curIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        newHandle :: a
newHandle = [a]
allHandles [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
nextIdx
        allHandles :: [a]
allHandles = TabbedWindowEntry s m n a -> a
forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a
tweValue (TabbedWindowEntry s m n a -> a)
-> [TabbedWindowEntry s m n a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
forall s (m :: * -> *) n a.
TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
twtEntries (TabbedWindow s m n a -> TabbedWindowTemplate s m n a
forall s (m :: * -> *) n a.
TabbedWindow s m n a -> TabbedWindowTemplate s m n a
twTemplate TabbedWindow s m n a
w)
        curEntry :: TabbedWindowEntry s m n a
curEntry = TabbedWindow s m n a -> TabbedWindowEntry s m n a
forall a s (m :: * -> *) n.
(Show a, Eq a) =>
TabbedWindow s m n a -> TabbedWindowEntry s m n a
getCurrentTabbedWindowEntry TabbedWindow s m n a
w
        newWin :: TabbedWindow s m n a
newWin = TabbedWindow s m n a
w { twValue :: a
twValue = a
newHandle }

    a -> TabbedWindow s m n a -> m ()
forall a s (m :: * -> *) n.
(Eq a, Show a) =>
a -> TabbedWindow s m n a -> m ()
runTabShowHandlerFor a
newHandle TabbedWindow s m n a
newWin
    TabbedWindow s m n a -> m (TabbedWindow s m n a)
forall (m :: * -> *) a. Monad m => a -> m a
return TabbedWindow s m n a
newWin