content: {-# LANGUAGE DoAndIfThenElse #-}
  {-# LANGUAGE GADTs #-}
  
  module Command.REPL (command) where
  
  import Prelude
  import Control.Applicative (many, (<|>))
  import Control.Monad (unless, when)
  import Control.Monad.Catch (MonadMask)
  import Control.Monad.IO.Class (liftIO, MonadIO)
  import Control.Monad.Trans.Class (MonadTrans(..))
  import Control.Monad.Trans.Except (ExceptT(..), runExceptT)
  import Control.Monad.Trans.State.Strict (StateT, evalStateT)
  import Control.Monad.Trans.Reader (ReaderT, runReaderT)
  import Data.Foldable (for_)
  import Language.PureScript qualified as P
  import Language.PureScript.CST qualified as CST
  import Language.PureScript.Glob (PSCGlobs(..), toInputGlobs, warnFileTypeNotFound)
  import Language.PureScript.Interactive
  import Options.Applicative qualified as Opts
  import SharedCLI qualified
  import System.Console.Haskeline (InputT, Settings(..), defaultSettings, getInputLine, handleInterrupt, outputStrLn, runInputT, setComplete, withInterrupt)
  import System.IO.UTF8 (readUTF8File)
  import System.Exit (ExitCode(..), exitFailure)
  import System.Directory (doesFileExist, getCurrentDirectory)
  import System.FilePath ((</>))
  import System.IO (hPutStrLn, stderr)
  
  -- | Command line options
  data PSCiOptions = PSCiOptions
    { psciInputGlob         :: [String]
    , psciInputFromFile     :: Maybe String
    , psciExclude           :: [String]
    , psciBackend           :: Backend
    }
  
  nodePathOption :: Opts.Parser (Maybe FilePath)
  nodePathOption = Opts.optional . Opts.strOption $
       Opts.metavar "FILE"
    <> Opts.long "node-path"
    <> Opts.help "Path to the Node executable"
  
  nodeFlagsOption :: Opts.Parser [String]
  nodeFlagsOption = Opts.option parser $
       Opts.long "node-opts"
    <> Opts.metavar "OPTS"
    <> Opts.value []
    <> Opts.help "Flags to pass to node, separated by spaces"
    where
      parser = words <$> Opts.str
  
  port :: Opts.Parser Int
  port = Opts.option Opts.auto $
       Opts.long "port"
    <> Opts.short 'p'
    <> Opts.help "The browser REPL backend was removed in v0.15.0. Use https://try.purescript.org instead."
  
  backend :: Opts.Parser Backend
  backend =
    (browserBackend <$> port)
    <|> (nodeBackend <$> nodePathOption <*> nodeFlagsOption)
  
  psciOptions :: Opts.Parser PSCiOptions
  psciOptions = PSCiOptions <$> many SharedCLI.inputFile
                            <*> SharedCLI.globInputFile
                            <*> many SharedCLI.excludeFiles
                            <*> backend
  
  -- | Parses the input and returns either a command, or an error as a 'String'.
  getCommand :: forall m. (MonadIO m, MonadMask m) => InputT m (Either String [Command])
  getCommand = handleInterrupt (return (Right [])) $ do
    line <- withInterrupt $ getInputLine "> "
    case line of
      Nothing -> return (Right [QuitPSCi]) -- Ctrl-D when input is empty
      Just "" -> return (Right [])
      Just s  -> return (parseCommand s)
  
  pasteMode :: forall m. (MonadIO m, MonadMask m) => InputT m (Either String [Command])
  pasteMode =
      parseCommand <$> go []
    where
      go :: [String] -> InputT m String
      go ls = maybe (return . unlines $ reverse ls) (go . (:ls)) =<< getInputLine "… "
  
  -- | All of the functions required to implement a PSCi backend
  data Backend = forall state. Backend
    { _backendSetup :: IO state
    -- ^ Initialize, and call the continuation when the backend is ready
    , _backendEval :: state -> String -> IO ()
    -- ^ Evaluate JavaScript code
    , _backendReload :: state -> IO ()
    -- ^ Reload the compiled code
    , _backendShutdown :: state -> IO ()
    -- ^ Shut down the backend
    }
  
  browserBackend :: Int -> Backend
  browserBackend _ = Backend setup mempty mempty mempty
    where
      setup :: IO ()
      setup = do
        hPutStrLn stderr "The browser REPL backend was removed in v0.15.0. Use TryPureScript instead: https://try.purescript.org"
        exitFailure
  
  nodeBackend :: Maybe FilePath -> [String] -> Backend
  nodeBackend nodePath nodeArgs = Backend setup eval reload shutdown
    where
      setup :: IO ()
      setup = return ()
  
      eval :: () -> String -> IO ()
      eval _ _ = do
        writeFile indexFile "import('./$PSCI/index.js').then(({ $main }) => $main());"
        result <- readNodeProcessWithExitCode nodePath (nodeArgs ++ [indexFile]) ""
        case result of
          Right (ExitSuccess, out, _)   -> putStrLn out
          Right (ExitFailure _, _, err) -> putStrLn err
          Left err                      -> putStrLn err
  
      reload :: () -> IO ()
      reload _ = return ()
  
      shutdown :: () -> IO ()
      shutdown _ = return ()
  
  options :: Opts.Parser PSCiOptions
  options = Opts.helper <*> psciOptions
  
  -- | Get command line options and drop into the REPL
  command :: Opts.Parser (IO ())
  command = loop <$> options
    where
      loop :: PSCiOptions -> IO ()
      loop PSCiOptions{..} = do
          inputFiles <- toInputGlobs $ PSCGlobs
            { pscInputGlobs = psciInputGlob
            , pscInputGlobsFromFile = psciInputFromFile
            , pscExcludeGlobs = psciExclude
            , pscWarnFileTypeNotFound = warnFileTypeNotFound "repl"
            }
          e <- runExceptT $ do
            modules <- ExceptT (loadAllModules inputFiles)
            when (null modules) . liftIO $ do
              putStr noInputMessage
              exitFailure
            unless (supportModuleIsDefined (map (P.getModuleName . snd) modules)) . liftIO $ do
              putStr supportModuleMessage
              exitFailure
            (externs, _) <- ExceptT . runMake . make $ fmap CST.pureResult <$> modules
            return (modules, externs)
          case psciBackend of
            Backend setup eval reload (shutdown :: state -> IO ()) ->
              case e of
                Left errs -> do
                  pwd <- getCurrentDirectory
                  putStrLn (P.prettyPrintMultipleErrors P.defaultPPEOptions {P.ppeRelativeDirectory = pwd} errs) >> exitFailure
                Right (modules, externs) -> do
                  historyFilename <- getHistoryFilename
                  let settings = defaultSettings { historyFile = Just historyFilename }
                      initialState = updateLoadedExterns (const (zip (map snd modules) externs)) initialPSCiState
                      config = PSCiConfig psciInputGlob
                      runner = flip runReaderT config
                               . flip evalStateT initialState
                               . runInputT (setComplete completion settings)
  
                      handleCommand' :: state -> Command -> StateT PSCiState (ReaderT PSCiConfig IO) ()
                      handleCommand' state = handleCommand (liftIO . eval state) (liftIO (reload state)) (liftIO . putStrLn)
  
                      go :: state -> InputT (StateT PSCiState (ReaderT PSCiConfig IO)) ()
                      go state = do
                        c <- getCommand
                        case c of
                          Left err -> outputStrLn err >> go state
                          Right xs -> goExec xs
                        where
                        goExec :: [Command] -> InputT (StateT PSCiState (ReaderT PSCiConfig IO)) ()
                        goExec xs = case xs of
                          [] -> go state
                          (PasteLines : rest) -> do
                            c' <- pasteMode
                            case c' of
                              Left err -> outputStrLn err >> goExec rest
                              Right c'' -> handleCommandWithInterrupts state c'' >> goExec rest
                          (QuitPSCi : _) -> do
                            outputStrLn quitMessage
                            liftIO $ shutdown state
                          (c' : rest) -> handleCommandWithInterrupts state [c'] >> goExec rest
  
                      loadUserConfig :: state -> StateT PSCiState (ReaderT PSCiConfig IO) ()
                      loadUserConfig state = do
                        configFile <- (</> ".purs-repl") <$> liftIO getCurrentDirectory
                        exists <- liftIO $ doesFileExist configFile
                        when exists $ do
                          cf <- liftIO (readUTF8File configFile)
                          case parseDotFile configFile cf of
                            Left err -> liftIO (putStrLn err >> exitFailure)
                            Right cmds -> liftIO (putStrLn cf) >> for_ cmds (handleCommand' state)
  
                      handleCommandWithInterrupts
                        :: state
                        -> [Command]
                        -> InputT (StateT PSCiState (ReaderT PSCiConfig IO)) ()
                      handleCommandWithInterrupts state cmds = do
                        handleInterrupt (outputStrLn "Interrupted.")
                                        (withInterrupt (lift (for_ cmds (handleCommand' state))))
  
                  putStrLn prologueMessage
                  backendState <- setup
                  runner (lift (loadUserConfig backendState) >> go backendState)
  