Common.hs

module UI.Widgets.Common
  ( module UI.Widgets.Common
  , module UI.Terminal.IO
  , module Control.Monad
  , module Data.Text
  , module Control.Monad.IO.Class
  , module Data.Constraint
  , module GHC.Stack
  ) where

import Common
import Control.DeepSeq
import Control.Concurrent.STM (atomically)
import Control.Concurrent.STM.TChan
import Control.Concurrent.STM.TVar
import Control.Monad.State.Strict
import Control.Exception
import Control.Monad.IO.Class
import Control.Monad.Loops (iterateWhile)
import Data.Bits
import GHC.Generics
import Data.Constraint
import Data.Kind (Type)
import Data.Map.Strict as M hiding (keys)
import Data.Maybe
import Data.Text as T
import Data.Text hiding (lines)
import qualified Data.Text as C
import Data.Text.IO as T
import Data.Typeable (Proxy(..), Typeable, cast, typeRep)
import qualified Data.Vector.Mutable as MV
import Data.Word
import GHC.Stack
import qualified System.IO as SIO
import System.Random
import qualified System.Terminal as TERM
import UI.Chars
import UI.Terminal.IO

import Control.Monad
import Control.Monad.Reader
import DiffRender.DiffRender
import Highlighter.Highlighter
import qualified System.Console.ANSI as A
import qualified System.IO as S

data WidgetState = WidgetState
  { wsWidgets            :: Map Int SomeWidget
  , wsCursorWidget       :: Maybe SomeKeyInputWidget -- Widget that authoritativly decide the status/location of cursor. Does not decide what widgets receive keyboard input
  , wsCursorVisible      :: Bool
  }

data UIState = UIState
  { usWidgetState :: WidgetState
  , usDiffRender  :: DiffRender
  }

liftWSMod :: (WidgetState -> WidgetState) -> (UIState -> UIState)
liftWSMod fn = (\us -> us { usWidgetState = fn $ usWidgetState us })

class HasCharScreen m where
  csInitialize :: Dimensions -> m ()
  csClear :: m ()
  csClearLine :: m ()
  csDraw :: Maybe (ScreenPos, Dimensions) -> m ()
  csPutText :: StyledText -> m ()
  csSetCursorPosition :: Int -> Int -> m ()

setCursorVisibility :: WidgetC m => Bool ->  m ()
setCursorVisibility b = modifyWidgetState (\ws -> ws { wsCursorVisible = b })

emptyWidgetState :: WidgetState
emptyWidgetState = do
  WidgetState mempty Nothing True

emptyUIState :: Dimensions -> IO UIState
emptyUIState dim = do
  dfr <- emptyDiffRender dim
  pure $ UIState emptyWidgetState dfr

type WidgetM m a = ReaderT (TVar UIState) m a

runWidgetM'' :: MonadIO m => UIState -> WidgetM m a -> m a
runWidgetM'' uistate act = do
  ws <- liftIO $ newTVarIO uistate
  flip runReaderT ws act

runWidgetM :: MonadIO m => WidgetM m a -> m a
runWidgetM act = do
  ws <- liftIO $ ((emptyUIState $ Dimensions 0 0))
  runWidgetM'' ws act

class HasDiffRender m where
  getDiffRender :: m DiffRender
  putDiffRender :: DiffRender -> m ()
  modifyDiffRender :: (DiffRender -> DiffRender) -> m ()

class HasWidgetState m where
  getWidgetState :: m WidgetState
  getWidgetStateMaybe :: m (Maybe WidgetState)
  putWidgetState :: WidgetState -> m ()
  modifyWidgetState :: (WidgetState -> WidgetState) -> m ()

askWidgetM :: MonadIO m => WidgetM m UIState
askWidgetM = do
  tvar <- ask
  liftIO $ atomically $ readTVar tvar

modifyWidgetM :: MonadIO m => (UIState -> UIState) -> WidgetM m ()
modifyWidgetM fn = do
    tvar <- ask
    liftIO $ atomically $ modifyTVar tvar fn

instance MonadIO m => HasDiffRender (ReaderT (TVar UIState) m) where
  getDiffRender = usDiffRender <$> askWidgetM
  putDiffRender dfr = modifyWidgetM (\us -> us { usDiffRender = dfr })
  modifyDiffRender fn = modifyWidgetM (\us -> us { usDiffRender = fn $ usDiffRender us })

instance MonadIO m => HasWidgetState (ReaderT (TVar UIState) m) where
  getWidgetState = usWidgetState <$> askWidgetM
  getWidgetStateMaybe = (Just . usWidgetState) <$> askWidgetM
  putWidgetState ws =
    modifyWidgetM (\us -> us { usWidgetState = ws })
  modifyWidgetState fn = modifyWidgetM (\us -> us { usWidgetState = fn $ usWidgetState us })

type WidgetC m =
  ( HasRandom m
  , HasLog m
  , HasTerminal m
  , MonadIO m
  , HasDiffRender m
  , HasWidgetState m
  , Typeable m
  )

getScreenBounds :: WidgetC m => m Dimensions
getScreenBounds = do
  screenState <- dfScreenState <$> getDiffRender
  let
    screenLines = ssLines screenState
    screenColumns = ssColumns screenState
  pure $ Dimensions screenColumns (MV.length screenLines)

instance MonadIO m => HasRandom m where
  getRandom = liftIO randomIO

instance (MonadIO m, WidgetC m) => HasCharScreen m where
  csInitialize dim = do
    emptyDfr <- liftIO $ emptyDiffRender dim
    putDiffRender emptyDfr

  csClear = do
    dfIn <- getDiffRender
    let bb = dfScreenStateBack dfIn
    liftIO $ MV.set (ssLines bb) [Plain (T.replicate (ssColumns bb) " ")]

  csClearLine = do
    dfIn <- getDiffRender
    let bb = dfScreenStateBack dfIn
    liftIO $ MV.modify (ssLines bb) (\_ -> [Plain (T.replicate (ssColumns bb) " ")]) (sY $ ssCursorPos bb)

  -- This function accepts a screen position and a window dimension to which the
  -- output should be rendered. This is used to render the program output to the
  -- output widget when the program is executed in the IDE.
  csDraw mScreenParams  = do
    dfr@(DiffRender { dfDebug = _, dfScreenStateBack = (ssLines -> ssb), dfScreenState = (ssLines -> ss) }) <- getDiffRender
    let
      (screenOffsetX, screenOffsetY) = case mScreenParams of
        Just (sp, _) -> (sX sp, sY sp)
        Nothing      -> (0, 0)

    liftIO $ MV.imapM_ (\idx neLine -> do
      oldLine <- MV.read ss idx
      if (oldLine /= neLine)
        then do
          -- if isDebug then
          --     appendLog (oldLine, neLine)
          --     else pass
          A.setCursorPosition (idx + screenOffsetY) screenOffsetX
          -- mapM_ (\x -> do T.putStr x; S.hFlush S.stdout; wait 0.005;) (stRender <$> neLine)
          mapM_ T.putStr (stRender <$> neLine)
          S.hFlush S.stdout
        else pure ()
      ) ssb
    liftIO $ copyScreenState (dfScreenStateBack dfr) (dfScreenState dfr)

    getWidgetStateMaybe >>= \case
      Nothing -> pass
      Just ws -> do
        case wsCursorVisible ws of
          False -> pass
          True ->
            case wsCursorWidget ws of
              Just (SomeKeyInputWidget fref) -> getCursorInfo fref >>= \case
                Just (cl, csst) -> do
                  liftIO $ A.setCursorPosition (sY cl + screenOffsetY) (sX cl + screenOffsetX)
                  putTextFlush $ cursorStyleCode csst
                Nothing -> pass
              Nothing -> pass

  csPutText t = getDiffRender >>= dfPutText t

  csSetCursorPosition x y = do
    modifyDiffRender (dfSetCursorPosition (const x) (const y))

getTerminalSizeIO :: IO (Maybe (Int, Int))
getTerminalSizeIO = do
  A.getTerminalSize >>= \case
    Just (y, x) -> pure $ Just (x, y)
    Nothing     -> pure Nothing

-- Below, the type parameter `a` is left in case we need to use tagged
-- references, like an IORef.
newtype WRef (a :: Type) = WRef Int
  deriving newtype (Eq, Ord)

strToKeyEvent :: String -> [KeyEvent]
-- gnome-terminal
strToKeyEvent ('\DEL': rst)  =  (KeyCtrl False False False Backspace):strToKeyEvent rst
strToKeyEvent ('\ESC': '[' : 'A' : rst)  =  (KeyCtrl False False False ArrowUp) : strToKeyEvent rst
strToKeyEvent ('\ESC': '[' : 'B' : rst)  =  (KeyCtrl False False False ArrowDown) : strToKeyEvent rst
strToKeyEvent ('\ESC': '[' : 'H' : rst)  =  (KeyCtrl False False False Home) : strToKeyEvent rst
strToKeyEvent ('\ESC': '[' : 'F' : rst)  =  (KeyCtrl False False False End) : strToKeyEvent rst
strToKeyEvent ('\ESC': '[' : 'C' : rst)  =  (KeyCtrl False False False ArrowRight) : strToKeyEvent rst
strToKeyEvent ('\ESC': '[' : 'D' : rst)  =  (KeyCtrl False False False ArrowLeft) : strToKeyEvent rst
strToKeyEvent ('\ESC': '[' : '5': '~': rst)  =  (KeyCtrl False False False PageUp) : strToKeyEvent rst
strToKeyEvent ('\ESC': '[' : '6': '~': rst)  =  (KeyCtrl False False False PageDown) : strToKeyEvent rst
strToKeyEvent ('\ESC': '[' : '2' : '~': rst)  =  (KeyCtrl False False False Insert) : strToKeyEvent rst
strToKeyEvent ('\ESC': '[' : '3' : '~': rst)  =  (KeyCtrl False False False Del) : strToKeyEvent rst
strToKeyEvent ('\ESC': '[' : '1' : '5': '~': rst)  =  (KeyCtrl False False False (Fun 5)) : strToKeyEvent rst
strToKeyEvent ('\ESC': '[' : '1' : '7': '~': rst)  =  (KeyCtrl False False False (Fun 6)) : strToKeyEvent rst
strToKeyEvent ('\ESC': '[' : '2' : '1': '~': rst)  =  (KeyCtrl False False False (Fun 10)) : strToKeyEvent rst
strToKeyEvent ('\ESC': 'O' : 'P': rst)  =  (KeyCtrl False False False (Fun 1)) : strToKeyEvent rst
strToKeyEvent ('\ESC': 'O' : 'Q': rst)  =  (KeyCtrl False False False (Fun 2)) : strToKeyEvent rst
strToKeyEvent ('\ESC': 'O' : 'R': rst)  =  (KeyCtrl False False False (Fun 3)) : strToKeyEvent rst
strToKeyEvent ('\ESC': '[' : '1': '9': ';' : '5' : '~' : rst)  = (KeyCtrl True False False (Fun 8)) : strToKeyEvent rst
strToKeyEvent ('\ESC': '[' : '1': ';' : '2' : 'C' : rst)  = (KeyCtrl True False False (ArrowRight)) : strToKeyEvent rst
strToKeyEvent ('\ESC': '[' : '1': ';' : '2' : 'D' : rst)  = (KeyCtrl True False False (ArrowLeft)) : strToKeyEvent rst
strToKeyEvent ('\ESC': '[' : '1': ';' : '2' : 'B' : rst)  = (KeyCtrl True False False (ArrowDown)) : strToKeyEvent rst
strToKeyEvent ('\ESC': '[' : '1': ';' : '2' : 'A' : rst)  = (KeyCtrl True False False (ArrowUp)) : strToKeyEvent rst

-- Linux term
strToKeyEvent ('\ESC': '[' : '[' : 'E': rst)  =  (KeyCtrl False False False (Fun 5)) : strToKeyEvent rst
strToKeyEvent ('\ESC': '[' : 'Z': rst)  =  (KeyCtrl False True False Tab) : strToKeyEvent rst
--
strToKeyEvent ('\ESC': c : rst )  =  (KeyChar False False True c) : strToKeyEvent rst
strToKeyEvent ('\ESC' : rst)  =  (KeyCtrl False False False Esc) : strToKeyEvent rst
strToKeyEvent ('\n': rst)  =  (KeyCtrl False False False Return) : strToKeyEvent rst
strToKeyEvent ('\t': rst)  =  (KeyCtrl False False False Tab) : strToKeyEvent rst
strToKeyEvent str       =  KeyChar False False False <$> str

-- Some terminals sets the eighth bit, instead of sending
-- Escape code to indicate alt key sequences. So this function
-- checks for the 8th bit, and if it is set, sets the alt modifier
-- and changes the original char to one with 8th bit unset.
convertFrom8Bit :: KeyEvent -> KeyEvent
convertFrom8Bit kc@(KeyChar c s _ char) = let
  cw = (toEnum $ fromEnum char) :: Word8
  mask' = complement (bit 7)
  in if ((bit 7 .&. cw) > 0) then (KeyChar c s True (toEnum $ fromEnum (cw .&. mask'))) else kc
convertFrom8Bit c = c

readTerminalEvent :: (TERM.MonadScreen m, TERM.MonadInput m, MonadIO m) => m [TerminalEvent]
readTerminalEvent = TERM.awaitEvent >>= \case
    Left _ -> do
      pure [TerminalInterrupt]
    Right x -> do
      case x of
        TERM.WindowEvent TERM.WindowSizeChanged -> do
          TERM.Size h w <- TERM.getWindowSize
          pure [TerminalResize w h]
        TERM.KeyEvent k mods -> pure $ TerminalKey <$> case k of
          TERM.CharKey c -> [convertFrom8Bit $ setModifiers mods $ KeyChar False False False c]
          TERM.ArrowKey TERM.Upwards -> [setModifiers mods $ KeyCtrl False False False ArrowUp]
          TERM.ArrowKey TERM.Downwards -> [setModifiers mods $ KeyCtrl False False False ArrowDown]
          TERM.ArrowKey TERM.Rightwards -> [setModifiers mods $ KeyCtrl False False False ArrowRight]
          TERM.ArrowKey TERM.Leftwards -> [setModifiers mods $ KeyCtrl False False False ArrowLeft]
          TERM.EscapeKey -> [setModifiers mods $ KeyCtrl False False False Esc]
          TERM.PageUpKey -> [setModifiers mods $ KeyCtrl False False False PageUp]
          TERM.PageDownKey -> [setModifiers mods $ KeyCtrl False False False PageDown]
          TERM.EnterKey -> [setModifiers mods $ KeyCtrl False False False Return]
          TERM.FunctionKey n -> [setModifiers mods $ KeyCtrl False False False (Fun n)]
          TERM.BackspaceKey -> [setModifiers mods $ KeyCtrl False False False Backspace]
          TERM.HomeKey -> [setModifiers mods $ KeyCtrl False False False Home]
          TERM.EndKey -> [setModifiers mods $ KeyCtrl False False False End]
          TERM.DeleteKey -> [setModifiers mods $ KeyCtrl False False False Del]
          TERM.TabKey -> [setModifiers mods $ KeyCtrl False False False Tab]
          _ -> []
        _ -> pure []
  where
    setModifiers :: TERM.Modifiers -> KeyEvent -> KeyEvent
    setModifiers modifiers (KeyCtrl _ _ _ c) = KeyCtrl ((modifiers .&. TERM.ctrlKey) /= mempty) ((modifiers .&. TERM.shiftKey) /= mempty) ((modifiers .&. TERM.altKey) /= mempty) c
    setModifiers modifiers (KeyChar _ _ _ c) = KeyChar ((modifiers .&. TERM.ctrlKey) /= mempty) ((modifiers .&. TERM.shiftKey) /= mempty) ((modifiers .&. TERM.altKey) /= mempty) c

readKey :: IO [KeyEvent]
readKey = do
  k <- readKey_ S.stdin
  pure $ strToKeyEvent k

readKey_ :: S.Handle -> IO String
readKey_ h = do
  char <- S.hGetChar h
  readRest [char]
  where
    readRest :: [Char] -> IO [Char]
    readRest t = S.hWaitForInput h 0 >>= \case
      True -> do
        c <- S.hGetChar h
        readRest (c:t)
      False -> pure $ Prelude.reverse t

uiLoop :: forall m event. (Show event, WidgetC m) => TChan event -> (event -> m Bool) -> m ()
uiLoop es cback = do
  void $ iterateWhile id $ do
    event <- liftIO $ atomically $ readTChan es
    r <- cback event
    pure r

cursorStyleCode :: CursorStyle -> Text
cursorStyleCode Bar       = T.pack $ "\ESC[5 q" <> A.showCursorCode
cursorStyleCode Underline = T.pack $ "\ESC[4 q" <> A.showCursorCode
cursorStyleCode Hidden    = T.pack A.hideCursorCode

readWRef :: forall a m. (WidgetC m, Widget a) => WRef a -> m a
readWRef (WRef ref) = do
  (fromMaybe (error "not found") . M.lookup ref . wsWidgets) <$> getWidgetState >>= \case
    SomeWidget w -> case cast w of
      Just a  -> pure a
      Nothing -> error "Unexpected type"

modifyWRef :: (WidgetC m, Widget a) => WRef a -> (a -> a) -> m ()
modifyWRef (WRef ref) fn =
  modifyWidgetState $ \s -> s { wsWidgets = M.update (Just . (modifySomeWidget fn)) ref $ wsWidgets s }

modifyWRefM :: (WidgetC m, Widget a) => WRef a -> (a -> m a) -> m ()
modifyWRefM (WRef ref) fn = do
  m <- wsWidgets <$> getWidgetState
  case M.lookup ref m of
    Just sw -> do
      nSw <- modifySomeWidgetM fn sw
      modifyWidgetState $ \s -> s { wsWidgets = M.update (\_ -> Just nSw) ref $ wsWidgets s }
    Nothing -> pure ()

modifySomeWidget :: Widget a => (a -> a) -> SomeWidget -> SomeWidget
modifySomeWidget fn (SomeWidget w) = case cast w of
  Just a  -> (SomeWidget (fn a))
  Nothing -> error "unexpected type"

modifySomeWidgetM :: (Monad m, Widget a) => (a -> m a) -> SomeWidget -> m SomeWidget
modifySomeWidgetM fn (SomeWidget w) = case cast w of
  Just a  -> do
    n <- fn a
    pure (SomeWidget n)
  Nothing -> error "unexpected type"

-- Insert the new widget at a random key in the Widget state map
-- and return the key.
newWRef :: (WidgetC m, Widget a) => a -> m (WRef a)
newWRef a = do
  ref <- getRandom
  modifyWidgetState $ \s -> s { wsWidgets = M.insert ref (SomeWidget a) $ wsWidgets s }
  pure (WRef ref)

data CtrlKey
  = Del
  | Esc
  | Insert
  | End
  | Home
  | ArrowLeft
  | ArrowRight
  | ArrowUp
  | ArrowDown
  | PageUp
  | PageDown
  | Backspace
  | Fun Int
  | Tab
  | Return
  deriving (Show, Ord, Eq, Generic)

instance NFData CtrlKey

data KeyEvent
  = KeyChar Bool Bool Bool Char -- Bool fields for modifiers for ctrl, shift, alt
  | KeyCtrl Bool Bool Bool CtrlKey
  deriving (Show, Eq, Ord, Generic)

instance NFData KeyEvent

data TerminalEvent
  = TerminalKey KeyEvent
  | TerminalResize Int Int
  | TerminalInterrupt
  deriving Show

pushTerminalEventToHandle :: SIO.Handle -> TerminalEvent -> IO ()
pushTerminalEventToHandle handle' kv = do
  case kv of
    TerminalKey (KeyChar False False False c) -> do
      SIO.hPutChar handle' c
      SIO.hFlush handle'
    TerminalKey (KeyCtrl False False False Del) -> do
      SIO.hPutStr handle' "\ESC[3~"
      SIO.hFlush handle'
    TerminalKey (KeyCtrl False False False Backspace) -> do
      SIO.hPutChar handle' '\DEL'
      SIO.hFlush handle'
    TerminalKey (KeyCtrl False False False Esc) -> do
      SIO.hPutChar handle' '\ESC'
      SIO.hFlush handle'
    TerminalKey (KeyCtrl False False False Return) -> do
      SIO.hPutChar handle' '\n'
      SIO.hFlush handle'
    TerminalKey (KeyCtrl False False False Tab) -> do
      SIO.hPutChar handle' '\t'
      SIO.hFlush handle'
    TerminalKey (KeyCtrl False True False Tab) -> do
      SIO.hPutStr handle' "\ESC[Z"
      SIO.hFlush handle'
    TerminalKey (KeyCtrl False False False ArrowUp) -> do
      SIO.hPutStr handle' "\ESC[1;2A"
      SIO.hFlush handle'
    TerminalKey (KeyCtrl False False False ArrowDown) -> do
      SIO.hPutStr handle' "\ESC[1;2B"
      SIO.hFlush handle'
    TerminalKey (KeyCtrl False False False ArrowLeft) -> do
      SIO.hPutStr handle' "\ESC[D"
      SIO.hFlush handle'
    TerminalKey (KeyCtrl False False False ArrowRight) -> do
      SIO.hPutStr handle' "\ESC[C"
      SIO.hFlush handle'
    _ -> pass

data TerminalException
  = TerminalException Text
  deriving (Show)

instance Exception TerminalException

class HasRandom m where
  getRandom :: Random a => m a

class HasCursor m where
  getCursor :: m CursorInfo

class Layout a where
  addWidget' :: (WidgetC m, Widget child) => WRef a -> StackingOrder -> WRef child -> m ()
  addWidget :: (WidgetC m, Widget child) => WRef a -> WRef child -> m ()
  addWidget ref cref = addWidget' ref 0 cref

  focusNext :: (WidgetC m) => WRef a -> Int -> m Bool

class Focusable a where
  setFocus :: WidgetC m => WRef a -> Bool -> m ()
  getFocus :: WidgetC m => WRef a -> m Bool

class Drawable a where
  draw :: WidgetC m => WRef a -> m ()
  setVisibility :: WidgetC m => WRef a -> Bool -> m ()
  getVisibility :: WidgetC m => WRef a -> m Bool

class Moveable a where
  move ::  WidgetC m => WRef a -> ScreenPos -> m ()
  getPos :: WidgetC m => WRef a -> m ScreenPos
  getDim :: WidgetC m => WRef a -> m Dimensions
  resize :: WidgetC m => WRef a -> (Dimensions -> Dimensions) -> m ()

class Container a c | a -> c where
  setContent :: WidgetC m => WRef a -> c -> m ()
  getContent :: WidgetC m => WRef a -> m c

class Selectable a where
  getSelection :: WidgetC m => WRef a -> m Text

class (Typeable a, Drawable a) => KeyInput a where
  getCursorInfo :: WidgetC m => WRef a -> m (Maybe CursorInfo)
  handleInput :: WidgetC m => WRef a -> KeyEvent -> m ()

data WidgetCapability a (c :: Constraint) where
  FocusableCap :: WRef a -> WidgetCapability a (Focusable a)
  KeyInputCap :: WRef a -> WidgetCapability a (KeyInput a)
  MoveableCap :: WRef a -> WidgetCapability a (Moveable a)
  SelectableCap :: WRef a -> WidgetCapability a (Selectable a)
  DrawableCap :: WRef a -> WidgetCapability a (Drawable a)
  LayoutCap :: WRef a -> WidgetCapability a (Layout a)
  ContainerCap :: Typeable cnt => WRef a -> Proxy cnt -> WidgetCapability a (Container a cnt)

class Typeable a => Widget a where
  hasCapability :: WidgetCapability a c -> Maybe (Dict c)

withCapability :: forall a c m b . (WidgetC m, Widget a, Typeable c) => WidgetCapability a c -> (c => m b)  -> m b
withCapability cap fn = case hasCapability cap of
  Just Dict -> fn
  Nothing   -> error ("No capability:" <> (show $ typeRep (Proxy @c)))

data SomeWidget where
  SomeWidget :: forall a. Widget a => a -> SomeWidget

data SomeWidgetRef where
  SomeWidgetRef :: forall a. (Typeable a, Widget a) => WRef a -> SomeWidgetRef

instance NFData SomeWidgetRef where
  rnf _ = ()

instance Show SomeWidgetRef where
  show _ = "(Widget)"

data SomeKeyInputWidget where
  SomeKeyInputWidget :: KeyInput a => WRef a -> SomeKeyInputWidget

wSetCursor :: (WidgetC m, HasTerminal m) => ScreenPos -> m ()
wSetCursor ScreenPos {..} = csSetCursorPosition sX sY

wSetCursorRel :: (HasTerminal m, WidgetC m) => ScreenPos -> ScreenPos -> m ScreenPos
wSetCursorRel o rel = do
  let n = moveRight (sX rel) $ moveDown (sY rel) o
  wSetCursor n
  pure n

drawTitleLine :: WidgetC m => ScreenPos -> Int -> Int -> Maybe Text -> m ()
drawTitleLine sp width titleOffset (fromMaybe "" -> title) = do
  wSetCursor sp
  let titleLength = T.length title
  csPutText $ StyledText NoStyle [Plain $ C.concat [C.replicate (titleOffset - 1) (C.singleton horizontalLine), C.singleton verticalRight], colorText A.White A.Blue title, Plain (C.singleton verticalLeft <> C.replicate (width - titleLength - titleOffset - 1) (C.singleton horizontalLine)) ]

drawTitleLineVertical :: WidgetC m => ScreenPos -> Int -> Int -> Maybe Text -> m ()
drawTitleLineVertical sp height titleOffset (fromMaybe "" -> title) = do
  wSetCursor sp
  let titleLength = T.length title

  forM_ [0..(titleOffset - 1)] (\r -> do
    wSetCursor $ moveDown r sp
    csPutText $ Plain $ C.concat [C.singleton verticalLine]
    )

  forM_ (Prelude.zip [titleOffset ..] (T.unpack title)) (\(r, c) -> do
    wSetCursor $ moveDown r sp
    csPutText $ colorText A.White A.Blue $ C.singleton c
    )

  forM_ [(titleOffset + titleLength) .. (height - 1)] (\r -> do
    wSetCursor $ moveDown r sp
    csPutText $ Plain $ C.concat [C.singleton verticalLine]
    )

drawBorderBox' :: WidgetC m => ScreenPos -> Dimensions -> (Text -> StyledText) -> m ()
drawBorderBox' sp Dimensions {..} fn =  do
  wSetCursor sp
  csPutText $ fn $ C.concat [C.singleton cornerLT, C.replicate (diW - 2) (C.singleton horizontalLine), C.singleton cornerRT]
  wSetCursor $ moveDown (diH - 1) sp
  csPutText $ fn $ C.concat [C.singleton cornerLB, C.replicate (diW - 2) (C.singleton horizontalLine), C.singleton cornerRB]
  forM_ [1..(diH - 2)] (\r -> do
    wSetCursor $ moveDown r sp
    csPutText $ fn $ C.concat [C.singleton verticalLine]
    wSetCursor $ moveRight (diW - 1) $ moveDown r sp
    csPutText $ fn $ C.concat [C.singleton verticalLine]
    )

drawBorderBox :: WidgetC m => ScreenPos -> Dimensions -> m ()
drawBorderBox sp dim = drawBorderBox' sp dim Plain

type StackingOrder = Int

data StackedWidget = StackedWidget { swSo :: StackingOrder, swSw :: SomeWidgetRef }