{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}

module Minilang.REPL.Pure where

import Control.Exception (throw)
import Control.Monad.Catch
import Control.Monad.Catch.Pure (CatchT (..))
import Control.Monad.State
import Data.Text hiding (replicate)
import Minilang.Lambda.Parser (pretty, resugar)
import qualified Minilang.Lambda.Unify as Type
import Minilang.REPL.Types

data PureEnv = PureEnv
  { inputText :: [Text],
    outputText :: [Text],
    pureREPL :: REPLEnv
  }

newtype PureREPL a = PureREPL {runPure :: CatchT (State PureEnv) a}
  deriving (Functor, Applicative, Monad, MonadState PureEnv, MonadCatch)

instance MonadREPL PureREPL where
  input = do
    ins <- gets inputText
    case ins of
      [] -> pure EOF
      (t : ts) -> modify (\e -> e {inputText = ts}) >> pure (interpret t)

  output t = modify $ \e -> e {outputText = render t : outputText e}

  prompt = pure ()

  getEnv = gets pureREPL

  setEnv e' = modify $ \e -> e {pureREPL = e'}

  load f = pure $ Left $ REPLError $ "cannot load file " <> f <> " in Pure interpreter"

render :: Out -> Text
render = \case
  Msg t -> t
  Evaluated ast _term typ -> pretty ast <> " : " <> Type.pretty typ
  Bye -> "Bye!"
  other -> pack (show other)

instance MonadThrow PureREPL where
  throwM = throw