laborantin-hs 0.1.1.3 → 0.1.2.0
raw patch · 8 files changed
+119/−68 lines, 8 filesdep +timedep −old-time
Dependencies added: time
Dependencies removed: old-time
Files
- Laborantin.hs +8/−10
- Laborantin/CLI.hs +43/−26
- Laborantin/Implementation.hs +4/−14
- Laborantin/Query.hs +2/−0
- Laborantin/Query/Interpret.hs +3/−3
- Laborantin/Types.hs +6/−5
- README.md +8/−7
- laborantin-hs.cabal +45/−3
Laborantin.hs view
@@ -31,18 +31,16 @@ rebrandError (ExecutionError str) = Left $ AnalysisError str -executeExhaustive :: (MonadIO m) => Backend m -> ScenarioDescription m -> m ()-executeExhaustive b sc = mapM_ f $ paramSets $ sParams sc+executeExhaustive :: (MonadIO m) => Backend m -> ScenarioDescription m -> [m ()]+executeExhaustive b sc = map f $ paramSets $ sParams sc where f = execute b sc -executeMissing :: (MonadIO m) => Backend m -> ScenarioDescription m -> m ()-executeMissing b sc = do- execs <- load b [sc] (B True)- let successful = filter ((== Success) . eStatus) execs- let exhaustive = S.fromList $ paramSets (sParams sc)- let existing = S.fromList $ map eParamSet successful- mapM_ f $ S.toList (exhaustive `S.difference` existing)- where f = execute b sc+executeMissing :: (MonadIO m) => Backend m -> ScenarioDescription m -> [Execution m] -> [m ()]+executeMissing b sc execs = map f $ S.toList (exhaustive `S.difference` existing)+ where successful = filter ((== Success) . eStatus) execs+ exhaustive = S.fromList $ paramSets (sParams sc)+ existing = S.fromList $ map eParamSet successful+ f = execute b sc load :: (MonadIO m) => Backend m -> [ScenarioDescription m] -> TExpr Bool -> m [Execution m] load = bLoad
Laborantin/CLI.hs view
@@ -25,6 +25,7 @@ import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T+import Data.Time (UTCTime(..), getCurrentTime) defaultMain xs = getArgs >>= dispatchR [] >>= runLabor xs @@ -64,10 +65,10 @@ data Labor = Run { scenarii :: [String] , params :: [String] , continue :: Bool , matcher :: [String]} | Describe { scenarii :: [String] } - | Find { scenarii :: [String] , params :: [String] , successful :: Bool, matcher :: [String]} - | Analyze { scenarii :: [String] , params :: [String] , successful :: Bool , matcher :: [String]} - | Rm { scenarii :: [String] , params :: [String] , successful :: Bool , matcher :: [String]} - | Query { scenarii :: [String] , params :: [String] , successful :: Bool , matcher :: [String]} + | Find { scenarii :: [String] , params :: [String] , successful :: Bool, today :: Bool, matcher :: [String]} + | Analyze { scenarii :: [String] , params :: [String] , successful :: Bool , today :: Bool, matcher :: [String]} + | Rm { scenarii :: [String] , params :: [String] , successful :: Bool , today :: Bool, matcher :: [String]} + | Query { scenarii :: [String] , params :: [String] , successful :: Bool , today :: Bool, matcher :: [String]} deriving (Typeable, Data, Show, Eq) instance Attributes Labor where@@ -93,6 +94,11 @@ , Invertible True , Default True ]+ , today %> [ Long ["today"]+ , Help "Today only (currently uses UTC day!)"+ , Invertible True+ , Default False+ ] , matcher %> [ Short "m" , Long ["matcher"] , Help "Restrict to a matching expression"@@ -133,12 +139,18 @@ statusToTExpr True = (Eq ScStatus (S "success")) statusToTExpr False = Not (Eq ScStatus (S "success")) +todayToTExpr :: Bool -> UTCTime -> TExpr Bool+todayToTExpr True today = (Or (Eq ScTimestamp (T today)) (Gt ScTimestamp (T today)))+todayToTExpr False _ = B True+ conjunctionQueries :: [TExpr Bool] -> TExpr Bool conjunctionQueries [] = B True+conjunctionQueries [q] = q conjunctionQueries (q:qs) = And q (conjunctionQueries qs) disjunctionQueries :: [TExpr Bool] -> TExpr Bool disjunctionQueries [] = B False+disjunctionQueries [q] = q disjunctionQueries (q:qs) = Or q (disjunctionQueries qs) filterDescriptions :: DescriptionTExpr -> [ScenarioDescription m] -> [ScenarioDescription m]@@ -147,27 +159,32 @@ runLabor :: [ScenarioDescription EnvIO] -> Labor -> IO ()-runLabor xs labor =+runLabor xs labor = do+ now <- getCurrentTime case labor of- (Describe scii) -> forM_ xs' (T.putStrLn . describeScenario)- Find {} -> do (execs,_) <- runEnvIO loadMatching- mapM_ (T.putStrLn . describeExecution) execs- (Rm {}) -> runSc loadAndRemove- (Run { continue = False }) -> runSc execAll- (Run { continue = True }) -> runSc execRemaining- Analyze {} -> runSc loadAndAnalyze- Query {} -> putStrLn $ showTExpr $ simplifyOneBoolLevel query+ (Describe scii) -> forM_ xs' (T.putStrLn . describeScenario)+ Find {} -> do (execs,_) <- runEnvIO (loadMatching now)+ mapM_ (T.putStrLn . describeExecution) execs+ (Rm {}) -> runSc (loadAndRemove now)+ (Run { continue = False }) -> mapM_ runSc allExecs+ (Run { continue = True }) -> do (execs,_) <- runEnvIO (loadMatching now)+ mapM_ runSc (remainingExecs execs)+ Analyze {} -> runSc (loadAndAnalyze now)+ Query {} -> do let expr = simplifyOneBoolLevel $ query now+ putStrLn $ showTExpr expr - where xs' = filterDescriptions (ScenarioName $ map T.pack $ scenarii labor) xs- matcherUExprs = rights $ map parseUExpr (matcher labor)- matcherTExprs = map (toTExpr (B True)) matcherUExprs- paramsTExpr = paramsToTExpr $ map T.pack $ params labor- scenarioTExpr = scenarsToTExpr $ map T.pack $ scenarii labor- statusTExpr = statusToTExpr $ successful labor- !query = conjunctionQueries (paramsTExpr:scenarioTExpr:statusTExpr:matcherTExprs)- runSc = void . runEnvIO- loadMatching = load defaultBackend xs' query- loadAndRemove = loadMatching >>= mapM (remove defaultBackend)- loadAndAnalyze= loadMatching >>= mapM (executeAnalysis defaultBackend)- execAll = forM_ xs' $ executeExhaustive defaultBackend- execRemaining = forM_ xs' $ executeMissing defaultBackend+ where xs' = filterDescriptions (ScenarioName $ map T.pack $ scenarii labor) xs+ matcherUExprs = rights $ map parseUExpr (matcher labor)+ matcherTExprs = map (toTExpr (B True)) matcherUExprs+ paramsTExpr = paramsToTExpr $ map T.pack $ params labor+ scenarioTExpr = scenarsToTExpr $ map T.pack $ scenarii labor+ statusTExpr = statusToTExpr $ successful labor+ dateTExpr tst = todayToTExpr (today labor) (tst {utctDayTime = 0})+ query tst = conjunctionQueries (paramsTExpr:scenarioTExpr:statusTExpr:dateTExpr':matcherTExprs)+ where dateTExpr' = dateTExpr tst+ runSc = void . runEnvIO+ loadMatching tst = load defaultBackend xs' (query tst)+ loadAndRemove tst = loadMatching tst >>= mapM (remove defaultBackend)+ loadAndAnalyze tst = loadMatching tst >>= mapM (executeAnalysis defaultBackend)+ allExecs = concatMap (executeExhaustive defaultBackend) xs'+ remainingExecs execs = concatMap (\sc -> executeMissing defaultBackend sc execs) xs'
Laborantin/Implementation.hs view
@@ -30,7 +30,7 @@ import System.Log.Handler (close) import System.Log.Handler.Simple import System.Log.Handler.Log4jXML-import System.Time (ClockTime(TOD),getClockTime)+import Data.Time (UTCTime, getCurrentTime) -- | Default monad for 'defaultBackend'. -- EnvIO carries a 'DynEnv' in a state and allows you to perform IO actions.@@ -49,12 +49,6 @@ instance ToJSON ExecutionStatus where toJSON = toJSON . show -instance ToJSON ClockTime where- toJSON (TOD secs ps) = object [ "sec" .= secs- , "ps" .= ps- , "zero" .= ("epoch" :: String)- ]- instance ToJSON (Execution a) where toJSON (Exec sc params path status es tsts) = object [ "scenario-name" .= sName sc , "params" .= params@@ -80,10 +74,6 @@ parseJSON (A.String txt) = return $ read $ T.unpack txt parseJSON _ = mzero -instance FromJSON ClockTime where- parseJSON (A.Object v) = TOD <$> v .: "sec" <*> v .: "ps"- parseJSON _ = mzero- instance FromJSON StoredExecution where parseJSON (A.Object v) = Stored <$> v .: "params" <*>@@ -111,7 +101,7 @@ prepare = prepareNewScenario finalize exec finalizer = do finalizer exec- now <- liftIO $ getClockTime+ now <- liftIO $ getCurrentTime let exec' = updateCompletionTime exec now liftIO . putStrLn $ "execution finished\n" liftIO $ BSL.writeFile (rundir ++ "/execution.json") (encode exec')@@ -130,7 +120,7 @@ load = loadExisting -updateCompletionTime :: Execution m -> ClockTime -> Execution m+updateCompletionTime :: Execution m -> UTCTime -> Execution m updateCompletionTime exec t1 = exec {eTimeStamps = (t0,t1)} where t0 = fst $ eTimeStamps exec @@ -143,7 +133,7 @@ prepareNewScenario :: ScenarioDescription EnvIO -> ParameterSet -> EnvIO (Execution EnvIO,Finalizer EnvIO) prepareNewScenario sc params = do (now,uuid) <- liftIO $ do- now <- getClockTime+ now <- getCurrentTime id <- randomIO :: IO UUID return (now,id) let rundir = intercalate "/" [T.unpack (sName sc), show uuid]
Laborantin/Query.hs view
@@ -36,6 +36,7 @@ evalExpr exec (L xs) = mapM (evalExpr exec) xs >>= Right evalExpr _ (T x) = Right x evalExpr exec ScName = Right $ sName $ eScenario exec+evalExpr exec ScTimestamp = Right $ fst $ eTimeStamps exec evalExpr exec ScStatus | eStatus exec == Success = Right "success" | eStatus exec == Failure = Right "failure" | eStatus exec == Running = Right "running"@@ -88,6 +89,7 @@ showTExpr (Times e1 e2) = "(" ++ showTExpr e1 ++ " * " ++ showTExpr e2 ++ ")" showTExpr ScName = "@sc.name" showTExpr ScStatus = "@sc.status"+showTExpr ScTimestamp = "@sc.timestamp" showTExpr (ScParam key) = "@sc.param:" ++ show key showTExpr (SCoerce x) = showTExpr x showTExpr (NCoerce x) = showTExpr x
Laborantin/Query/Interpret.hs view
@@ -8,7 +8,7 @@ import Laborantin.Query import Data.Text (Text) import Data.Maybe (fromMaybe)-import System.Time (ClockTime)+import Data.Time (UTCTime) type Param = Maybe ParameterValue @@ -17,7 +17,7 @@ TTNum :: TTyp Rational TTString :: TTyp Text TTParam :: TTyp (Text,Param)- TTClock :: TTyp ClockTime+ TTUTCTime :: TTyp UTCTime data IError = IError deriving (Show)@@ -42,7 +42,7 @@ interpret UScStatus = Right (ScStatus ::: TTString) interpret (UScParam a) = Right (ScParam a ::: TTParam) interpret (UB a) = Right (B a ::: TTBool)-interpret (UT a) = Right (T a ::: TTClock)+interpret (UT a) = Right (T a ::: TTUTCTime) interpret (UN a) = Right (N a ::: TTNum) interpret (US a) = Right (S a ::: TTString) interpret (UAnd a b) = do
Laborantin/Types.hs view
@@ -30,7 +30,7 @@ ) where import qualified Data.Map as M-import System.Time (ClockTime)+import Data.Time (UTCTime) import Control.Monad.Reader import Control.Monad.Error import Data.Dynamic@@ -91,7 +91,7 @@ , ePath :: FilePath , eStatus :: ExecutionStatus , eAncestors :: [Execution m] - , eTimeStamps :: (ClockTime,ClockTime)+ , eTimeStamps :: (UTCTime,UTCTime) } deriving (Show) data StoredExecution = Stored {@@ -99,7 +99,7 @@ , sePath :: FilePath , seStatus :: ExecutionStatus , seAncestors :: [(FilePath,Text)]- , seTimeStamps :: (ClockTime,ClockTime)+ , seTimeStamps :: (UTCTime,UTCTime) } deriving (Show) data Dependency m = Dep {@@ -158,7 +158,7 @@ B :: Bool -> TExpr Bool S :: Text -> TExpr Text L :: [TExpr a] -> TExpr [a]- T :: ClockTime -> TExpr ClockTime+ T :: UTCTime -> TExpr UTCTime Plus :: TExpr Rational -> TExpr Rational -> TExpr Rational Times :: TExpr Rational -> TExpr Rational -> TExpr Rational And :: TExpr Bool -> TExpr Bool -> TExpr Bool@@ -170,6 +170,7 @@ ScName :: TExpr Text ScStatus :: TExpr Text ScParam :: Text -> TExpr (Text, Maybe ParameterValue)+ ScTimestamp :: TExpr UTCTime SCoerce :: TExpr (Text, Maybe ParameterValue) -> TExpr Text NCoerce :: TExpr (Text, Maybe ParameterValue) -> TExpr Rational SilentSCoerce :: TExpr (Text, Maybe ParameterValue) -> TExpr Text@@ -180,7 +181,7 @@ | UB Bool | US Text | UL [UExpr]- | UT ClockTime+ | UT UTCTime | UPlus UExpr UExpr | UMinus UExpr UExpr | UTimes UExpr UExpr
README.md view
@@ -112,15 +112,16 @@ # Roadmap -For version 1.+For version 1.2 -* Parse clocktime-* Debug errors in-* Function to expand TExpr to parameter space (for run command)-* Selector to load prior results based on a TExpr+* Syntax to parse clocktime and with --date=today/this-week etc. types of flags+* Print better debug errors on parsing messages+* Function to expand an UExpr (or a TExpr ([(ParameterName,ParameterValue)]))into a ParameterSpace+ - then need a function to extend a ParameterSpace with default values+ ScenarioDescription -> ParameterSpace -> ParameterSpace+* Add a scSelector :: TExpr Bool field to a scenario to load ancestors at prepare-time - "require" helper that sets a dep + selection * exports to propose exported files using "show-exports" command # Annoyances/Bugs-* DynEnv shared for the whole runEnvIO, need to have one DynEnv per-execution-+* the "continue" mode doesn't do what it should anymore, don't use it for now
laborantin-hs.cabal view
@@ -2,9 +2,51 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: laborantin-hs-version: 0.1.1.3+version: 0.1.2.0 synopsis: an experiment management framework--- description: +description: + Laborantin is a framework and DSL to run and manage results from scientific+ experiments. Good targets for Laborantin are experiments that you can+ run /offline/ such as benchmark and batch analytics.+ .+ Writing experiments with Laborantin has at least two advantages over+ rolling your own scripts. First, Laborantain standardizes the workflow of your+ experimentations. There is one-way to describe what a project can do, what+ experiments where already run, how to delete files corresponding to a specific+ experiment etc. Second, Laborantin builds on years of experience running+ experiments. Using Laborantin should alleviates common pain points such as+ querying for experiments, managing dependencies between results+ .+ Laborantin's DSL lets you express experiment parameters,+ setup, teardown, and recovery hooks in a systematic way.+ In addition, this DSL let you express dependencies on your+ experiments so that you can run prior experiments or data analyses.+ .+ Laborantin comes with a default backend that stores+ experiment results in a filesystem-hierarchy. Laborantin+ also comes with a default command-line that let you+ specify which experiments to run, analyze, or delete.+ .+ > ping :: ScenarioDescription EnvIO+ > ping = scenario "ping" $ do+ > describe "ping to a remote server"+ > parameter "destination" $ do+ > describe "a destination server (host or ip)"+ > values [str "example.com", str "probecraft.net"]+ > parameter "packet-size" $ do+ > describe "packet size in bytes"+ > values [num 50, num 1500] + > run $ do+ > (StringParam srv) <- param "destination"+ > (StringParam ps) <- param "packet-size"+ > liftIO (executePingCommand srv ps) >>= writeResult "raw-result"+ > where executePingCommand :: Text -> Rational -> IO (Text)+ > executePingCommand host packetSize = ...+ >+ > main :: IO ()+ > main = defaultMain [ping]++ homepage: https://github.com/lucasdicioccio/laborantin-hs license: Apache-2.0 license-file: LICENSE@@ -20,7 +62,7 @@ exposed-modules: Laborantin, Laborantin.DSL, Laborantin.Implementation, Laborantin.Types, Laborantin.CLI, Laborantin.Query other-modules: Laborantin.Query.Parse, Laborantin.Query.Interpret other-extensions: FlexibleContexts, OverloadedStrings, TupleSections- build-depends: base >=4.6 && <4.7, transformers >=0.3 && <0.4, mtl >=2.1 && <2.2, containers >=0.5 && <0.6, text >=0.11 && <0.12, bytestring >=0.10 && <0.11, aeson >=0.6 && <0.7, uuid >=1.2 && <1.3, directory >=1.2 && <1.3, random >=1.0 && <1.1, hslogger >=1.2 && <1.3, cmdlib >= 0.3.5, split >= 0.2.2, old-time >= 1.1.0.0, parsec >= 3.1.0+ build-depends: base >=4.6 && <4.7, transformers >=0.3 && <0.4, mtl >=2.1 && <2.2, containers >=0.5 && <0.6, text >=0.11 && <0.12, bytestring >=0.10 && <0.11, aeson >=0.6 && <0.7, uuid >=1.2 && <1.3, directory >=1.2 && <1.3, random >=1.0 && <1.1, hslogger >=1.2 && <1.3, cmdlib >= 0.3.5, split >= 0.2.2, time >= 1.4.0.1, parsec >= 3.1.0 -- hs-source-dirs: default-language: Haskell2010