{-# 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?")