{-# 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 <> renderType typ
  Defined ident typ -> ident <> renderType typ
  Bye -> "Bye!"
  other -> pack (show other)

renderType :: Maybe Type.Type -> Text
renderType typ = case typ of
  Nothing -> ""
  Just t -> " : " <> Type.pretty t

instance MonadThrow PureREPL where
  throwM = throw