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

    import Control.Exception
    import Data.List (sortOn)
    import Data.List qualified as L
    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.Fmt qualified as Fmt
    import Futhark.CLI.HIP qualified as HIP
    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.Script qualified as Script
    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
    "script", (Command
    Script.main, String
    "Run FutharkScript expressions.")),
          (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.")),
          (String
    "fmt", (Command
    Fmt.main, String
    "Reformat Futhark source file."))
        ]

    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'
          | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ String
    "-" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `L.isPrefixOf` String
    cmd ->
              String -> IO ()
    optionsError (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "unknown subcommand \"" String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    cmd String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    "\"."
        [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