{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Minilang.REPL.Run where

import Control.Monad.Catch
import Data.Text hiding (replicate)
import qualified Data.Text as Text
import Debug.Trace (trace)
import Minilang.Lambda (loadProgram)
import Minilang.Lambda.DeBruijn (eval, fromDeBruijn, toDeBruijn)
import Minilang.Lambda.Eval (newEnv)
import Minilang.Lambda.Infer (infer, newContext)
import qualified Minilang.Lambda.Infer as Infer
import Minilang.Lambda.Parser (desugar, parse)
import Minilang.Lambda.Unify (Type (TyVar))
import Minilang.REPL.Types

-- | Run a REPL session
runREPL ::
  (MonadCatch m, MonadREPL m) => m ()
runREPL = go
  where
    go = do
      prompt
      raw <- input
      case raw of
        EOF -> output Bye
        In txt -> handleUserInput txt >> go
        Com cmd -> handleCommand cmd >> go

handleUserInput ::
  (MonadCatch m, MonadREPL m) =>
  Text ->
  m ()
handleUserInput txt = do
  REPLEnv {language} <- getEnv
  case parse txt of
    Left err -> output (Msg $ pack $ show err)
    Right expr -> do
      let term = desugar expr
          v = fromDeBruijn $ eval (toDeBruijn term)
      case language of
        Typed ->
          case infer term of
            Left typeError -> output (Msg $ Infer.render typeError)
            Right typ -> do
              let
              output (Evaluated v typ)
        Untyped ->
          output (Evaluated v (TyVar "<?>"))

handleCommand ::
  (MonadCatch m, MonadREPL m) =>
  Command ->
  m ()
handleCommand ClearEnv = getEnv >>= \e -> setEnv (e {env = newEnv, context = newContext})
handleCommand DumpEnv =
  getEnv >>= \REPLEnv {..} ->
    output (CurrentEnv env context)
handleCommand (Load (File file)) = do
  t <- load file
  case t of
    Left err -> output (Msg $ pack $ show err)
    Right prog -> loadProgramInEnv prog
handleCommand (Load (Data prog)) = loadProgramInEnv prog
handleCommand (Set (StepTypeChecker st)) = getEnv >>= \e -> setEnv (e {stepTypeCheck = st})
handleCommand (Set (DebugParser st)) = getEnv >>= \e -> setEnv (e {debugParser = st})
handleCommand (Set (SelectLanguage lang)) = getEnv >>= \e -> setEnv (e {language = lang})
handleCommand Help =
  output (Msg helpText)

loadProgramInEnv ::
  (MonadCatch m, MonadREPL m) =>
  Text ->
  m ()
loadProgramInEnv prog = do
  repl@REPLEnv {env, context} <- getEnv
  case parse prog of
    Left err -> output (Msg $ pack $ show err)
    Right e -> do
      case loadProgram e env context of
        Left typeError -> output (Msg $ pack $ show typeError)
        Right (term, typ, env', context') -> do
          setEnv (repl {env = env', context = context'})
          output (Evaluated term typ)
  where
    makeMessage =
      "Loaded \""
        <> ( if Text.length prog > 15
               then Text.take 15 prog <> "..."
               else prog
           )
        <> "\""