{-# LANGUAGE FlexibleContexts #-}

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

import Control.Monad.State
import qualified Data.ByteString.Lazy as BS
import Data.Function (on)
import Data.List (isInfixOf, isPrefixOf, nubBy)
import Futhark.Compiler
import Futhark.Test
import Futhark.Util.Options
import System.Environment (getExecutablePath)
import System.Exit
import System.FilePath
import System.IO

-- | @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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
          [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
            (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]
forall a b. (a -> b) -> a -> b
$
              (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
f -> Bool -> Bool
not (String
"prelude/" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
f)) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
                ((String, FileModule) -> String) -> Imports -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, FileModule) -> String
forall a b. (a, b) -> a
fst Imports
prog_imports
    [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 -> String -> IO ()
dataget String
file String
dataset
    [String]
_ -> Maybe (IO ())
forall a. Maybe a
Nothing
  where
    dataget :: String -> String -> IO ()
dataget String
prog String
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
testSpecFromFileOrDie String
prog

      let exact :: [TestRun]
exact = (TestRun -> Bool) -> [TestRun] -> [TestRun]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String
dataset String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) (String -> Bool) -> (TestRun -> String) -> TestRun -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestRun -> String
runDescription) [TestRun]
runs
          infixes :: [TestRun]
infixes = (TestRun -> Bool) -> [TestRun] -> [TestRun]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String
dataset String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) (String -> Bool) -> (TestRun -> String) -> TestRun -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestRun -> String
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 (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> String -> Bool)
-> (TestRun -> String) -> TestRun -> TestRun -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` TestRun -> String
runDescription) ([TestRun] -> [TestRun]) -> [TestRun] -> [TestRun]
forall a b. (a -> b) -> a -> b
$
        if [TestRun] -> 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 :: * -> *).
MonadIO m =>
FutharkExe -> String -> Values -> m ByteString
getValuesBS FutharkExe
futhark String
dir (TestRun -> Values
runInput TestRun
x)
        [] -> do
          Handle -> String -> IO ()
hPutStr Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"No dataset '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dataset String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'.\n"
          Handle -> String -> IO ()
hPutStr Handle
stderr String
"Available datasets:\n"
          (TestRun -> IO ()) -> [TestRun] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> (TestRun -> String) -> TestRun -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (TestRun -> String) -> TestRun -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestRun -> String
runDescription) [TestRun]
runs
          IO ()
forall a. IO a
exitFailure
        [TestRun]
runs' -> do
          Handle -> String -> IO ()
hPutStr Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Dataset '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dataset String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' ambiguous:\n"
          (TestRun -> IO ()) -> [TestRun] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> (TestRun -> String) -> TestRun -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (TestRun -> String) -> TestRun -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestRun -> String
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