-- | The main function for the @futhark@ command line program.
module Futhark.CLI.Main (main) where

import Control.Exception
import Data.List (sortOn)
import Data.Maybe
import Data.Text.IO qualified as T
import Futhark.CLI.Autotune qualified as Autotune
import Futhark.CLI.Bench qualified as Bench
import Futhark.CLI.Benchcmp qualified as Benchcmp
import Futhark.CLI.C qualified as C
import Futhark.CLI.CUDA qualified as CCUDA
import Futhark.CLI.Check qualified as Check
import Futhark.CLI.Datacmp qualified as Datacmp
import Futhark.CLI.Dataset qualified as Dataset
import Futhark.CLI.Defs qualified as Defs
import Futhark.CLI.Dev qualified as Dev
import Futhark.CLI.Doc qualified as Doc
import Futhark.CLI.Eval qualified as Eval
import Futhark.CLI.HIP qualified as HIP
import Futhark.CLI.LSP qualified as LSP
import Futhark.CLI.Literate qualified as Literate
import Futhark.CLI.Misc qualified as Misc
import Futhark.CLI.Multicore qualified as Multicore
import Futhark.CLI.MulticoreISPC qualified as MulticoreISPC
import Futhark.CLI.MulticoreWASM qualified as MulticoreWASM
import Futhark.CLI.OpenCL qualified as OpenCL
import Futhark.CLI.Pkg qualified as Pkg
import Futhark.CLI.Profile qualified as Profile
import Futhark.CLI.PyOpenCL qualified as PyOpenCL
import Futhark.CLI.Python qualified as Python
import Futhark.CLI.Query qualified as Query
import Futhark.CLI.REPL qualified as REPL
import Futhark.CLI.Run qualified as Run
import Futhark.CLI.Test qualified as Test
import Futhark.CLI.WASM qualified as WASM
import Futhark.Error
import Futhark.Util (maxinum, showText)
import Futhark.Util.Options
import GHC.IO.Encoding (setLocaleEncoding)
import GHC.IO.Exception (IOErrorType (..), IOException (..))
import System.Environment
import System.Exit
import System.IO
import Prelude

type Command = String -> [String] -> IO ()

commands :: [(String, (Command, String))]
commands :: [(String, (Command, String))]
commands =
  ((String, (Command, String)) -> String)
-> [(String, (Command, String))] -> [(String, (Command, String))]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn
    (String, (Command, String)) -> String
forall a b. (a, b) -> a
fst
    [ (String
"dev", (Command
Dev.main, String
"Run compiler passes directly.")),
      (String
"eval", (Command
Eval.main, String
"Evaluate Futhark expressions passed in as arguments")),
      (String
"repl", (Command
REPL.main, String
"Run interactive Read-Eval-Print-Loop.")),
      (String
"run", (Command
Run.main, String
"Run a program through the (slow!) interpreter.")),
      (String
"c", (Command
C.main, String
"Compile to sequential C.")),
      (String
"opencl", (Command
OpenCL.main, String
"Compile to C calling OpenCL.")),
      (String
"cuda", (Command
CCUDA.main, String
"Compile to C calling CUDA.")),
      (String
"hip", (Command
HIP.main, String
"Compile to C calling HIP.")),
      (String
"multicore", (Command
Multicore.main, String
"Compile to multicore C.")),
      (String
"python", (Command
Python.main, String
"Compile to sequential Python.")),
      (String
"pyopencl", (Command
PyOpenCL.main, String
"Compile to Python calling PyOpenCL.")),
      (String
"wasm", (Command
WASM.main, String
"Compile to WASM with sequential C")),
      (String
"wasm-multicore", (Command
MulticoreWASM.main, String
"Compile to WASM with multicore C")),
      (String
"ispc", (Command
MulticoreISPC.main, String
"Compile to multicore ISPC")),
      (String
"test", (Command
Test.main, String
"Test Futhark programs.")),
      (String
"bench", (Command
Bench.main, String
"Benchmark Futhark programs.")),
      (String
"dataset", (Command
Dataset.main, String
"Generate random test data.")),
      (String
"datacmp", (Command
Datacmp.main, String
"Compare Futhark data files for equality.")),
      (String
"dataget", (Command
Misc.mainDataget, String
"Extract test data.")),
      (String
"doc", (Command
Doc.main, String
"Generate documentation for Futhark code.")),
      (String
"pkg", (Command
Pkg.main, String
"Manage local packages.")),
      (String
"check", (Command
Check.main, String
"Type-check a program.")),
      (String
"check-syntax", (Command
Misc.mainCheckSyntax, String
"Syntax-check a program.")),
      (String
"imports", (Command
Misc.mainImports, String
"Print all non-builtin imported Futhark files.")),
      (String
"hash", (Command
Misc.mainHash, String
"Print hash of program AST.")),
      (String
"autotune", (Command
Autotune.main, String
"Autotune threshold parameters.")),
      (String
"defs", (Command
Defs.main, String
"Show location and name of all definitions.")),
      (String
"query", (Command
Query.main, String
"Query semantic information about program.")),
      (String
"literate", (Command
Literate.main, String
"Process a literate Futhark program.")),
      (String
"lsp", (Command
LSP.main, String
"Run LSP server.")),
      (String
"thanks", (Command
Misc.mainThanks, String
"Express gratitude.")),
      (String
"tokens", (Command
Misc.mainTokens, String
"Print tokens from Futhark file.")),
      (String
"benchcmp", (Command
Benchcmp.main, String
"Compare two benchmark results.")),
      (String
"profile", (Command
Profile.main, String
"Analyse profiling data."))
    ]

msg :: String
msg :: String
msg =
  [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
    [String
"<command> options...", String
"Commands:", String
""]
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"   " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
cmd String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
cmd) Char
' ' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
desc
           | (String
cmd, (Command
_, String
desc)) <- [(String, (Command, String))]
commands
         ]
  where
    k :: Int
k = [Int] -> Int
forall a (f :: * -> *). (Num a, Ord a, Foldable f) => f a -> a
maxinum (((String, (Command, String)) -> Int)
-> [(String, (Command, String))] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int)
-> ((String, (Command, String)) -> String)
-> (String, (Command, String))
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, (Command, String)) -> String
forall a b. (a, b) -> a
fst) [(String, (Command, String))]
commands) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3

-- | Catch all IO exceptions and print a better error message if they
-- happen.
reportingIOErrors :: IO () -> IO ()
reportingIOErrors :: IO () -> IO ()
reportingIOErrors =
  (IO () -> [Handler ()] -> IO ()) -> [Handler ()] -> IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip
    IO () -> [Handler ()] -> IO ()
forall a. IO a -> [Handler a] -> IO a
catches
    [ (ExitCode -> IO ()) -> Handler ()
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ExitCode -> IO ()
onExit,
      (InternalError -> IO ()) -> Handler ()
forall a e. Exception e => (e -> IO a) -> Handler a
Handler InternalError -> IO ()
onICE,
      (IOException -> IO ()) -> Handler ()
forall a e. Exception e => (e -> IO a) -> Handler a
Handler IOException -> IO ()
onIOException,
      (SomeException -> IO ()) -> Handler ()
forall a e. Exception e => (e -> IO a) -> Handler a
Handler SomeException -> IO ()
onError
    ]
  where
    onExit :: ExitCode -> IO ()
    onExit :: ExitCode -> IO ()
onExit = ExitCode -> IO ()
forall e a. Exception e => e -> IO a
throwIO

    onICE :: InternalError -> IO ()
    onICE :: InternalError -> IO ()
onICE (Error ErrorClass
CompilerLimitation Text
s) = do
      Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr Text
"Known compiler limitation encountered.  Sorry."
      Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr Text
"Revise your program or try a different Futhark compiler."
      Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr Text
s
      ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (ExitCode -> IO ()) -> ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
1
    onICE (Error ErrorClass
CompilerBug Text
s) = do
      Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr Text
"Internal compiler error."
      Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr Text
"Please report this at https://github.com/diku-dk/futhark/issues."
      Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr Text
s
      ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (ExitCode -> IO ()) -> ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
1

    onError :: SomeException -> IO ()
    onError :: SomeException -> IO ()
onError SomeException
e
      | Just AsyncException
UserInterrupt <- SomeException -> Maybe AsyncException
forall e. Exception e => SomeException -> Maybe e
asyncExceptionFromException SomeException
e =
          () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- This corresponds to CTRL-C, which is not an error.
      | Bool
otherwise = do
          Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr Text
"Internal compiler error (unhandled IO exception)."
          Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr Text
"Please report this at https://github.com/diku-dk/futhark/issues"
          Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ SomeException -> Text
forall a. Show a => a -> Text
showText SomeException
e
          ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (ExitCode -> IO ()) -> ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
1

    onIOException :: IOException -> IO ()
    onIOException :: IOException -> IO ()
onIOException IOException
e
      | IOException -> IOErrorType
ioe_type IOException
e IOErrorType -> IOErrorType -> Bool
forall a. Eq a => a -> a -> Bool
== IOErrorType
ResourceVanished =
          ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (ExitCode -> IO ()) -> ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
1
      | Bool
otherwise = IOException -> IO ()
forall a e. Exception e => e -> a
throw IOException
e

-- | The @futhark@ executable.
main :: IO ()
main :: IO ()
main = IO () -> IO ()
reportingIOErrors (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  Handle -> TextEncoding -> IO ()
hSetEncoding Handle
stdout TextEncoding
utf8
  Handle -> TextEncoding -> IO ()
hSetEncoding Handle
stderr TextEncoding
utf8
  TextEncoding -> IO ()
setLocaleEncoding TextEncoding
utf8
  [String]
args <- IO [String]
getArgs
  String
prog <- IO String
getProgName
  case [String]
args of
    String
cmd : [String]
args'
      | Just (Command
m, String
_) <- String -> [(String, (Command, String))] -> Maybe (Command, String)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
cmd [(String, (Command, String))]
commands -> Command
m ([String] -> String
unwords [String
prog, String
cmd]) [String]
args'
    [String]
_ -> ()
-> [FunOptDescr ()]
-> String
-> ([String] -> () -> Maybe (IO ()))
-> Command
forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> Command
mainWithOptions () [] String
msg (Maybe (IO ()) -> () -> Maybe (IO ())
forall a b. a -> b -> a
const (Maybe (IO ()) -> () -> Maybe (IO ()))
-> ([String] -> Maybe (IO ())) -> [String] -> () -> Maybe (IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (IO ()) -> [String] -> Maybe (IO ())
forall a b. a -> b -> a
const Maybe (IO ())
forall a. Maybe a
Nothing) String
prog [String]
args