Eval.hs

{- HLINT ignore "Use tuple-section" -}

module Editor.Eval where

import Brick (EventM, get, modify)
import Brick.BChan (BChan, writeBChan)
import Control.Concurrent (forkIO, threadDelay)
import Control.Monad.RWS (MonadIO (..))
import Data.Functor (void)
import qualified Data.Text as T
import Editor.Core
import Editor.Util (currentLine, getContent)
import Lens.Micro
import UI.Core (AppEvent (..), EditorEventEnv (..), Name, envEditorState, envEnv)
import Zwirn.Language.Compiler (CIError (..), CompilerOutput (..), Environment, compilerInterpreterWithBlock, getBlockStartEnd, runCI)

evalEvent :: EventM Name EditorEventEnv ()
evalEvent = do
  (EditorEventEnv chan _ _ _ env es) <- get
  x <- liftIO $ evalCode es env
  case x of
    Left (CIError err env') -> do
      modify $ \as -> as & envEnv .~ env'
      block <- liftIO $ tryGetBlock es env
      liftIO $ writeBChan chan (UpdateOutput (OutputError, show err))
      liftIO $ clearFlash chan
      modify $
        envEditorState
          %~ (esMessage ?~ show err)
            . (esFlashBlock .~ ((\b -> (OutputError, b)) <$> block))
    Right (OutMessage t, env', block) -> do
      modify $ \as -> as & envEnv .~ env'
      liftIO $ writeBChan chan (UpdateOutput (OutputInfo, T.unpack t))
      liftIO $ clearFlash chan
      liftIO $ writeBChan chan UpdateEnv
      modify $
        envEditorState
          %~ (esMessage ?~ T.unpack t)
            . (esFlashBlock ?~ (OutputInfo, block))
    Right (_, env', block) -> do
      modify $ \as -> as & envEnv .~ env'
      liftIO $ writeBChan chan (UpdateOutput (OutputInfo, "Ok"))
      liftIO $ clearFlash chan
      liftIO $ writeBChan chan UpdateEnv
      modify $
        envEditorState
          %~ (esMessage ?~ "Ok.")
            . (esFlashBlock ?~ (OutputInfo, block))
  where
    clearFlash :: BChan AppEvent -> IO ()
    clearFlash chan = void $ forkIO $ do
      threadDelay 100000
      writeBChan chan ClearFlash

evalCode :: EditorState -> Environment -> IO (Either CIError (CompilerOutput, Environment, (Int, Int)))
evalCode es env = runCI env (compilerInterpreterWithBlock r content)
  where
    content = getContent es
    r = currentLine es

tryGetBlock :: EditorState -> Environment -> IO (Maybe (Int, Int))
tryGetBlock es env = do
  x <- runCI env (getBlockStartEnd r content)
  case x of
    Left _ -> return Nothing
    Right block -> return $ Just block
  where
    content = getContent es
    r = currentLine es