-- | @futhark eval@
module Futhark.CLI.Eval (main) where

import Control.Monad
  ( forM_,
  )
import Data.Map qualified as M
import Data.Text qualified as T
import Futhark.Eval
  ( EvalConfig (..),
    evalConfig,
    evalServerOptions,
    newInterpreterState,
    runExpr,
  )
import Futhark.Util.Options
  ( ArgDescr (NoArg, ReqArg),
    FunOptDescr,
    OptDescr (Option),
    mainWithOptions,
  )
import Futhark.Util.Pretty
  ( hPutDocLn,
    putDocLn,
  )
import System.Exit (ExitCode (ExitFailure), exitWith)
import System.IO (stderr)

-- | Run @futhark eval@.
main :: String -> [String] -> IO ()
main :: String -> [String] -> IO ()
main = EvalConfig
-> [FunOptDescr EvalConfig]
-> String
-> ([String] -> EvalConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
mainWithOptions EvalConfig
evalConfig [FunOptDescr EvalConfig]
options String
"options... <exprs...>" [String] -> EvalConfig -> Maybe (IO ())
run
  where
    run :: [String] -> EvalConfig -> Maybe (IO ())
run [] EvalConfig
_ = Maybe (IO ())
forall a. Maybe a
Nothing
    run [String]
exprs EvalConfig
config = IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ [String] -> EvalConfig -> IO ()
runExprs [String]
exprs EvalConfig
config

runExprs :: [String] -> EvalConfig -> IO ()
runExprs :: [String] -> EvalConfig -> IO ()
runExprs [String]
exprs EvalConfig
cfg = do
  maybe_new_state <- EvalConfig -> VFS -> IO (Either (Doc AnsiStyle) InterpreterState)
forall (m :: * -> *).
(MonadIO m, Evaluation m) =>
EvalConfig -> VFS -> m (Either (Doc AnsiStyle) InterpreterState)
newInterpreterState EvalConfig
cfg VFS
forall k a. Map k a
M.empty
  interpreter_state <- case maybe_new_state of
    Left Doc AnsiStyle
reason -> do
      Handle -> Doc AnsiStyle -> IO ()
hPutDocLn Handle
stderr Doc AnsiStyle
reason
      ExitCode -> IO InterpreterState
forall a. ExitCode -> IO a
exitWith (ExitCode -> IO InterpreterState)
-> ExitCode -> IO InterpreterState
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
2
    Right InterpreterState
s -> InterpreterState -> IO InterpreterState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InterpreterState
s
  forM_ exprs $ \String
expr -> Doc AnsiStyle -> IO ()
putDocLn (Doc AnsiStyle -> IO ()) -> IO (Doc AnsiStyle) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< InterpreterState -> Text -> IO (Doc AnsiStyle)
forall (m :: * -> *).
(Evaluation m, MonadIO m) =>
InterpreterState -> Text -> m (Doc AnsiStyle)
runExpr InterpreterState
interpreter_state (String -> Text
T.pack String
expr)

options :: [FunOptDescr EvalConfig]
options :: [FunOptDescr EvalConfig]
options =
  [ String
-> [String]
-> ArgDescr (Either (IO ()) (EvalConfig -> EvalConfig))
-> String
-> FunOptDescr EvalConfig
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      String
"f"
      [String
"file"]
      ( (String -> Either (IO ()) (EvalConfig -> EvalConfig))
-> String -> ArgDescr (Either (IO ()) (EvalConfig -> EvalConfig))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg
          (\String
entry -> (EvalConfig -> EvalConfig)
-> Either (IO ()) (EvalConfig -> EvalConfig)
forall a b. b -> Either a b
Right ((EvalConfig -> EvalConfig)
 -> Either (IO ()) (EvalConfig -> EvalConfig))
-> (EvalConfig -> EvalConfig)
-> Either (IO ()) (EvalConfig -> EvalConfig)
forall a b. (a -> b) -> a -> b
$ \EvalConfig
config -> EvalConfig
config {evalFile = Just entry})
          String
"NAME"
      )
      String
"The file to load before evaluating expressions.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (EvalConfig -> EvalConfig))
-> String
-> FunOptDescr EvalConfig
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      String
"w"
      [String
"no-warnings"]
      (Either (IO ()) (EvalConfig -> EvalConfig)
-> ArgDescr (Either (IO ()) (EvalConfig -> EvalConfig))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (EvalConfig -> EvalConfig)
 -> ArgDescr (Either (IO ()) (EvalConfig -> EvalConfig)))
-> Either (IO ()) (EvalConfig -> EvalConfig)
-> ArgDescr (Either (IO ()) (EvalConfig -> EvalConfig))
forall a b. (a -> b) -> a -> b
$ (EvalConfig -> EvalConfig)
-> Either (IO ()) (EvalConfig -> EvalConfig)
forall a b. b -> Either a b
Right ((EvalConfig -> EvalConfig)
 -> Either (IO ()) (EvalConfig -> EvalConfig))
-> (EvalConfig -> EvalConfig)
-> Either (IO ()) (EvalConfig -> EvalConfig)
forall a b. (a -> b) -> a -> b
$ \EvalConfig
config -> EvalConfig
config {evalPrintWarnings = False})
      String
"Do not print warnings."
  ]
    [FunOptDescr EvalConfig]
-> [FunOptDescr EvalConfig] -> [FunOptDescr EvalConfig]
forall a. [a] -> [a] -> [a]
++ [FunOptDescr EvalConfig]
evalServerOptions