Popup.hs

module Editor.Popup where

import Brick (Viewport (..), get, modify)
import Brick.Main (lookupViewport)
import Brick.Types (EventM)
import Control.Monad.RWS (MonadIO (..))
import qualified Data.Text as T
import Editor.Core
import Editor.Diagnostic
import Editor.Util
import Lens.Micro
import UI.Core (EditorEventEnv (..), Name (..), envEditorState)
import Zwirn.Language.Compiler (CIError, Environment, runCI)
import Zwirn.Language.LSP.Hover (parseAndGetInfoAt)
import Zwirn.Language.Location (Position (..), RealSrcLoc (..))

hintEvent :: EventM Name EditorEventEnv ()
hintEvent = do
  let fromName (Editor i) = EditorViewport i
      fromName x = x
  (EditorEventEnv _ name _ _ env es) <- get
  off <- maybe (0, 0) (\(VP l r _ _) -> (l, r)) <$> lookupViewport (fromName name)
  es' <- liftIO $ getPopup es env off
  modify $ envEditorState .~ es'
  return ()

getPopupInfo :: EditorState -> Environment -> IO (Either CIError (Maybe (T.Text, RealSrcLoc)))
getPopupInfo es env = runCI env (parseAndGetInfoAt False content (Position r (c + 1)))
  where
    content = getContent es
    (r, c) = currentCursor es

getPopup :: EditorState -> Environment -> (Int, Int) -> IO EditorState
getPopup es env (left, ro) = do
  res <- getPopupInfo es env
  ds <- getDiagnostics es env

  let cursor = currentCursor es
      mdiag = getAnyDiagnostic cursor $ rowDiagnostics (fst $ currentCursor es) ds
      mpopup = case mdiag of
        Just (Diagnostic (pos, _) diag) -> Just (diag, pos)
        Nothing -> case res of
          Right (Just (info, pos)) -> Just (T.unpack info, (rStartLine pos, rStartChar pos))
          _ -> Nothing

  case mpopup of
    (Just (cont, pos)) -> return $ es & esPopup ?~ Popup cont (screenCol, popupRow) -- {esPopup = Just $ Popup cont (screenCol, popupRow)}
      where
        infoWidth = length $ lines cont
        -- visRow = esScrollRow es
        screenCol = snd pos + lineNumberWidth es - left
        row = fst pos - ro
        popupRow = if row - (infoWidth + 2) < 0 then row + 1 else row - (infoWidth + 2)
    _ -> return $ clearPopup es