{-# 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.Console.Haskeline
  ( defaultBehavior,
    defaultSettings,
    historyFile,
    runInputTBehavior,
    setComplete,
  )
import System.IO (Handle)

-- * Haskeline REPL

withTerminal :: IO ()
withTerminal =
  runInputTBehavior defaultBehavior settings $ evalStateT (runHaskeline runREPL) initialREPL
  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 :: Handle -> Handle -> IO ()
withIO hin hout = do
  input <- parseProgram <$> Text.hGetContents hin
  case input of
    Left err -> Text.hPutStrLn hout (Text.pack (show err))
    Right inputs -> case loadProgram Untyped newEnv newContext inputs 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) <> " : " <> 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)