diff --git a/Laborantin.hs b/Laborantin.hs --- a/Laborantin.hs +++ b/Laborantin.hs @@ -7,6 +7,7 @@ import Control.Monad.IO.Class import Control.Monad.Reader import Control.Monad.Error +import Control.Applicative import qualified Data.Set as S execute :: (MonadIO m) => Backend m -> ScenarioDescription m -> ParameterSet -> m () @@ -21,8 +22,15 @@ bRun b exec bTeardown b exec bAnalyze b exec - recover exec err = bRecover b exec >> throwError err + recover exec err = bRecover b err exec >> throwError err +executeAnalysis :: (MonadIO m, Functor m) => Backend m -> Execution m -> m (Either AnalysisError ()) +executeAnalysis b exec = do + either rebrandError Right <$> runReaderT (runErrorT (go exec)) (b, exec) + where go exec = bAnalyze b exec + rebrandError (ExecutionError str) = Left $ AnalysisError str + + executeExhaustive :: (MonadIO m) => Backend m -> ScenarioDescription m -> m () executeExhaustive b sc = mapM_ f $ paramSets $ sParams sc where f = execute b sc @@ -30,11 +38,14 @@ executeMissing :: (MonadIO m) => Backend m -> ScenarioDescription m -> m () executeMissing b sc = do execs <- load b sc + let successful = filter ((== Success) . eStatus) execs let exhaustive = S.fromList $ paramSets (sParams sc) - let existing = S.fromList $ map eParamSet execs + let existing = S.fromList $ map eParamSet successful mapM_ f $ S.toList (exhaustive `S.difference` existing) where f = execute b sc - load :: (MonadIO m) => Backend m -> ScenarioDescription m -> m [Execution m] load = bLoad + +remove :: (MonadIO m) => Backend m -> Execution m -> m () +remove = bRemove diff --git a/Laborantin/DSL.hs b/Laborantin/DSL.hs --- a/Laborantin/DSL.hs +++ b/Laborantin/DSL.hs @@ -22,6 +22,7 @@ , appendResult , logger , dbg + , err ) where import qualified Data.Map as M @@ -44,7 +45,7 @@ -- | DSL entry point to build a 'ScenarioDescription'. scenario :: String -> State (ScenarioDescription m) () -> ScenarioDescription m scenario name f = execState f sc0 - where sc0 = SDesc name "" M.empty M.empty + where sc0 = SDesc name "" M.empty M.empty Nothing -- | Attach a description to the 'Parameter' / 'Scnario' describe :: Describable a => String -> State a () @@ -92,8 +93,10 @@ teardown = appendHook "teardown" -- | Define the recovery hook for this scenario -recover :: Step m () -> State (ScenarioDescription m) () -recover = appendHook "recover" +recover :: (ExecutionError -> Step m ()) -> State (ScenarioDescription m) () +recover f = modify (setRecoveryAction action) + where action err = Action (f err) + setRecoveryAction act sc = sc { sRecoveryAction = Just act } -- | Define the offline analysis hook for this scenario analyze :: Step m () -> State (ScenarioDescription m) () @@ -134,6 +137,10 @@ -- | Sends a line of data to the logger (debug mode) dbg :: Monad m => String -> Step m () dbg msg = logger >>= flip lLog msg + +-- | Interrupts the scenario by throwing an error +err :: Monad m => String -> Step m () +err = throwError . ExecutionError -- | Get the parameter with given name. -- Throw an error if the parameter is missing. diff --git a/Laborantin/Implementation.hs b/Laborantin/Implementation.hs --- a/Laborantin/Implementation.hs +++ b/Laborantin/Implementation.hs @@ -10,13 +10,16 @@ import qualified Data.Map as M import qualified Data.Text as T import qualified Data.ByteString.Lazy as BSL +import qualified Data.ByteString.Lazy.Char8 as C import Laborantin.Types import Data.Aeson (decode,encode,FromJSON,parseJSON,(.:),ToJSON,toJSON,(.=),object) import qualified Data.Aeson as A import qualified Data.Aeson.Types as A import Control.Monad.State +import Control.Monad.Error import Control.Applicative ((<$>),(<*>)) import Data.List +import Data.Maybe import Data.UUID import System.Directory import System.Random @@ -30,8 +33,8 @@ type EnvIO = (StateT DynEnv IO) -- | Execute an EnvIO action in IO. -runEnvIO :: EnvIO () -> IO DynEnv -runEnvIO m = snd <$> runStateT m M.empty +runEnvIO :: EnvIO a -> IO (a,DynEnv) +runEnvIO m = runStateT m M.empty instance ToJSON ParameterValue where toJSON (StringParam str) = object ["type" .= ("string"::T.Text), "val" .= T.pack str] @@ -83,7 +86,7 @@ -- and logs. -- defaultBackend :: Backend EnvIO -defaultBackend = Backend "default EnvIO backend" prepare finalize setup run teardown analyze recover result load log +defaultBackend = Backend "default EnvIO backend" prepare finalize setup run teardown analyze recover result load log rm where prepare :: ScenarioDescription EnvIO -> ParameterSet -> EnvIO (Execution EnvIO,Finalizer EnvIO) prepare sc params = do uuid <- liftIO (randomIO :: IO UUID) @@ -99,20 +102,17 @@ putStrLn $ advertise exec return [h1,h2] return (exec, \_ -> liftIO $ forM_ handles close) - where advertise exec = unlines $ map ($ exec) [show. sName . eScenario - , show . eParamSet - , ePath] finalize exec finalizer = do finalizer exec - liftIO . putStrLn $ "done" + liftIO . putStrLn $ "execution finished\n" liftIO $ BSL.writeFile (rundir ++ "/execution.json") (encode exec) where rundir = ePath exec setup = callHooks "setup" . eScenario run = callHooks "run" . eScenario teardown = callHooks "teardown" . eScenario - analyze = callHooks "analyze" . eScenario - recover = callHooks "recover" . eScenario - callHooks key sc = maybe (error $ "no such hook: " ++ key) unAction (M.lookup key $ sHooks sc) + analyze exec = liftIO (putStrLn $ advertise exec) >> callHooks "analyze" (eScenario exec) + recover err exec = unAction (doRecover err) + where doRecover = fromMaybe (\_ -> Action $ return ()) (sRecoveryAction $ eScenario exec) result exec = return . defaultResult exec load :: ScenarioDescription EnvIO -> EnvIO [Execution EnvIO] @@ -127,6 +127,13 @@ where forStored (Stored params path status) = Exec sc params path status log exec = return $ defaultLog exec + rm exec = liftIO $ removeDirectoryRecursive $ ePath exec + + callHooks key sc = maybe (error $ "no such hook: " ++ key) unAction (M.lookup key $ sHooks sc) + advertise exec = unlines [ "scenario: " ++ (show . sName . eScenario) exec + , "rundir: " ++ ePath exec + , "json-params: " ++ (C.unpack . encode . eParamSet) exec + ] -- | Default result handler for the 'EnvIO' monad (see 'defaultBackend'). defaultResult :: Execution m -> String -> Result EnvIO diff --git a/Laborantin/Types.hs b/Laborantin/Types.hs --- a/Laborantin/Types.hs +++ b/Laborantin/Types.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TupleSections #-} +{-# LANGUAGE FlexibleInstances #-} module Laborantin.Types ( ScenarioDescription (..) @@ -7,11 +8,13 @@ , ParameterSpace , ParameterSet , paramSets + , expandValue , Result (..) , Backend (..) , Execution (..) , StoredExecution (..) , ExecutionError (..) + , AnalysisError (..) , ExecutionStatus (..) , Finalizer (..) , LogHandler (..) @@ -29,9 +32,14 @@ type ParameterSpace = M.Map String ParameterDescription data ExecutionError = ExecutionError String deriving (Show) +data AnalysisError = AnalysisError String + deriving (Show) instance Error ExecutionError where noMsg = ExecutionError "A String Error!" strMsg = ExecutionError +instance Error AnalysisError where + noMsg = AnalysisError "A String Error!" + strMsg = AnalysisError type Step m a = ErrorT ExecutionError (ReaderT (Backend m,Execution m) m) a newtype Action m = Action { unAction :: Step m () } @@ -39,11 +47,15 @@ instance Show (Action m) where show _ = "(Action)" +instance Show (ExecutionError -> Action m) where + show _ = "(Error-recovery action)" + data ScenarioDescription m = SDesc { sName :: String , sDesc :: String , sParams :: ParameterSpace , sHooks :: M.Map String (Action m) + , sRecoveryAction :: Maybe (ExecutionError -> Action m) } deriving (Show) data ParameterDescription = PDesc { @@ -61,7 +73,7 @@ type ParameterSet = M.Map String ParameterValue data ExecutionStatus = Running | Success | Failure - deriving (Show,Read) + deriving (Show,Read,Eq) data Execution m = Exec { eScenario :: ScenarioDescription m @@ -94,10 +106,11 @@ , bRun :: Execution m -> Step m () , bTeardown :: Execution m -> Step m () , bAnalyze :: Execution m -> Step m () - , bRecover :: Execution m -> Step m () + , bRecover :: ExecutionError -> Execution m -> Step m () , bResult :: Execution m -> String -> Step m (Result m) , bLoad :: ScenarioDescription m -> m [Execution m] , bLogger :: Execution m -> Step m (LogHandler m) + , bRemove :: Execution m -> m () } data Result m = Result { diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,14 +1,125 @@ laborantin-hs ============= -Haskell meets Laborantin +Initially, Laborantin is a Ruby framework for controlling and managing +experiments. Laborantin-Hs is the Haskell port of Laborantin. +# Introduction +Designing scientific experiments is hard. Scientific experiments often must +test an hypothesis such as *does parameter X* influences the outcome of *process A* ? +Experimenters must write code to run the *process A*, a task that may be daunting +when it comes to setting up machines remotely or calling half-a-dozen of shell +scripts to edit configurations such as firewall settings for computer networks. +As a result of spending time to prepare and debug the code for *process A*, +little time is left for writing the code around *parameter X*. + +In general, running scientific experiments requires a number of actions such as: + - writing code for the experiments themselves + - preparing the system for conducting experiments + - actually conducting the experiments + - organizing results for the experiments + - documenting the experiments + - analyzing the results of experiments + +Analyzing results itself is an experiment because a sound analyses also requires +steps such as: + - writing code for the analyses themselves + - actually conducting the analyses + - organizing results for the analyses + - [...] + +After each analysis step, the scientist may want to run extra experiments if +some questions are not fully answered, or if new questions arise. These extra +experiments again ask for the same care in preparing/conducting/analyzing +experiments. Laborantin is a framework to help you along this iterative +process. + +Laborantin is moving away from Ruby and adopted Haskell for two distinct +reasons. First, Haskell is a functional programming language and it is easier +to reuse chunk of codes in declarative DSLs (Domain Specific Languages) with +functional programming languages than scripting languages (although Ruby is +great for DSLs too). Second, Haskell has a very powerful type system and it +allows to catch a whole set of bugs at compile time. While I may consider the +first point on DSLs open for debate, this second point is the nail in the +coffin: real-world experiments generally involve a time-consuming phase where +we act on the physical world (e.g., sending hundreds of network packets spaced +in time). You do not want to lose minutes because a typo crashed your +experiment: it is infuriating and stressful. You typically cannot write tests +for this type of "effects on the real-world-only" code. Nor it is possible to +mock and write unit tests for the whole world when you are under pressure for +getting results for your research. Thus, Haskell's opinionated choices to +segregate effectful code from pure code and Haskell's obnoxious type system are +a time saver in code for running experiments. One drawback of using Haskell is +that Laborantin-Hs needs a compilation phase now (i.e., Laborantin-Hs is more a +library than a command-line utility). Somehow, I think that the pros far +outweigh the cons. Plus, it seems possible to write a `labor`-like script +for Laborantin-Hs that will compile the project or call `runhaskell` +underneath. + +Laborantin-Hs brings the following to the experimenter: + - a clean DSL to express scenarios, parameters, as well as raw data an + product analysis + - an execution engine that runs scenarios, exhausting the parameter space for you + - a default backend to store executed scenarios data and metadata in the + filesystem + - auto-documentation features to later generate simple HTML reports + - the full power of Haskell type-system to catch runtime errors at compile time + +With releasing Laborantin for free and under an open-source license, our goal +is to make sure that your precious expert time is used in productive efforts. This +is not a purely altruistic goal because I want to benefit from your good +science asap. Another goal of Laborantin is to empower scientists who want to +open their code and datasets more easily than possible nowadays. + +# Historical anecdote + +A pattern I started with, and that I have seen often while observing my peers +is to encode parameters in filename such as process_A_parameterX1.dat to store +a data result and `process_A_parameterX2.dat`. For instance +`ping_grenouille.com_1500.dat`. Such a scheme is okay for a first shot but +quickly becomes opaque past a few parameters, or when you have +special characters in string parameters. Plus, with evolving version of *process +A* into finer and finer refinements a whole genealogy of experiments unrolls +and the number of required result files explodes. A similar effect happens as +the number of result files needed grows or as the number of parameters +increases. + +After failing to manage sound experiments with mere bash scripts encoding +parameters in filenames, an obvious next step is to use a build system such as +`make` to run experiments. Makefiles help, but they only work for so long. +Make is a build system for managing dependencies in a build process. I think +you can use `make` to explore a set of parameters, but it looks totally +unnatural to write rules for encoding and decoding parameters in filenames. In +the end, your Makefile is barely decipherable and you need the Rosetta stone +to remember what `%<` means because your web search engine will simply ignore +the glyph. Thus, documenting the experiments while evolving the set of +experiments quickly becomes painful. You can try to work around by combining +`make` with shell scripts and environment variables but the coupling between +different files becomes so tight that your experiment project is impossible to +maintain and it will fail in absurd and totally obscure manner. Similarly, I +let you imagine how annoying it is, when you spent a full day writing and +debugging your Makefile and it turns out you need to spend another day to make +sure `make clean` does not wipe all your results because you had an experiment +crash. + +The only way around managing results for an exploding parameter space is to use +a sort of database, and to let the computer manage the database. If you ever +start encoding parameters values or experiment names in filenames, you are +doing it wrong. It is exactly the same as that using a spoon to drive a +screw: it works but it is a lot of effort. Laborantin is out, free, and +open-source: use it, fork it, or clone it. + +# Roadmap + + # TODO -* more doc +* save timing of scenario executions in default backend +* standalone query expression module * use Text rather than String where appropriate -* defaultMain with run/describe/find/analyze/rm modes -* in-memory (pure?) backend -* dependency annotations -* configuration reader +* dependency type with annotations to execute missing dependencies +* dumb dependency solver +* selector to load prior results +* "require" helper that sets a dep+selection +* exports to propose exported files using "show-exports" command diff --git a/laborantin-hs.cabal b/laborantin-hs.cabal --- a/laborantin-hs.cabal +++ b/laborantin-hs.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: laborantin-hs -version: 0.1.0.0 +version: 0.1.1.0 synopsis: an experiment management framework -- description: homepage: https://github.com/lucasdicioccio/laborantin-hs @@ -20,6 +20,6 @@ exposed-modules: Laborantin, Laborantin.DSL, Laborantin.Implementation, Laborantin.Types -- other-modules: 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 + 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 -- hs-source-dirs: default-language: Haskell2010