{-# 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
data TabbedWindowEntry s m n a =
TabbedWindowEntry { forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a
tweValue :: a
, forall s (m :: * -> *) n a.
TabbedWindowEntry s m n a -> a -> s -> Widget n
tweRender :: a -> s -> Widget n
, forall s (m :: * -> *) n a.
TabbedWindowEntry s m n a -> a -> Event -> m ()
tweHandleEvent :: a -> Vty.Event -> m ()
, forall s (m :: * -> *) n a.
TabbedWindowEntry s m n a -> a -> Bool -> Text
tweTitle :: a -> Bool -> T.Text
, forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a -> m ()
tweShowHandler :: a -> m ()
}
data TabbedWindowTemplate s m n a =
TabbedWindowTemplate { forall s (m :: * -> *) n a.
TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
twtEntries :: [TabbedWindowEntry s m n a]
, forall s (m :: * -> *) n a.
TabbedWindowTemplate s m n a -> a -> Widget n
twtTitle :: a -> Widget n
}
data TabbedWindow s m n a =
TabbedWindow { forall s (m :: * -> *) n a. TabbedWindow s m n a -> a
twValue :: a
, forall s (m :: * -> *) n a.
TabbedWindow s m n a -> TabbedWindowTemplate s m n a
twTemplate :: TabbedWindowTemplate s m n a
, forall s (m :: * -> *) n a. TabbedWindow s m n a -> Int
twWindowWidth :: Int
, forall s (m :: * -> *) n a. TabbedWindow s m n a -> Int
twWindowHeight :: Int
}
tabbedWindow :: (Show a, Eq a)
=> a
-> TabbedWindowTemplate s m n a
-> (Int, Int)
-> TabbedWindow s m n a
tabbedWindow :: forall a s (m :: * -> *) n.
(Show a, Eq a) =>
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 = forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a
tweValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) n a.
TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
twtEntries TabbedWindowTemplate s m n a
t
in if | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
handles ->
forall a. HasCallStack => [Char] -> a
error [Char]
"BUG: tabbed window template must provide at least one entry"
| forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
handles forall a. Eq a => a -> a -> Bool
/= forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. Eq a => [a] -> [a]
nub [a]
handles) ->
forall a. HasCallStack => [Char] -> a
error [Char]
"BUG: tabbed window should have one entry per handle"
| Bool -> Bool
not (a
initialVal forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
handles) ->
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"BUG: tabbed window handle " forall a. Semigroup a => a -> a -> a
<>
forall a. Show a => a -> [Char]
show a
initialVal forall a. Semigroup a => a -> a -> a
<> [Char]
" not present in template"
| Bool
otherwise ->
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
}
getCurrentTabbedWindowEntry :: (Show a, Eq a)
=> TabbedWindow s m n a
-> TabbedWindowEntry s m n a
getCurrentTabbedWindowEntry :: 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 =
forall a s (m :: * -> *) n.
(Eq a, Show a) =>
a -> TabbedWindow s m n a -> TabbedWindowEntry s m n a
lookupTabbedWindowEntry (forall s (m :: * -> *) n a. TabbedWindow s m n a -> a
twValue TabbedWindow s m n a
w) TabbedWindow s m n a
w
runTabShowHandlerFor :: (Eq a, Show a) => a -> TabbedWindow s m n a -> m ()
runTabShowHandlerFor :: forall a s (m :: * -> *) n.
(Eq a, Show a) =>
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 = 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
forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a -> m ()
tweShowHandler TabbedWindowEntry s m n a
entry a
handle
lookupTabbedWindowEntry :: (Eq a, Show a)
=> a
-> TabbedWindow s m n a
-> TabbedWindowEntry s m n a
lookupTabbedWindowEntry :: 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 =
let matchesVal :: TabbedWindowEntry s m n a -> Bool
matchesVal TabbedWindowEntry s m n a
e = forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a
tweValue TabbedWindowEntry s m n a
e forall a. Eq a => a -> a -> Bool
== a
handle
in case forall a. (a -> Bool) -> [a] -> [a]
filter forall {s} {m :: * -> *} {n}. TabbedWindowEntry s m n a -> Bool
matchesVal (forall s (m :: * -> *) n a.
TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
twtEntries forall a b. (a -> b) -> a -> b
$ 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]
_ -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"BUG: tabbed window entry for " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show (forall s (m :: * -> *) n a. TabbedWindow s m n a -> a
twValue TabbedWindow s m n a
w) forall a. Semigroup a => a -> a -> a
<>
[Char]
" should have matched a single entry"
tabbedWindowNextTab :: (Monad m, Show a, Eq a)
=> TabbedWindow s m n a
-> m (TabbedWindow s m n a)
tabbedWindowNextTab :: forall (m :: * -> *) a s n.
(Monad m, Show a, Eq a) =>
TabbedWindow s m n a -> m (TabbedWindow s m n a)
tabbedWindowNextTab TabbedWindow s m n a
w | forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall s (m :: * -> *) n a.
TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
twtEntries forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) n a.
TabbedWindow s m n a -> TabbedWindowTemplate s m n a
twTemplate TabbedWindow s m n a
w) forall a. Eq a => a -> a -> Bool
== Int
1 = 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 forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a
tweValue TabbedWindowEntry s m n a
curEntry) [a]
allHandles of
Maybe Int
Nothing ->
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"BUG: tabbedWindowNextTab: could not find " forall a. Semigroup a => a -> a -> a
<>
[Char]
"current handle in handle list"
Just Int
i -> Int
i
nextIdx :: Int
nextIdx = if Int
curIdx forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
allHandles forall a. Num a => a -> a -> a
- Int
1
then Int
0
else Int
curIdx forall a. Num a => a -> a -> a
+ Int
1
newHandle :: a
newHandle = [a]
allHandles forall a. [a] -> Int -> a
!! Int
nextIdx
allHandles :: [a]
allHandles = forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a
tweValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) n a.
TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
twtEntries (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 = 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 }
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
forall (m :: * -> *) a. Monad m => a -> m a
return TabbedWindow s m n a
newWin
tabbedWindowPreviousTab :: (Monad m, Show a, Eq a)
=> TabbedWindow s m n a
-> m (TabbedWindow s m n a)
tabbedWindowPreviousTab :: forall (m :: * -> *) a s n.
(Monad m, Show a, Eq a) =>
TabbedWindow s m n a -> m (TabbedWindow s m n a)
tabbedWindowPreviousTab TabbedWindow s m n a
w | forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall s (m :: * -> *) n a.
TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
twtEntries forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) n a.
TabbedWindow s m n a -> TabbedWindowTemplate s m n a
twTemplate TabbedWindow s m n a
w) forall a. Eq a => a -> a -> Bool
== Int
1 = 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 forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a
tweValue TabbedWindowEntry s m n a
curEntry) [a]
allHandles of
Maybe Int
Nothing ->
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"BUG: tabbedWindowPreviousTab: could not find " forall a. Semigroup a => a -> a -> a
<>
[Char]
"current handle in handle list"
Just Int
i -> Int
i
nextIdx :: Int
nextIdx = if Int
curIdx forall a. Eq a => a -> a -> Bool
== Int
0
then forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
allHandles forall a. Num a => a -> a -> a
- Int
1
else Int
curIdx forall a. Num a => a -> a -> a
- Int
1
newHandle :: a
newHandle = [a]
allHandles forall a. [a] -> Int -> a
!! Int
nextIdx
allHandles :: [a]
allHandles = forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a
tweValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) n a.
TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
twtEntries (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 = 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 }
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
forall (m :: * -> *) a. Monad m => a -> m a
return TabbedWindow s m n a
newWin