{-# LANGUAGE FlexibleContexts #-}

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

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

isBuiltin :: String -> Bool
isBuiltin :: String -> Bool
isBuiltin = (String
"prelude/" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)

-- | @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 ()) -> ([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
$
        ((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 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 (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
prettyText ([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 -> 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 :: * -> *).
(MonadFail 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