module Futhark.CLI.Script (main) where

import Control.Monad.Except
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Futhark.CLI.Literate
  ( Options (..),
    initialOptions,
    prepareServer,
    scriptCommandLineOptions,
  )
import Futhark.Script
import Futhark.Util.Options
import Futhark.Util.Pretty (prettyText)
import System.Exit
import System.IO

commandLineOptions :: [FunOptDescr Options]
commandLineOptions :: [FunOptDescr Options]
commandLineOptions =
  [FunOptDescr Options]
scriptCommandLineOptions
    [FunOptDescr Options]
-> [FunOptDescr Options] -> [FunOptDescr Options]
forall a. [a] -> [a] -> [a]
++ [ String
-> [String]
-> ArgDescr (Either (IO ()) (Options -> Options))
-> String
-> FunOptDescr Options
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
           String
"D"
           [String
"debug"]
           ( Either (IO ()) (Options -> Options)
-> ArgDescr (Either (IO ()) (Options -> Options))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Options -> Options)
 -> ArgDescr (Either (IO ()) (Options -> Options)))
-> Either (IO ()) (Options -> Options)
-> ArgDescr (Either (IO ()) (Options -> Options))
forall a b. (a -> b) -> a -> b
$ (Options -> Options) -> Either (IO ()) (Options -> Options)
forall a b. b -> Either a b
Right ((Options -> Options) -> Either (IO ()) (Options -> Options))
-> (Options -> Options) -> Either (IO ()) (Options -> Options)
forall a b. (a -> b) -> a -> b
$ \Options
config ->
               Options
config
                 { scriptExtraOptions :: [String]
scriptExtraOptions = String
"-D" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Options -> [String]
scriptExtraOptions Options
config,
                   scriptVerbose :: Int
scriptVerbose = Options -> Int
scriptVerbose Options
config Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                 }
           )
           String
"Enable debugging.",
         String
-> [String]
-> ArgDescr (Either (IO ()) (Options -> Options))
-> String
-> FunOptDescr Options
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
           String
"L"
           [String
"log"]
           ( Either (IO ()) (Options -> Options)
-> ArgDescr (Either (IO ()) (Options -> Options))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Options -> Options)
 -> ArgDescr (Either (IO ()) (Options -> Options)))
-> Either (IO ()) (Options -> Options)
-> ArgDescr (Either (IO ()) (Options -> Options))
forall a b. (a -> b) -> a -> b
$ (Options -> Options) -> Either (IO ()) (Options -> Options)
forall a b. b -> Either a b
Right ((Options -> Options) -> Either (IO ()) (Options -> Options))
-> (Options -> Options) -> Either (IO ()) (Options -> Options)
forall a b. (a -> b) -> a -> b
$ \Options
config ->
               Options
config
                 { scriptExtraOptions :: [String]
scriptExtraOptions = String
"-L" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Options -> [String]
scriptExtraOptions Options
config,
                   scriptVerbose :: Int
scriptVerbose = Options -> Int
scriptVerbose Options
config Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                 }
           )
           String
"Enable logging."
       ]

-- | Run @futhark script@.
main :: String -> [String] -> IO ()
main :: String -> [String] -> IO ()
main = Options
-> [FunOptDescr Options]
-> String
-> ([String] -> Options -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
mainWithOptions Options
initialOptions [FunOptDescr Options]
commandLineOptions String
"program script" (([String] -> Options -> Maybe (IO ()))
 -> String -> [String] -> IO ())
-> ([String] -> Options -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[String]
args Options
opts ->
  case [String]
args of
    [String
prog, String
script] -> IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ do
      Exp
script' <- case String -> Text -> Either Text Exp
parseExpFromText String
"command line argument" (Text -> Either Text Exp) -> Text -> Either Text Exp
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
script of
        Left Text
e -> do
          Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr Text
e
          IO Exp
forall a. IO a
exitFailure
        Right Exp
x -> Exp -> IO Exp
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
x
      String -> Options -> (ScriptServer -> IO ()) -> IO ()
forall a. String -> Options -> (ScriptServer -> IO a) -> IO a
prepareServer String
prog Options
opts ((ScriptServer -> IO ()) -> IO ())
-> (ScriptServer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ScriptServer
s -> do
        Either Text CompoundValue
r <-
          ExceptT Text IO CompoundValue -> IO (Either Text CompoundValue)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Text IO CompoundValue -> IO (Either Text CompoundValue))
-> ExceptT Text IO CompoundValue -> IO (Either Text CompoundValue)
forall a b. (a -> b) -> a -> b
$ ScriptServer -> ExpValue -> ExceptT Text IO CompoundValue
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
ScriptServer -> ExpValue -> m CompoundValue
getExpValue ScriptServer
s (ExpValue -> ExceptT Text IO CompoundValue)
-> ExceptT Text IO ExpValue -> ExceptT Text IO CompoundValue
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< EvalBuiltin (ExceptT Text IO)
-> ScriptServer -> Exp -> ExceptT Text IO ExpValue
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
EvalBuiltin m -> ScriptServer -> Exp -> m ExpValue
evalExp (String -> EvalBuiltin (ExceptT Text IO)
forall (m :: * -> *).
(MonadIO m, MonadError Text m) =>
String -> EvalBuiltin m
scriptBuiltin String
".") ScriptServer
s Exp
script'
        case Either Text CompoundValue
r of
          Left Text
e -> do
            Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr Text
e
            IO ()
forall a. IO a
exitFailure
          Right CompoundValue
v ->
            Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ CompoundValue -> Text
forall a. Pretty a => a -> Text
prettyText CompoundValue
v
    [String]
_ -> Maybe (IO ())
forall a. Maybe a
Nothing