{-# 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 { TabbedWindowEntry s m n a -> a
tweValue :: a
, TabbedWindowEntry s m n a -> a -> s -> Widget n
tweRender :: a -> s -> Widget n
, TabbedWindowEntry s m n a -> a -> Event -> m ()
tweHandleEvent :: a -> Vty.Event -> m ()
, TabbedWindowEntry s m n a -> a -> Bool -> Text
tweTitle :: a -> Bool -> T.Text
, TabbedWindowEntry s m n a -> a -> m ()
tweShowHandler :: a -> m ()
}
data TabbedWindowTemplate s m n a =
TabbedWindowTemplate { TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
twtEntries :: [TabbedWindowEntry s m n a]
, TabbedWindowTemplate s m n a -> a -> Widget n
twtTitle :: a -> Widget n
}
data TabbedWindow s m n a =
TabbedWindow { TabbedWindow s m n a -> a
twValue :: a
, TabbedWindow s m n a -> TabbedWindowTemplate s m n a
twTemplate :: TabbedWindowTemplate s m n a
, TabbedWindow s m n a -> Int
twWindowWidth :: Int
, 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 :: 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
}
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
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
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"
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
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