module IDE.IDE where

import Common
import Data.Text.Encoding (decodeUtf8)
import Compiler.Lexer
import Compiler.Parser
import Control.Concurrent
import Control.Concurrent.STM
import Control.Concurrent.STM.TSem
import Control.Exception
import Control.Monad
import Data.IORef
import qualified Data.List as DL
import Data.Map as Map
import Data.Maybe
import qualified Data.Set as S
import Data.Text as T
import Data.Text.IO as T
import System.Process (createPipe)
import qualified System.IO as SIO

import Compiler.AST.Program
import IDE.Common
import IDE.Help
import Interpreter
import Interpreter.Common
import Interpreter.Lib.Misc
import Interpreter.Initialize
import Parser.Parser
import UI.Widgets
import UI.Widgets.AutoComplete
import UI.Widgets.Layout
import UI.Widgets.TextContainer
import UI.Widgets.LogWidget
import UI.Widgets.WatchWidget
import UI.Widgets.TitledContainer
import UI.Widgets.OutputContainer
import DiffRender.DiffRender
import Data.Version (Version(..))
import Paths_spade (version)

data IDEDebugEnv = IDEDebugEnv
  { ideDebugIn :: TBQueue DebugIn
  , ideDebugOut :: TBQueue DebugOut
  , ideDebugThreadInputR :: SIO.Handle
  , ideDebugThreadInputW :: SIO.Handle
  , ideDebugThreadId :: Maybe ThreadId
  }

data IDEState = IDEState
  { idsDebugEnv            :: Maybe IDEDebugEnv
  , idsCodeAutocompletions :: [(Text, Text)]
  , idsCodeParseError      :: Maybe (Location, Text)
  , idsKeyInputReciever    :: Maybe SomeKeyInputWidget
  }

ideStartState :: IDEState
ideStartState = IDEState Nothing [] Nothing Nothing

resetIDEState :: IDEState -> IDEState
resetIDEState ids = ids { idsDebugEnv = Nothing, idsCodeParseError = Nothing, idsKeyInputReciever = Nothing }

type Clipboard = (Text -> IO (), IO (Maybe Text))

type IDEM a = WidgetM IO a

putStrLnFlush :: Text -> IO ()
putStrLnFlush s = do
  T.putStrLn s
  SIO.hFlush stdout

extractBuiltIns :: IO ([(Text, Text)], [(Text, Text)])
extractBuiltIns = do
  sdlWindowsRef <- newIORef []
  scope <- isGlobalScope . snd <$> runStateT loadBuiltIns (emptyIs sdlWindowsRef)
  let keywords = (\x -> let s = toSource $ toEnum @Keyword x in (s, s)) <$> [0 .. fromEnum $ maxBound @Keyword]
  let builtIns = DL.foldl' extractOneDoc [] (Map.assocs scope)
  pure (keywords, builtIns)
  where
    extractOneDoc :: [(Text, Text)] -> (ScopeKey, Value) -> [(Text, Text)]
    extractOneDoc in_ (SkIdentifier (unIdentifer ->ide), BuiltIn (BuiltinVal (ObjectValue m))) =
      in_ <> ((\k -> let a = ide <> "." <> k in (a, a)) <$> Map.keys m)
    extractOneDoc in_ (SkIdentifier ide, BuiltIn (BuiltinCallWithDoc s)) =
      (unIdentifer ide <> "()", T.concat [
        unIdentifer ide,
        "(",
        T.intercalate ", " ((\(l, r) -> T.concat [l, ": ", r]) <$> extractDoc s),
        ")"
        ]
      ) : in_
    extractOneDoc in_ (SkIdentifier ide, BuiltIn (BuiltinCall _)) = (unIdentifer ide, unIdentifer ide) : in_
    extractOneDoc in_ (SkOperator op, _) = (toSource op, toSource op) : in_
    extractOneDoc in_ _ = in_

getAutocompleteSuggestions :: MonadIO m => TVar IDEState -> [(Text, Text)] -> Text -> m [(Text, Text)]
getAutocompleteSuggestions ideStateRef dict key = do
  acs <- liftIO $ idsCodeAutocompletions <$> readTVarIO ideStateRef
  pure $ Prelude.filter fn (acs <> dict)
  where
    fn :: (Text, Text) -> Bool
    fn (i, _) = T.isPrefixOf key i

-- This thread reads the editor contents and try to parse into
-- tokens and ast. And then fills some autocomplete suggestions and
-- makes any parse error location.
codeProcessingThread :: IORef [Token] -> TChan IDEEvent -> MVar Text -> IO ()
codeProcessingThread tokensRef ideEventRef editorContentRef =  forever $ flip catch handler $ do
  liftIO $ atomically $ writeTChan ideEventRef IDEReqEditorContent
  code <- takeMVar editorContentRef
  tokens <- tokenize code
  liftIO $ writeIORef tokensRef tokens
  mError <- parseEither @Program tokens >>= \case
    Left (ParseErrorWithParsed _ loc (FatalError a)) -> pure $ Just (loc, T.pack $ show a)
    Left (ParseErrorWithParsed _ _ (FatalErrorWithLocation loc fpe)) -> pure $ Just (loc, T.pack $ show fpe)
    _ -> pure Nothing
  liftIO $ atomically $ writeTChan ideEventRef $ IDEParseErrorUpdate mError
  liftIO $ atomically $ writeTChan ideEventRef $ IDEACUpdateIdentifiers $ S.toList $ S.fromList $ catMaybes $ filterIdentifiers <$> tokens
  wait 1
  where
    handler :: SomeException -> IO ()
    handler e = liftIO $ atomically $ writeTChan ideEventRef $ IDEAppendLog (T.pack $ show e)

    filterIdentifiers :: Token -> Maybe Text
    filterIdentifiers Token { tkRaw = (TkIdentifier (unIdentifer -> idf))} = Just idf
    filterIdentifiers _ = Nothing

-- | A type to differentiat debuging mode in IDE when input events
-- need to be fed to the interpreted program, and not to the IDE.
data InputRouting
  = RouteIDE
  | RouteProgram SIO.Handle

instance Show InputRouting where
  show RouteIDE         = "Route To IDE"
  show (RouteProgram _) = "Route To Program"

runIDE :: FilePath -> TChan TerminalEvent -> TMVar (TBQueue DebugIn) -> IO ()
runIDE filePath inputChan interpreterDebugInChanRef = do
  content <- try (T.readFile filePath) >>= \case
    Right c                   -> pure c
    Left (_ :: SomeException) -> pure ""
  (keywords, builtIns) <- extractBuiltIns
  ideStateRef <- newTVarIO ideStartState
  ideEventsRef <- newTChanIO
  atomically $ writeTChan ideEventsRef (IDEAppendLog ("Loaded file: " <> (T.pack filePath)))

  clipboardRef <- newIORef @(Maybe Text) Nothing
  let clipboard = (\t -> modifyIORef clipboardRef (\_ -> Just t), readIORef clipboardRef)
  editorContentMVar <- newEmptyMVar @Text

  tokensRef <- newIORef @[Token] []

  void $ forkIO $ codeProcessingThread tokensRef ideEventsRef editorContentMVar

  inputRouteToRef <- newTVarIO RouteIDE

  void $ liftIO $ forkIO $ forever $ do
      kv <- atomically $ readTChan inputChan
      (atomically $ readTVar inputRouteToRef) >>= \case
        RouteIDE          -> atomically $ writeTChan ideEventsRef (IDETerminalEvent kv)
        RouteProgram handle' -> pushTerminalEventToHandle handle' kv

  void $ runWidgetM $ do

    -- The editor
    editorRef <- editor (getAutocompleteSuggestions ideStateRef (keywords <> builtIns)) (Just $ SomeTokenStream (readIORef tokensRef))
    modifyWRef editorRef (\ew' -> ew' { ewParams = (ewParams ew') { epLinenumberRightPad = 1, epBorder = False }})
    setContent editorRef content
    liftIO $ atomically $ modifyTVar ideStateRef (\ids -> ids { idsKeyInputReciever = Just $ SomeKeyInputWidget editorRef })

    -- Output widget
    (programOutputHandleR, programOutputHandleW)  <- liftIO createPipe
    outputWidgetRef <- outputContainer programOutputHandleR
    titledOutputRef <- titledContainer (SomeWidgetRef outputWidgetRef) " OUTPUT "
    modifyWRef titledOutputRef setVertical
    setVisibility titledOutputRef False

    -- Watch widget
    watchWidgetRef <- watchWidget
    titledWatchRef <- titledContainer (SomeWidgetRef watchWidgetRef) " Watch "

    let dimensionDistributionFnMain =
          [ undefined
          , [1]
          , [0.5, 0.5]
          ]

    let dimensionDistributionFn =
          [ undefined
          , [1]
          , [0.85, 0.15]
          , [0.70, 0.15, 0.15]
          , [0.55, 0.15, 0.15, 0.15]
          ]

    logRef <- logWidget
    titledLogRef <- titledContainer (SomeWidgetRef logRef) " Log "

    helpWidgetRef <- helpWidget ((Prelude.head . T.split (== '.'). fst) <$> builtIns) ideEventsRef
    -- The autocomplete widget
    ac <- autoComplete
    modifyWRef editorRef (\ed -> ed { ewAutocompleteWidget = Just $ SomeWidgetRef ac })

    -- The aboutbox widget
    aboutText <- textContainer (ScreenPos 0 0) (Dimensions 58 12)
    let versionString = T.intercalate "." ((T.pack . show) <$> versionBranch version)

    let aboutContent =
          (T.replicate 24 " ") <> "S.P.A.D.E" <> "\n"
          <> (T.replicate 24 " ") <> "=========" <> "\n\n"
          <>  "     A Simple Programming And Debugging Environment" <> "\n"
          <>  "     ______________________________________________" <> "\n\n"
          <>  "                      Version " <> versionString <> "\n\n\n"
          <>  "             Copyright (C) 2022 Sandeep.C.R" <> "\n\n\n"
          <>  "                  Press Esc to close"
    setContent aboutText aboutContent
    aboutBox <- borderBox (ScreenPos 10 16) (Dimensions 60 16) (SomeWidgetRef aboutText)
    setVisibility aboutBox False

    -- The Outermost layout
    layoutRef' <- layoutWidget Horizontal dimensionDistributionFnMain

    layoutRef <- layoutWidget Vertical dimensionDistributionFn
    modifyWRef layoutRef (\lw -> lw { lowFloatingContent = [SomeWidgetRef ac] })
    modifyWRef layoutRef' (\lw -> lw { lowFloatingContent = [SomeWidgetRef aboutBox] })

    addWidget layoutRef editorRef
    addWidget layoutRef helpWidgetRef
    addWidget layoutRef titledWatchRef
    addWidget layoutRef titledLogRef

    addWidget layoutRef' layoutRef
    addWidget layoutRef' titledOutputRef

    setVisibility helpWidgetRef False
    setVisibility titledWatchRef False

    -- The menu
    let menu = Menu
          [ ("File", SubMenu ["Save (F6)", "Beautify", "Exit"])
          , ("Edit", SubMenu ["Cut", "Copy", "Paste", "Select All"])
          , ("Run", SubMenu ["Run (F5)", "Step (F8)", "Stop (F9)"])
          , ("Windows", SubMenu ["Clear log", "Clear Output", "Toggle Output"])
          , ("Help", SubMenu ["About", "Contents"])
          ] Nothing (Just $ T.pack filePath)
    menuContainerRef <- menuContainer (SomeWidgetRef layoutRef') menu (selectionHandler ideEventsRef)

    modify $ liftWSMod (\ws -> ws { wsCursorWidget = Just $ SomeKeyInputWidget editorRef })


    -- A snippet that refresh the screen.
    let
      ideRedraw :: WidgetC m => m ()
      ideRedraw = do
        csClear
        draw menuContainerRef
        csDraw Nothing

    let
      getActiveEditor :: WidgetC m => m (WRef EditorWidget)
      getActiveEditor = do
          (getVisibility editorRef) >>= \case
            True -> pure editorRef
            _ -> getVisibility helpWidgetRef >>= \case
              True -> hwContentWidget <$> (readWRef helpWidgetRef)
              _    -> error "No visible editor"
    let
      launchProgram
        :: forall m. WidgetC m
        => m (Either Text IDEDebugEnv, Maybe TSem)
      launchProgram = do
        source <- getContent editorRef
        (pOutHandle, outputScreenOffset, outputScreenSize, mOutBufLock) <- getVisibility titledOutputRef >>= \case
          True -> do
            screenSize <- getDim outputWidgetRef
            outputPos <- getPos outputWidgetRef
            outBufLock <- liftIO $ atomically $ newTSem 1
            pure (programOutputHandleW, outputPos, screenSize, Just outBufLock)
          False -> do
            clearscreen
            screenSize <- diffRenderToDimension <$> getDiffRender
            pure (SIO.stdout, ScreenPos 0 0, screenSize, Nothing)
        liftIO $ do
          compileEither source >>= \case
            Right p  -> do
              debugIn <- atomically (newTBQueue 10)
              debugOut <- atomically (newTBQueue 10)
              let
                handler :: SomeException -> IO ()
                handler e = do
                  atomically (writeTBQueue debugOut (Errored (T.pack $ show e)))

              (programInputHandleR, programInputHandleW)  <- liftIO createPipe
              let ideDebugEnv = IDEDebugEnv debugIn debugOut programInputHandleR programInputHandleW Nothing
              void $ forkOS $ do

                thisThreadId <- myThreadId

                startMode <- atomically $ do
                  -- Initialize IDE debuggins state
                  dIn <- readTBQueue debugIn
                  check (dIn == Start || dIn == StartStep) -- Wait till the Start command
                  modifyTVar ideStateRef
                    (\idestate ->
                        idestate
                          { idsDebugEnv = Just $ ideDebugEnv { ideDebugThreadId = Just thisThreadId }
                          })
                  pure dIn
                let
                  stateFn = case startMode of
                    StartStep -> (\is -> is
                      { isInputHandle = programInputHandleR
                      , isRunMode = DebugMode $ DebugEnv SingleStep debugIn debugOut
                      , isOutputHandle = pOutHandle
                      , isTerminalParams = Just (outputScreenOffset, outputScreenSize)
                      , isStdoutLock = mOutBufLock
                      })
                    Start -> (\is -> is
                      { isRunMode = DebugMode (DebugEnv Continue debugIn debugOut)
                      , isInputHandle = programInputHandleR
                      , isOutputHandle = pOutHandle
                      , isTerminalParams = Just (outputScreenOffset, outputScreenSize)
                      , isStdoutLock = mOutBufLock
                      })
                    _ -> error "Impossible!"

                flip catch handler (void $ do
                  void $ interpret stateFn p
                  atomically (writeTBQueue debugOut (Finished False))
                  )
                -- Reset IDE debuggins state
                void $ atomically $ do
                  readTBQueue debugIn >>= (check . (== Stop)) -- Wait till the stop command
                  void $ takeTMVar interpreterDebugInChanRef
                  modifyTVar ideStateRef
                    (\idestate ->
                        idestate
                          { idsDebugEnv = Nothing
                          })

              atomically $ putTMVar interpreterDebugInChanRef debugIn
              pure (Right ideDebugEnv, mOutBufLock)
            Left err -> do
              pure (Left (hReadable err), mOutBufLock)

    uiLoop ideEventsRef (\case
      IDEShowAbout ->  do
        mc <- readWRef menuContainerRef
        setVisibility aboutBox True
        adim <- getDim aboutBox
        move aboutBox (ScreenPos ((div (diW $ mcwDim mc) 2) - (div (diW adim) 2)) 20)
        ideRedraw
        pure True
      IDEToggleOutput ->  do
        getVisibility titledOutputRef >>= \case
          True -> setVisibility titledOutputRef False
          False -> setVisibility titledOutputRef True
        ideRedraw
        pure True
      IDEHideAbout ->  do
        setVisibility aboutBox False
        ideRedraw
        pure True
      IDEToggleHelp ->  do
        getVisibility helpWidgetRef >>= \case
          True -> do
            setVisibility helpWidgetRef False
            setVisibility editorRef True
            setVisibility watchWidgetRef True
            modify $ liftWSMod (\ws -> ws { wsCursorWidget = Just $ SomeKeyInputWidget editorRef })
            liftIO $ atomically (modifyTVar ideStateRef (\is -> is { idsKeyInputReciever = Just $ SomeKeyInputWidget editorRef }))
          False -> do
            setVisibility helpWidgetRef True
            setVisibility editorRef False
            setVisibility watchWidgetRef False
            modify $ liftWSMod (\ws -> ws { wsCursorWidget = Just $ SomeKeyInputWidget helpWidgetRef })
            liftIO $ atomically (modifyTVar ideStateRef (\is -> is { idsKeyInputReciever = Just $ SomeKeyInputWidget helpWidgetRef }))
        d <- getScreenBounds
        csInitialize d
        draw menuContainerRef
        csDraw Nothing
        pure True
      IDEStop -> do
        idsDebugEnv <$> (liftIO  $ readTVarIO ideStateRef) >>= \case
          Just ideDebugEnv -> case ideDebugThreadId ideDebugEnv of
            Just threadId -> do
              liftIO $ killThread threadId
              waitTill (\_ -> True) (ideDebugOut ideDebugEnv) >>=
                processDebugOut ideEventsRef ideStateRef logRef editorRef (ideDebugIn ideDebugEnv)
            Nothing ->
              insertLog logRef "No thread running"
          Nothing ->
            insertLog logRef "Interpreter is not running"
        pure True
      IDESave -> do
        c <- getContent editorRef
        liftIO $ T.writeFile filePath c
        insertLog logRef ("Saved to " <> (T.pack filePath) <>".")
        pure True
      IDEEdit Copy -> do
        ew <- getActiveEditor >>= readWRef
        case selectionToTuple <$> (ewSelection ew) of
          Just (r1, r2) -> let
            contents = ewContent ew
            removeLength = (r2 - r1 + 1)
            copyContent = T.take (removeLength + 1) (T.drop r1 contents)
            in liftIO $ (fst clipboard) copyContent
          Nothing -> pass
        pure True
      IDEEdit Cut -> do
        modifyWRefM editorRef (\ew -> case (selectionToTuple <$> ewSelection ew) of
          Just (r1, r2) -> let
            contents = ewContent ew
            (p1, p2) = T.splitAt r1 contents
            removeLength = (r2 - r1 + 1)
            cutContent = T.take removeLength p2
            in do
              liftIO $ (fst clipboard) cutContent
              let newCursor = max 0 (r1 - 1)
              pure $ putCursor Nothing newCursor $ ew { ewSelection = Nothing, ewContent = p1 <> (T.drop removeLength p2) }
          Nothing -> pure ew
          )
        ideRedraw
        pure True
      IDEEdit Paste -> do
        modifyWRefM editorRef (\ew -> do
          let
            contents = ewContent ew
            (p1, p2) = T.splitAt (ewCursor ew) contents
          (liftIO (snd clipboard)) >>= \case
            Nothing -> pure ew
            Just insertContent ->
              pure $ putCursor Nothing (ewCursor ew + T.length insertContent) $ ew { ewContent = p1 <> insertContent <> p2 }
          )
        ideRedraw
        pure True
      IDEEdit SelectAll -> do
        modifyWRef editorRef (\ew -> ew { ewSelection = Just $ SelectionInfo 0 0 ((T.length $ ewContent ew) - 1) })
        ideRedraw
        pure True
      IDEClearLog -> do
        modifyWRef logRef (\lw -> lw { lwContent = [] })
        pure True
      IDEClearOutput -> do
        clearOutput outputWidgetRef
        pure True
      IDEAppendLog msg -> do
        insertLog logRef msg
        pure True
      IDEBeautify -> do
        insertLog logRef "Formatting..."
        code <- getContent editorRef
        (liftIO $ compileEither @Program code) >>= \case
          Right a -> do
            setContent editorRef (T.strip $ toSource a)
            liftIO $ atomically $ writeTChan ideEventsRef IDEClearDraw
          Left (ParseErrorWithParsed _ _ e) -> insertLog logRef ("Parse error:" <> T.pack (show e))
        pure True
      IDEDraw -> do
        pure True
      IDEClearDraw -> do
        d <- getScreenBounds
        csInitialize d
        draw menuContainerRef
        csDraw Nothing
        pure True
      IDEACUpdateIdentifiers acs -> do
        liftIO $ atomically (modifyTVar ideStateRef (\is -> is { idsCodeAutocompletions = (\x -> (x, x)) <$> acs }))
        pure True
      IDEParseErrorUpdate mError -> do
        liftIO $ atomically (modifyTVar ideStateRef (\is -> is { idsCodeParseError = mError }))
        idestate <- liftIO $ readTVarIO ideStateRef
        case idsCodeParseError idestate of
          Just (loc, _) -> modifyWRef editorRef (\ew -> ew { ewParseErrorLocation = Just loc })
          Nothing -> modifyWRef editorRef (\ew -> ew { ewParseErrorLocation = Nothing })
        ideRedraw
        pure True
      IDEReqEditorContent ->  do
        c <- getContent editorRef
        liftIO $ void $ putMVar editorContentMVar c
        pure True
      IDEExit ->  do
        pure False
      IDERun -> do
        idsDebugEnv <$> liftIO (readTVarIO ideStateRef) >>= \case
          -- If we are in a debug session, just run to completion.
          (Just ideDebugEnv) -> do
            insertLog logRef "Continuing debug session to end..."
            liftIO $ atomically $ do
              writeTBQueue (ideDebugIn ideDebugEnv) Run
              writeTVar inputRouteToRef (RouteProgram $ ideDebugThreadInputW ideDebugEnv)
            waitTill (\_ -> True) (ideDebugOut ideDebugEnv) >>=
              processDebugOut ideEventsRef ideStateRef logRef editorRef (ideDebugIn ideDebugEnv)
            liftIO $ atomically $ do
              writeTChan ideEventsRef IDEClearDraw
              writeTVar inputRouteToRef RouteIDE
          _ -> do
            -- Or else launch a new run of the program.
            setCursorPosition 0 0
            launchProgram >>= \case
              (Right ideDebugEnv, mStdoutLock) -> do
                insertLog logRef "Starting..."
                clearOutput outputWidgetRef
                liftIO $ atomically $ do
                  writeTBQueue (ideDebugIn ideDebugEnv) Start
                  writeTVar inputRouteToRef (RouteProgram $ ideDebugThreadInputW ideDebugEnv)

                -- Keep the display updated in another thread
                -- A flag is used to end this display update thread
                -- as the conventional way of using killThread to kill
                -- it appeared to not work sometimes. Probably because the
                -- waitings involved inside it.
                mDisplayThreadExitFlag <- liftIO (newTVarIO False)
                mDisplayUpdateThread <- case mStdoutLock of
                  Nothing -> pure False
                  Just sem -> do
                    ws <- get
                    _ <- (liftIO $ forkIO $ let
                        go = do
                          liftIO $ atomically $ waitTSem sem
                          void $ runWidgetM'' ws ideRedraw
                          liftIO $ atomically $ signalTSem sem
                          wait 0.1
                          liftIO $ readTVarIO mDisplayThreadExitFlag >>= \case
                            True -> pure ()
                            _ -> go
                      in go)
                    pure True

                waitTill (\_ -> True) (ideDebugOut ideDebugEnv) >>=
                  processDebugOut ideEventsRef ideStateRef logRef editorRef (ideDebugIn ideDebugEnv)
                if mDisplayUpdateThread
                  then liftIO $ atomically $ writeTVar mDisplayThreadExitFlag True
                  else pass
                liftIO $ atomically $ do
                  writeTChan ideEventsRef IDEClearDraw
                  writeTVar inputRouteToRef RouteIDE
              (Left err, _) -> do
                insertLog logRef $ "Compile Error: " <> err
                liftIO $ atomically $ writeTChan ideEventsRef IDEClearDraw
        pure True
      IDEStep -> do
        csSetCursorPosition 0 0
        idsDebugEnv <$> liftIO (readTVarIO ideStateRef) >>= \case
          -- A debugging session exists already.
          -- Send the step command, wait for updated state to arrive.
          (Just ideDebugEnv) -> do
            -- Get current interpreter statement location
            (liftIO $ atomically $ tryReadTBQueue (ideDebugOut ideDebugEnv)) >>= \case
              Just debugOut -> do
                processDebugOut ideEventsRef ideStateRef logRef editorRef (ideDebugIn ideDebugEnv) debugOut
              Nothing -> pass
            liftIO $ atomically $ do
              writeTBQueue (ideDebugIn ideDebugEnv) StepIn
              writeTVar inputRouteToRef (RouteProgram $ ideDebugThreadInputW ideDebugEnv)
            -- Wait till the interpreter moves to the next location
            (liftIO $ atomically $ readTBQueue (ideDebugOut ideDebugEnv)) >>=
                processDebugOut ideEventsRef ideStateRef logRef editorRef (ideDebugIn ideDebugEnv)
            liftIO $ atomically $ do
              writeTVar inputRouteToRef RouteIDE

          _ -> do
            -- No debugging session exist. Launch one.
            launchProgram >>= \case
              (Right ideDebugEnv, _) -> do
                liftIO $ atomically $ do
                  writeTBQueue (ideDebugIn ideDebugEnv) StartStep
                  writeTBQueue (ideDebugIn ideDebugEnv) StepIn
                  writeTVar inputRouteToRef (RouteProgram $ ideDebugThreadInputW ideDebugEnv)

                -- Wait till the interpreter moves to the first location
                (liftIO $ atomically $ readTBQueue (ideDebugOut ideDebugEnv)) >>=
                  processDebugOut ideEventsRef ideStateRef logRef editorRef (ideDebugIn ideDebugEnv)

                liftIO $ atomically $ do
                  writeTVar inputRouteToRef RouteIDE

              (Left err, _) -> insertLog logRef $ "Compile Error: " <> err
        pure True
      IDEDebugUpdate mds -> do
        case mds of
          Just ds -> do
            items <- liftIO $ scopeToWatchItems $ dsScope ds
            modifyWRef editorRef (\ew -> putCursor Nothing (lcOffset (dsLocation ds)) $ ew { ewReadOnly = True, ewDebugLocation = Just $ dsLocation ds })
            modifyWRef titledWatchRef (\twr -> setTitle twr $ wrapInSpace ("Watching Thread: " <> dsThreadName ds))
            setVisibility titledWatchRef True
            modifyWRef watchWidgetRef (\ww -> ww { wwVisible = True, wwContent = items  })
            case dsCurrenEvaluation ds of
              Just cv -> insertLog logRef ("Evaluating: " <> cv)
              Nothing -> pass

          Nothing -> do
            modifyWRef titledWatchRef (\twr -> setTitle twr "Watch")
            modifyWRef editorRef (\ew -> ew { ewReadOnly = False, ewDebugLocation = Nothing })
            setVisibility titledWatchRef False
        liftIO $ atomically $ writeTChan ideEventsRef IDEClearDraw
        pure True
      IDETerminalEvent TerminalInterrupt  -> pure False
      IDETerminalEvent (TerminalResize w h)  -> do
        let dim' = Dimensions w h
        csInitialize dim'
        modifyWRef menuContainerRef (\mc -> mc { mcwDim = dim' })
        draw menuContainerRef
        adjustScrollOffset editorRef
        draw menuContainerRef
        csDraw Nothing
        pure True
      IDETerminalEvent (TerminalKey ev)  -> do
        case ev of
          KeyChar True _ _ 'c' -> pure False
          KeyChar True _ _ 'C' -> pure False
          k -> do
            updateMenuOnKey ideEventsRef menuContainerRef k >>= \case
              True -> pure ()
              False -> shortcutsHandler ideEventsRef k >>= \case
                True -> pure ()
                False -> do
                  case k of
                    KeyCtrl _ _ _ Del -> liftIO $ atomically $ writeTChan ideEventsRef (IDEEdit Cut)
                    _ -> pass
                  idsKeyInputReciever <$> (liftIO $ readTVarIO ideStateRef) >>= \case
                    Just (SomeKeyInputWidget w) -> handleInput w k
                    Nothing                     -> pure ()
            idestate <- liftIO $ readTVarIO ideStateRef
            case idsCodeParseError idestate of
              Just (loc, _) -> modifyWRef editorRef (\ew -> ew { ewParseErrorLocation = Just loc })
              Nothing -> modifyWRef editorRef (\ew -> ew { ewParseErrorLocation = Nothing })
            ideRedraw
            pure True
      )
    clearscreen
    setCursorPosition 0 0
    where

      waitTill
        :: MonadIO m
        => (DebugOut -> Bool)
        -> TBQueue DebugOut
        -> m DebugOut
      waitTill pred_ debugOut = do
        (liftIO $ atomically $ readTBQueue debugOut) >>= \case
          a@(pred_ -> True) -> pure a
          _ -> waitTill pred_ debugOut

      processDebugOut
        :: forall m. (HasCallStack, WidgetC m)
        => TChan IDEEvent
        -> TVar IDEState
        -> WRef LogWidget
        -> WRef EditorWidget
        -> TBQueue DebugIn
        -> DebugOut
        -> m ()
      processDebugOut ideEventRef ideStateRef logRef editorRef debugIn dout = do
        case dout of
          -- Update the IDE debug state with the received debug state.
          DebugData ds -> do
            liftIO $ atomically $ writeTChan ideEventRef (IDEDebugUpdate $ Just ds)
          Errored err -> do
            liftIO $ atomically $ modifyTVar ideStateRef (\i -> (resetIDEState i) { idsKeyInputReciever = idsKeyInputReciever i })
            modifyWRef editorRef (\ew -> ew { ewReadOnly = False })
            insertLog logRef err
            liftIO $ atomically $ do
              writeTBQueue debugIn Stop
              writeTChan ideEventRef (IDEDebugUpdate Nothing)
          Finished isUserInterrupt -> do
            modifyWRef editorRef (\ew -> ew { ewReadOnly = False })
            liftIO $ atomically $ modifyTVar ideStateRef (\i -> (resetIDEState i) { idsKeyInputReciever = idsKeyInputReciever i })
            insertLog logRef (if isUserInterrupt then "User Interrupt" else "Finished program")
            liftIO $ atomically $ do
              writeTBQueue debugIn Stop
              writeTChan ideEventRef (IDEDebugUpdate Nothing)

updateMenuOnKey :: WidgetC m => TChan IDEEvent -> WRef MenuContainerWidget -> KeyEvent -> m Bool
updateMenuOnKey ideEventsRef ref kv = do
  w <- readWRef ref
  case (kv, menuActive $ mcwMenu w) of
    (KeyCtrl _ _ _ Esc, Just _) -> do
        modifyWRef ref (\w' -> w' { mcwMenu = (mcwMenu w) { menuActive = Nothing }})
        setCursorVisibility True
        pure True
    (KeyCtrl _ _ _ Esc, _) -> do
        liftIO $ atomically $ writeTChan ideEventsRef IDEHideAbout
        pure False -- Let Esc key bubble
    (KeyChar _ _ True c, _) -> do
      foldM_ (\x (n, _) -> case T.uncons (T.toLower n) of
        Nothing -> pure $ x + 1
        Just (c1, _) ->
          if c == c1
            then do
              modifyWRef ref (\w' -> w' { mcwMenu = (mcwMenu w) { menuActive = Just (x, 0) }})
              setCursorVisibility False
              pure $ x + 1
            else
              pure $ x + 1) 0 (menuItems $ mcwMenu w)
      pure True
    (KeyCtrl _ _ _ ArrowLeft, Just (x, _))
      | x > 0 -> do
          modifyWRef ref (\w' -> w' { mcwMenu = (mcwMenu w) { menuActive = Just (x - 1, 0) }})
          pure True
      | otherwise -> do
          modifyWRef ref (\w' -> w' { mcwMenu = (mcwMenu w) { menuActive = Just (Prelude.length (menuItems $ mcwMenu w) - 1, 0) }})
          pure True

    (KeyCtrl _ _ _ ArrowRight, Just (x, _)) -> do
      let menuItemsLength = Prelude.length $ menuItems $ mcwMenu w
      let newX = x + 1
      if newX < menuItemsLength
        then do
          modifyWRef ref (\w' -> w' { mcwMenu = (mcwMenu w) { menuActive = Just (newX, 0) }})
          pure True
        else do
          modifyWRef ref (\w' -> w' { mcwMenu = (mcwMenu w) { menuActive = Just (0, 0) }})
          pure True

    (KeyCtrl _ _ _ ArrowUp, Just (x, y))
      | y > 0 -> do
              modifyWRef ref (\w' -> w' { mcwMenu = (mcwMenu w) { menuActive = Just (x, y - 1) }})
              pure True
      | otherwise -> do
          case getSubmenuAt (mcwMenu w) x of
            Nothing -> pure True
            Just (SubMenu smi) -> do
              modifyWRef ref (\w' -> w' { mcwMenu = (mcwMenu w) { menuActive = Just (x, Prelude.length smi - 1) }})
              pure True

    (KeyCtrl _ _ _ ArrowDown, Just (x, y)) -> do
      case getSubmenuAt (mcwMenu w) x of
        Just (SubMenu smi) -> do
          let newY = y + 1
          if newY < (Prelude.length smi)
            then do
              modifyWRef ref (\w' -> w' { mcwMenu = (mcwMenu w) { menuActive = Just (x, newY) }})
              pure True
            else do
              modifyWRef ref (\w' -> w' { mcwMenu = (mcwMenu w) { menuActive = Just (x, 0) }})
              pure True
        Nothing -> pure True
    (KeyCtrl _ _ _ Return, Just (x, y)) -> do
      (mcwSelectionHandler w) ref (x, y)
      setCursorVisibility True
      pure True
    _ -> pure False

scopeToWatchItems :: Scope -> IO [(Text, Text)]
scopeToWatchItems s = foldM (\o (k, v) -> do
  let
    vKey = case k of
      SkIdentifier i -> unIdentifer i
      SkOperator op  -> T.pack $ show op
  vText <- case v of
    ErrorValue t                     -> pure $ Just $ "Error: " <> t
    v'                               ->
      catch (fst <$> (runInterpretM dummyIS ((Just . decodeUtf8) <$> serializeJSON v'))) (\case
                          UnserializeableValue -> pure Nothing
                          e -> pure $ Just $ "Error: " <> (T.pack $ show e))

  case vText of
    Just t  -> pure $ (vKey, t) : o
    Nothing -> pure o
  ) [] (Map.assocs s)

selectionHandler
  :: forall m. WidgetC m
  => TChan IDEEvent
  -> WRef MenuContainerWidget
  -> (Int, Int)
  -> m ()
selectionHandler ideEventsRef ref selection = do
  case selection of
    (0, 0) -> liftIO $ atomically $ writeTChan ideEventsRef IDESave
    (0, 1) -> liftIO $ atomically $ writeTChan ideEventsRef IDEBeautify
    (0, 2) -> liftIO $ atomically $ writeTChan ideEventsRef IDEExit
    (1, 0) -> liftIO $ atomically $ writeTChan ideEventsRef (IDEEdit Cut)
    (1, 1) -> liftIO $ atomically $ writeTChan ideEventsRef (IDEEdit Copy)
    (1, 2) -> liftIO $ atomically $ writeTChan ideEventsRef (IDEEdit Paste)
    (1, 3) -> liftIO $ atomically $ writeTChan ideEventsRef (IDEEdit SelectAll)
    (2, 0) -> liftIO $ atomically $ writeTChan ideEventsRef IDERun
    (2, 1) -> liftIO $ atomically $ writeTChan ideEventsRef IDEStep
    (2, 2) -> liftIO $ atomically $ writeTChan ideEventsRef IDEStop
    (3, 0) -> liftIO $ atomically $ writeTChan ideEventsRef IDEClearLog
    (3, 1) -> liftIO $ atomically $ writeTChan ideEventsRef IDEClearOutput
    (3, 2) -> liftIO $ atomically $ writeTChan ideEventsRef IDEToggleOutput
    (4, 0) -> liftIO $ atomically $ writeTChan ideEventsRef IDEShowAbout
    (4, 1) -> liftIO $ atomically $ writeTChan ideEventsRef IDEToggleHelp
    _      -> pass
  modifyWRef ref (\mcw -> mcw { mcwMenu = (mcwMenu mcw) { menuActive = Nothing } })
  liftIO $ atomically $ writeTChan ideEventsRef IDEClearDraw

shortcutsHandler
  :: forall m. WidgetC m
  => TChan IDEEvent
  -> KeyEvent
  -> m Bool
shortcutsHandler ideEventRef kv = do
    case kv of
      KeyCtrl _ _ _ (Fun 6) -> do
        liftIO $ atomically $ writeTChan ideEventRef IDESave
        pure True

      KeyCtrl _ _ _ (Fun 1) -> do
        liftIO $ atomically $ writeTChan ideEventRef IDEToggleHelp
        pure True

      KeyCtrl _ _ _ (Fun 9) -> do
        liftIO $ atomically $ writeTChan ideEventRef IDEStop
        pure True

      KeyCtrl _ _ _ (Fun 8) -> do
        liftIO $ atomically $ writeTChan ideEventRef IDEStep
        pure True

      KeyCtrl _ _ _ (Fun 5) -> do
        liftIO $ atomically $ writeTChan ideEventRef IDERun
        pure True
      _               -> pure False