Event.hs

module Docs.Event where

import Brick (BrickEvent (..), EventM, ViewportScroll (..), gets, modify)
import Brick.Main (viewportScroll)
import Control.Monad (when)
import Control.Monad.IO.Class (liftIO)
import qualified Data.Map as Map
import qualified Data.Text as T
import Docs.Util
import Editor.File (copyToClipboard)
import qualified Graphics.Vty as V
import UI.Core (AppState (..), Content (..), Doc (..), DocFocus (..), DocMap, Name (..), Window (..))
import Zwirn.Language.Compiler (Environment, compilerInterpreterWithBlock, runCI)

handleDocEvent :: Doc -> DocFocus -> DocMap -> BrickEvent Name e -> EventM Name AppState (Doc, DocFocus)
handleDocEvent d f _ (VtyEvent (V.EvKey (V.KChar '\t') _)) = return (d, moveNext d f)
handleDocEvent d (CodeFocus i) _ (VtyEvent (V.EvKey V.KEnter _)) = evalCodeEvent d i
handleDocEvent d (CodeFocus i) _ (VtyEvent (V.EvKey (V.KChar 'c') [V.MCtrl])) = copyCodeEvent d i >> return (d, CodeFocus i)
handleDocEvent d (LinkFocus i) m (VtyEvent (V.EvKey V.KEnter _)) = gotoLink d i m >>= \x -> vScrollToBeginning (viewportScroll DocViewport) >> return x
handleDocEvent d f _ (MouseDown name V.BScrollUp _ _) = when (isDoc name) (vScrollBy (viewportScroll DocViewport) (-1)) >> return (d, f)
handleDocEvent d f _ (MouseDown name V.BScrollDown _ _) = when (isDoc name) (vScrollBy (viewportScroll DocViewport) 1) >> return (d, f)
handleDocEvent d f _ _ = return (d, f)

isDoc :: Name -> Bool
isDoc Documentation = True
isDoc (DocLink _) = True
isDoc (DocCode _) = True
isDoc DocViewport = True
isDoc _ = False

gotoLink :: Doc -> Int -> DocMap -> EventM Name AppState (Doc, DocFocus)
gotoLink d i m = case getLinkAt d i of
  Nothing -> return (d, LinkFocus i)
  Just dest -> case Map.lookup dest m of
    Just d' -> return (d', moveNext d' NoFocus)
    Nothing -> return (d, LinkFocus i)

gotoStart :: EventM Name AppState ()
gotoStart = modify $ \as -> as {asWindows = Map.alter alt Documentation $ asWindows as}
  where
    alt (Just (Window x y (DocumentationContent _ _ m) a b)) = do
      st <- Map.lookup "welcome.md" m
      Just $ Window x y (DocumentationContent st (moveNext st NoFocus) m) a b
    alt x = x

evalCodeEvent :: Doc -> Int -> EventM Name AppState (Doc, DocFocus)
evalCodeEvent d i = case getCodeAt d i of
  Nothing -> return (d, CodeFocus i)
  Just cont -> do
    env <- gets asEnvironment
    env' <- liftIO $ evalCode cont env
    modify $ \as -> as {asEnvironment = env'}
    return (d, CodeFocus i)

copyCodeEvent :: Doc -> Int -> EventM Name AppState ()
copyCodeEvent d i = case getCodeAt d i of
  Nothing -> return ()
  Just t -> do
    vtyOut <- gets asVtyOutput
    case vtyOut of
      Nothing -> return ()
      Just out -> liftIO (copyToClipboard out t)

evalCode :: T.Text -> Environment -> IO Environment
evalCode cont env = do
  x <- runCI env (compilerInterpreterWithBlock 0 cont)
  case x of
    Left _ -> return env
    Right (_, env', _) -> return env'