    -- | Various small subcommands that are too simple to deserve their own file.
    module Futhark.CLI.Misc
      ( mainImports,
        mainHash,
        mainDataget,
        mainCheckSyntax,
        mainThanks,
        mainTokens,
      )
    where

    import Control.Monad
    import Control.Monad.State
    import Data.ByteString.Lazy qualified as BS
    import Data.Function (on)
    import Data.List (nubBy)
    import Data.Loc (L (..), startPos)
    import Data.Text qualified as T
    import Data.Text.IO qualified as T
    import Futhark.Compiler
    import Futhark.Test
    import Futhark.Util (hashText, interactWithFileSafely)
    import Futhark.Util.Options
    import Futhark.Util.Pretty (prettyTextOneLine)
    import Language.Futhark.Parser.Lexer (scanTokensText)
    import Language.Futhark.Prop (isBuiltin)
    import Language.Futhark.Semantic (includeToString)
    import System.Environment (getExecutablePath)
    import System.Exit
    import System.FilePath
    import System.IO
    import System.Random

    -- | @futhark imports@
    mainImports :: String -> [String] -> IO ()
    mainImports :: String -> [String] -> IO ()
    mainImports = ()
    -> [FunOptDescr ()]
    -> String
    -> ([String] -> () -> Maybe (IO ()))
    -> String
    -> [String]
    -> IO ()
    forall cfg.
    cfg
    -> [FunOptDescr cfg]
    -> String
    -> ([String] -> cfg -> Maybe (IO ()))
    -> String
    -> [String]
    -> IO ()
    mainWithOptions () [] String
    "program" (([String] -> () -> Maybe (IO ())) -> String -> [String] -> IO ())
    -> ([String] -> () -> Maybe (IO ())) -> String -> [String] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \[String]
    args () ->
      case [String]
    args of
        [String
    file] -> IO () -> Maybe (IO ())
    forall a. a -> Maybe a
    Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
    forall a b. (a -> b) -> a -> b
    $ do
          (Warnings
    _, Imports
    prog_imports, VNameSource
    _) <- String -> IO (Warnings, Imports, VNameSource)
    forall (m :: * -> *).
    MonadIO m =>
    String -> m (Warnings, Imports, VNameSource)
    readProgramOrDie String
    file
          IO () -> IO ()
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> IO ()) -> ([String] -> IO ()) -> [String] -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> IO ()
    putStr (String -> IO ()) -> ([String] -> String) -> [String] -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String
    unlines ([String] -> String)
    -> ([String] -> [String]) -> [String] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ".fut") ([String] -> [String])
    -> ([String] -> [String]) -> [String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Bool
    isBuiltin) ([String] -> IO ()) -> [String] -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            ((ImportName, FileModule) -> String) -> Imports -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (ImportName -> String
    includeToString (ImportName -> String)
    -> ((ImportName, FileModule) -> ImportName)
    -> (ImportName, FileModule)
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ImportName, FileModule) -> ImportName
    forall a b. (a, b) -> a
    fst) Imports
    prog_imports
        [String]
    _ -> Maybe (IO ())
    forall a. Maybe a
    Nothing

    -- | @futhark hash@
    mainHash :: String -> [String] -> IO ()
    mainHash :: String -> [String] -> IO ()
    mainHash = ()
    -> [FunOptDescr ()]
    -> String
    -> ([String] -> () -> Maybe (IO ()))
    -> String
    -> [String]
    -> IO ()
    forall cfg.
    cfg
    -> [FunOptDescr cfg]
    -> String
    -> ([String] -> cfg -> Maybe (IO ()))
    -> String
    -> [String]
    -> IO ()
    mainWithOptions () [] String
    "program" (([String] -> () -> Maybe (IO ())) -> String -> [String] -> IO ())
    -> ([String] -> () -> Maybe (IO ())) -> String -> [String] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \[String]
    args () ->
      case [String]
    args of
        [String
    file] -> IO () -> Maybe (IO ())
    forall a. a -> Maybe a
    Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
    forall a b. (a -> b) -> a -> b
    $ do
          [(String, UncheckedProg)]
    prog <- ((String, UncheckedProg) -> Bool)
    -> [(String, UncheckedProg)] -> [(String, UncheckedProg)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool)
    -> ((String, UncheckedProg) -> Bool)
    -> (String, UncheckedProg)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Bool
    isBuiltin (String -> Bool)
    -> ((String, UncheckedProg) -> String)
    -> (String, UncheckedProg)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String, UncheckedProg) -> String
    forall a b. (a, b) -> a
    fst) ([(String, UncheckedProg)] -> [(String, UncheckedProg)])
    -> IO [(String, UncheckedProg)] -> IO [(String, UncheckedProg)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO [(String, UncheckedProg)]
    forall (m :: * -> *).
    MonadIO m =>
    String -> m [(String, UncheckedProg)]
    readUntypedProgramOrDie String
    file
          -- The 'map snd' is an attempt to get rid of the file names so
          -- they won't affect the hashing.
          IO () -> IO ()
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Text -> IO ()
    T.putStrLn (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    hashText (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ [UncheckedProg] -> Text
    forall a. Pretty a => a -> Text
    prettyTextOneLine ([UncheckedProg] -> Text) -> [UncheckedProg] -> Text
    forall a b. (a -> b) -> a -> b
    $ ((String, UncheckedProg) -> UncheckedProg)
    -> [(String, UncheckedProg)] -> [UncheckedProg]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, UncheckedProg) -> UncheckedProg
    forall a b. (a, b) -> b
    snd [(String, UncheckedProg)]
    prog
        [String]
    _ -> Maybe (IO ())
    forall a. Maybe a
    Nothing

    -- | @futhark dataget@
    mainDataget :: String -> [String] -> IO ()
    mainDataget :: String -> [String] -> IO ()
    mainDataget = ()
    -> [FunOptDescr ()]
    -> String
    -> ([String] -> () -> Maybe (IO ()))
    -> String
    -> [String]
    -> IO ()
    forall cfg.
    cfg
    -> [FunOptDescr cfg]
    -> String
    -> ([String] -> cfg -> Maybe (IO ()))
    -> String
    -> [String]
    -> IO ()
    mainWithOptions () [] String
    "program dataset" (([String] -> () -> Maybe (IO ())) -> String -> [String] -> IO ())
    -> ([String] -> () -> Maybe (IO ())) -> String -> [String] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \[String]
    args () ->
      case [String]
    args of
        [String
    file, String
    dataset] -> IO () -> Maybe (IO ())
    forall a. a -> Maybe a
    Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
    forall a b. (a -> b) -> a -> b
    $ String -> Text -> IO ()
    dataget String
    file (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack String
    dataset
        [String]
    _ -> Maybe (IO ())
    forall a. Maybe a
    Nothing
      where
        dataget :: String -> Text -> IO ()
    dataget String
    prog Text
    dataset = do
          let dir :: String
    dir = String -> String
    takeDirectory String
    prog

          [TestRun]
    runs <- ProgramTest -> [TestRun]
    testSpecRuns (ProgramTest -> [TestRun]) -> IO ProgramTest -> IO [TestRun]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO ProgramTest
    testSpecFromProgramOrDie String
    prog

          let exact :: [TestRun]
    exact = (TestRun -> Bool) -> [TestRun] -> [TestRun]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Text
    dataset ==) (Text -> Bool) -> (TestRun -> Text) -> TestRun -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TestRun -> Text
    runDescription) [TestRun]
    runs
              infixes :: [TestRun]
    infixes = (TestRun -> Bool) -> [TestRun] -> [TestRun]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Text
    dataset `T.isInfixOf`) (Text -> Bool) -> (TestRun -> Text) -> TestRun -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TestRun -> Text
    runDescription) [TestRun]
    runs

          FutharkExe
    futhark <- String -> FutharkExe
    FutharkExe (String -> FutharkExe) -> IO String -> IO FutharkExe
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO String
    getExecutablePath

          case (TestRun -> TestRun -> Bool) -> [TestRun] -> [TestRun]
    forall a. (a -> a -> Bool) -> [a] -> [a]
    nubBy (Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) (Text -> Text -> Bool)
    -> (TestRun -> Text) -> TestRun -> TestRun -> Bool
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` TestRun -> Text
    runDescription) ([TestRun] -> [TestRun]) -> [TestRun] -> [TestRun]
    forall a b. (a -> b) -> a -> b
    $
            if [TestRun] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TestRun]
    exact then [TestRun]
    infixes else [TestRun]
    exact of
            [TestRun
    x] -> ByteString -> IO ()
    BS.putStr (ByteString -> IO ()) -> IO ByteString -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< FutharkExe -> String -> Values -> IO ByteString
    forall (m :: * -> *).
    (MonadFail m, MonadIO m) =>
    FutharkExe -> String -> Values -> m ByteString
    getValuesBS FutharkExe
    futhark String
    dir (TestRun -> Values
    runInput TestRun
    x)
            [] -> do
              Handle -> Text -> IO ()
    T.hPutStr Handle
    stderr (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "No dataset '" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    dataset Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "'.\n"
              Handle -> Text -> IO ()
    T.hPutStr Handle
    stderr Text
    "Available datasets:\n"
              (TestRun -> IO ()) -> [TestRun] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Handle -> Text -> IO ()
    T.hPutStrLn Handle
    stderr (Text -> IO ()) -> (TestRun -> Text) -> TestRun -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text
    "  " <>) (Text -> Text) -> (TestRun -> Text) -> TestRun -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TestRun -> Text
    runDescription) [TestRun]
    runs
              IO ()
    forall a. IO a
    exitFailure
            [TestRun]
    runs' -> do
              Handle -> Text -> IO ()
    T.hPutStr Handle
    stderr (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "Dataset '" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    dataset Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "' ambiguous:\n"
              (TestRun -> IO ()) -> [TestRun] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Handle -> Text -> IO ()
    T.hPutStrLn Handle
    stderr (Text -> IO ()) -> (TestRun -> Text) -> TestRun -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text
    "  " <>) (Text -> Text) -> (TestRun -> Text) -> TestRun -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TestRun -> Text
    runDescription) [TestRun]
    runs'
              IO ()
    forall a. IO a
    exitFailure

        testSpecRuns :: ProgramTest -> [TestRun]
    testSpecRuns = TestAction -> [TestRun]
    testActionRuns (TestAction -> [TestRun])
    -> (ProgramTest -> TestAction) -> ProgramTest -> [TestRun]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ProgramTest -> TestAction
    testAction
        testActionRuns :: TestAction -> [TestRun]
    testActionRuns CompileTimeFailure {} = []
        testActionRuns (RunCases [InputOutputs]
    ios [StructureTest]
    _ [WarningTest]
    _) = (InputOutputs -> [TestRun]) -> [InputOutputs] -> [TestRun]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap InputOutputs -> [TestRun]
    iosTestRuns [InputOutputs]
    ios

    -- | @futhark check-syntax@
    mainCheckSyntax :: String -> [String] -> IO ()
    mainCheckSyntax :: String -> [String] -> IO ()
    mainCheckSyntax = ()
    -> [FunOptDescr ()]
    -> String
    -> ([String] -> () -> Maybe (IO ()))
    -> String
    -> [String]
    -> IO ()
    forall cfg.
    cfg
    -> [FunOptDescr cfg]
    -> String
    -> ([String] -> cfg -> Maybe (IO ()))
    -> String
    -> [String]
    -> IO ()
    mainWithOptions () [] String
    "program" (([String] -> () -> Maybe (IO ())) -> String -> [String] -> IO ())
    -> ([String] -> () -> Maybe (IO ())) -> String -> [String] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \[String]
    args () ->
      case [String]
    args of
        [String
    file] -> IO () -> Maybe (IO ())
    forall a. a -> Maybe a
    Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
    forall a b. (a -> b) -> a -> b
    $ IO [(String, UncheckedProg)] -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO [(String, UncheckedProg)] -> IO ())
    -> IO [(String, UncheckedProg)] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO [(String, UncheckedProg)]
    forall (m :: * -> *).
    MonadIO m =>
    String -> m [(String, UncheckedProg)]
    readUntypedProgramOrDie String
    file
        [String]
    _ -> Maybe (IO ())
    forall a. Maybe a
    Nothing

    -- | @futhark thanks@
    mainThanks :: String -> [String] -> IO ()
    mainThanks :: String -> [String] -> IO ()
    mainThanks = ()
    -> [FunOptDescr ()]
    -> String
    -> ([String] -> () -> Maybe (IO ()))
    -> String
    -> [String]
    -> IO ()
    forall cfg.
    cfg
    -> [FunOptDescr cfg]
    -> String
    -> ([String] -> cfg -> Maybe (IO ()))
    -> String
    -> [String]
    -> IO ()
    mainWithOptions () [] String
    "" (([String] -> () -> Maybe (IO ())) -> String -> [String] -> IO ())
    -> ([String] -> () -> Maybe (IO ())) -> String -> [String] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \[String]
    args () ->
      case [String]
    args of
        [] -> IO () -> Maybe (IO ())
    forall a. a -> Maybe a
    Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
    forall a b. (a -> b) -> a -> b
    $ do
          Int
    i <- (Int, Int) -> IO Int
    forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
    randomRIO (Int
    0, Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)
          String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [String]
    responses [String] -> Int -> String
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    i
        [String]
    _ -> Maybe (IO ())
    forall a. Maybe a
    Nothing
      where
        n :: Int
    n = [String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    responses
        responses :: [String]
    responses =
          [ String
    "You're welcome!",
            String
    "Tell all your friends about Futhark!",
            String
    "Likewise!",
            String
    "And thank you in return for trying the language!",
            String
    "It's our pleasure!",
            String
    "Have fun with Futhark!"
          ]

    -- | @futhark tokens@
    mainTokens :: String -> [String] -> IO ()
    mainTokens :: String -> [String] -> IO ()
    mainTokens = ()
    -> [FunOptDescr ()]
    -> String
    -> ([String] -> () -> Maybe (IO ()))
    -> String
    -> [String]
    -> IO ()
    forall cfg.
    cfg
    -> [FunOptDescr cfg]
    -> String
    -> ([String] -> cfg -> Maybe (IO ()))
    -> String
    -> [String]
    -> IO ()
    mainWithOptions () [] String
    "program" (([String] -> () -> Maybe (IO ())) -> String -> [String] -> IO ())
    -> ([String] -> () -> Maybe (IO ())) -> String -> [String] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \[String]
    args () ->
      case [String]
    args of
        [String
    file] -> IO () -> Maybe (IO ())
    forall a. a -> Maybe a
    Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
    forall a b. (a -> b) -> a -> b
    $ do
          Maybe (Either String (Either LexerError [L Token]))
    res <- IO (Either LexerError [L Token])
    -> IO (Maybe (Either String (Either LexerError [L Token])))
    forall a. IO a -> IO (Maybe (Either String a))
    interactWithFileSafely (Pos -> Text -> Either LexerError [L Token]
    scanTokensText (String -> Pos
    startPos String
    file) (Text -> Either LexerError [L Token])
    -> IO Text -> IO (Either LexerError [L Token])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO Text
    T.readFile String
    file)
          case Maybe (Either String (Either LexerError [L Token]))
    res of
            Maybe (Either String (Either LexerError [L Token]))
    Nothing -> do
              Handle -> String -> IO ()
    hPutStrLn Handle
    stderr (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    file String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    ": file not found."
              ExitCode -> IO ()
    forall a. ExitCode -> IO a
    exitWith (ExitCode -> IO ()) -> ExitCode -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> ExitCode
    ExitFailure Int
    2
            Just (Left String
    e) -> do
              Handle -> String -> IO ()
    forall a. Show a => Handle -> a -> IO ()
    hPrint Handle
    stderr String
    e
              ExitCode -> IO ()
    forall a. ExitCode -> IO a
    exitWith (ExitCode -> IO ()) -> ExitCode -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> ExitCode
    ExitFailure Int
    2
            Just (Right (Left LexerError
    e)) -> do
              Handle -> LexerError -> IO ()
    forall a. Show a => Handle -> a -> IO ()
    hPrint Handle
    stderr LexerError
    e
              ExitCode -> IO ()
    forall a. ExitCode -> IO a
    exitWith (ExitCode -> IO ()) -> ExitCode -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> ExitCode
    ExitFailure Int
    2
            Just (Right (Right [L Token]
    tokens)) ->
              (L Token -> IO ()) -> [L Token] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ L Token -> IO ()
    forall {a}. Show a => L a -> IO ()
    printToken [L Token]
    tokens
        [String]
    _ -> Maybe (IO ())
    forall a. Maybe a
    Nothing
      where
        printToken :: L a -> IO ()
    printToken (L Loc
    _ a
    token) =
          a -> IO ()
    forall a. Show a => a -> IO ()
    print a
    token