module Laborantin.CLI (defaultMain) where
import Control.Monad
import Control.Applicative
import Control.Monad.IO.Class
import Laborantin
import Laborantin.Types
import Laborantin.Implementation
import System.Environment
import System.Console.CmdLib hiding (run)
import qualified Data.Map as M
import Data.List (intercalate)
import Data.Aeson (encode)
import Data.Maybe (catMaybes)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List.Split (splitOn)
defaultMain xs = getArgs >>= dispatchR [] >>= runLabor xs
unlines' :: [String] -> String
unlines' = intercalate "\n"
describeScenario :: ScenarioDescription m -> String
describeScenario sc = unlines [
"# Scenario: " ++ sName sc
, " " ++ sDesc sc
, " " ++ (show . length . paramSets $ sParams sc) ++ " parameter combinations by default"
, "## Parameters:"
, unlines' $ paramLines
]
where paramLines = map (uncurry paramLine) pairs
pairs = M.toList $ sParams sc
paramLine n p = unlines' [
"### " ++ n
, describeParameter p
]
describeParameter :: ParameterDescription -> String
describeParameter p = unlines' [
"(" ++ pName p ++ ")"
, " " ++ pDesc p
, " " ++ (show . length $ concatMap expandValue $ pValues p) ++ " values:"
, unlines $ map ((" - " ++) . show) (pValues p)
]
describeExecution :: Execution m -> String
describeExecution e = intercalate " " [ ePath e
, sName (eScenario e)
, "(" ++ show (eStatus e) ++ ")"
, C.unpack $ encode (eParamSet e)
]
data Labor = Run { scenarii :: [String] , params :: [String] , continue :: Bool}
| Describe { scenarii :: [String] }
| Find { scenarii :: [String] , params :: [String] }
| Analyze { scenarii :: [String] , params :: [String] }
| Rm { scenarii :: [String] , params :: [String] , force :: Bool , failed :: Bool , successful :: Bool}
deriving (Typeable, Data, Show, Eq)
instance Attributes Labor where
attributes _ = group "Options" [
scenarii %> [ Short "s"
, Long ["scenario"]
, Help "Restrict to the scenarios in parameter."
, ArgHelp "SCENARIOS"
]
, params %> [ Short "p"
, Long ["param"]
, Help "Restrict a parameter, format name=type:val."
, ArgHelp "PARAMS"
]
, continue %> [ Short "c"
, Long ["continue"]
, Default False
, Invertible True
, Help "Continue execution (skip known)"
]
, force %> [ Short "f"
, Long ["force"]
, Help "Force flag"
]
, failed %> [ Long ["failed"]
, Help "Failed only"
]
, successful %> [ Long ["successful"]
, Help "Successful only"
]
]
instance RecordCommand Labor where
mode_summary _ = "Laborantin command-line interface"
data DescriptionQuery = ScenarioName [String]
deriving (Show)
type ExecutionQuery = M.Map String [ParameterValue]
parseParamQuery :: String -> Maybe (String,[ParameterValue])
parseParamQuery str = let vals = splitOn ":" str in
case vals of
[k,"int",v] -> Just (k, [NumberParam . toRational $ read v])
[k,"double",v] -> Just (k, [NumberParam . toRational $ (read v :: Double)])
[k,"rational",v] -> Just (k, [NumberParam $ read v])
[k,"str",v] -> Just (k, [StringParam v])
_ -> Nothing
paramsToQuery :: [String] -> ExecutionQuery
paramsToQuery xs = let pairs = catMaybes (map parseParamQuery xs) in
M.fromListWith (++) pairs
filterDescriptions :: DescriptionQuery -> [ScenarioDescription m] -> [ScenarioDescription m]
filterDescriptions (ScenarioName []) xs = xs
filterDescriptions (ScenarioName ns) xs = filter ((flip elem ns) . sName) xs
filterExecutions :: ExecutionQuery -> [Execution m] -> [Execution m]
filterExecutions query = filter (matchQuery query . eParamSet)
matchQuery :: ExecutionQuery -> ParameterSet -> Bool
matchQuery m params = all id $ map snd $ M.toList $ M.intersectionWith elem params m
runLabor :: [ScenarioDescription EnvIO] -> Labor -> IO ()
runLabor xs labor =
case labor of
(Describe scii) -> forM_ xs' (putStrLn . describeScenario)
Find {} -> do (execs,_) <- runEnvIO loadMatching
mapM_ (putStrLn . describeExecution) execs
(Rm {}) -> runSc loadAndRemove
(Run { continue = False }) -> runSc execAll
(Run { continue = True }) -> runSc execRemaining
Analyze {} -> runSc loadAndAnalyze
where xs' = filterDescriptions (ScenarioName $ scenarii labor) xs
query = paramsToQuery $ params labor
runSc = void . runEnvIO
loadAll = concat <$> mapM (load defaultBackend) xs'
loadMatching = filterExecutions query <$> loadAll
loadAndRemove = loadMatching >>= mapM (remove defaultBackend)
loadAndAnalyze= loadMatching >>= mapM (executeAnalysis defaultBackend)
execAll = forM_ xs' $ executeExhaustive defaultBackend
execRemaining = forM_ xs' $ executeMissing defaultBackend