{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC "-fno-warn-orphans" #-}

module Minilang.REPL where

import Control.Monad.Catch.Pure (CatchT (..), SomeException)
import Control.Monad.State
import Data.Text hiding (replicate)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import Minilang.Lambda (loadProgram)
import Minilang.Lambda.Eval (Term, newEnv)
import Minilang.Lambda.Infer (newContext)
import Minilang.Lambda.Parser (parseProgram, pretty, resugar)
import Minilang.Lambda.Unify (Type)
import qualified Minilang.Lambda.Unify as Unify
import Minilang.REPL.Haskeline
import Minilang.REPL.IO
import Minilang.REPL.Pure
import Minilang.REPL.Purer
import Minilang.REPL.Run
import Minilang.REPL.Types
import System.Environment (lookupEnv)
import Text.Read (readMaybe)
import System.Console.Haskeline
  ( defaultBehavior,
    defaultSettings,
    historyFile,
    runInputTBehavior,
    setComplete,
  )
import System.IO (Handle, stderr)

-- | Read the evaluator selection from the @MINILANG_EVAL@ environment variable.
-- Returns 'DeBruijn' when the variable is absent or unrecognised.
evaluatorFromEnv :: IO Evaluator
evaluatorFromEnv =
  lookupEnv "MINILANG_EVAL" >>= \case
    Nothing  -> pure DeBruijn
    Just raw -> case readMaybe raw of
      Just ev -> pure ev
      Nothing -> do
        Text.hPutStrLn stderr $
          "Warning: unknown MINILANG_EVAL value " <> Text.pack (show raw)
          <> ", falling back to DeBruijn"
        pure DeBruijn

-- | Build the initial 'REPLEnv' using the given 'Evaluator'.
replEnvWith :: Evaluator -> REPLEnv
replEnvWith ev = initialREPL { evaluator = ev }

-- * Haskeline REPL

withTerminal :: Evaluator -> IO ()
withTerminal ev =
  runInputTBehavior defaultBehavior settings $
    evalStateT (runHaskeline runREPL) (replEnvWith ev)
  where
    settings = setComplete completion $ defaultSettings {historyFile = Just "~/.minilang.history"}

-- * Other REPLs

-- | Pure IO REPL
-- Used for testing purposes
withHandles ::
  Handle -> Handle -> IO ()
withHandles hin hout =
  evalStateT (runConsole runREPL) (IOEnv hin hout initialREPL)

-- | Simple IO REPL, used to evaluate programs from stdin or file loading
withIO :: Evaluator -> Handle -> Handle -> IO ()
withIO ev hin hout = do
  programText <- parseProgram <$> Text.hGetContents hin
  case programText of
    Left err -> Text.hPutStrLn hout (Text.pack (show err))
    Right prog -> case loadProgram ev Untyped newEnv newContext prog of
      Right (results, _, _) -> mapM_ (Text.hPutStrLn hout . render) results
      Left err -> Text.hPutStrLn hout (Text.pack $ show err)
  where
    render :: (Term, Type) -> Text
    render (term, _typ) = pretty (resugar term) -- TODO: handle types <> " : " <> Unify.pretty typ

-- * Pure REPL

withInput ::
  [Text] -> [Text]
withInput stream =
  outputText $ execState (runCatchT (runPure runREPL)) (PureEnv stream [] initialREPL)

-- * Purer REPL

-- This useful for rehydrating and environment from a sequence of inputs

withInputs ::
  REPLEnv -> [In] -> PurerEnv
withInputs initEnv stream =
  execState (runCatchT (runPurer runREPL)) (PurerEnv stream [] initEnv)

runProgram :: PurerREPL a -> PurerEnv
runProgram prog =
  execState (runCatchT (runPurer prog)) (PurerEnv [] [] initialREPL)