1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
module ProbeSolvers where
import Control.Exception ( try, SomeException )
import Data.Char ( toLower )
import qualified Data.List as L
import Data.Maybe ( catMaybes )
import System.Exit ( ExitCode(..) )
import System.Process ( readProcessWithExitCode )
newtype TestLevel = TestLevel String deriving Eq
newtype SolverName = SolverName String deriving (Eq, Show)
newtype SolverVersion = SolverVersion String deriving (Eq, Show)
getSolverVersion :: SolverName -> IO (Either String SolverVersion)
getSolverVersion (SolverName solver) =
let args = case toLower <$> solver of
-- n.b. abc will return a non-zero exit code if asked
-- for command usage.
"abc" -> ["s", "-q", "version;quit"]
_ -> ["--version"]
in try (readProcessWithExitCode (toLower <$> solver) args "") >>= \case
Right (r,o,e) ->
if r == ExitSuccess
then let ol = lines o in
return $ Right $ SolverVersion
$ if null ol then (solver <> " v??") else head ol
else return $ Left $ solver <> " version error: " <> show r <> " /;/ " <> e
Left (err :: SomeException) -> return $ Left $ solver <> " invocation error: " <> show err
reportSolverVersions :: TestLevel
-> (solverinfo -> SolverName)
-> [(solverinfo, Either String SolverVersion)]
-> IO [(solverinfo, SolverVersion)]
reportSolverVersions testLevel getSolverName versionedSolvers =
do putStrLn "SOLVER SELF-REPORTED VERSIONS::"
catMaybes <$> mapM (rep testLevel) versionedSolvers
where rep lvl (testsolver, versionInfo) = let s = getSolverName testsolver
in disp lvl testsolver s versionInfo
disp lvl solver (SolverName sname) = \case
Right v@(SolverVersion ver) ->
do putStrLn $ " Solver " <> sname <> " -> " <> ver
return $ Just (solver, v)
Left e -> if and [ "does not exist" `L.isInfixOf` e
, lvl == TestLevel "0"
]
then do putStrLn $ " Solver " <> sname <> " not found; skipping (would fail with CI_TEST_LEVEL=1)"
return Nothing
else do putStrLn $ " Solver " <> sname <> " error: " <> e
return $ Just (solver, SolverVersion "v?")
|
