summaryrefslogtreecommitdiff
path: root/Benchmark.hs
diff options
context:
space:
mode:
authorJoeyHess <>2019-01-22 16:29:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-01-22 16:29:00 (GMT)
commitf35d8a64c4ddddcfe2c863be337aebb85b2e99c1 (patch)
tree57e7ff21ab433640fe7d6291a393927f5ce16bba /Benchmark.hs
parent526517cc85642e750c87ecd4ae7abd44f7c3decd (diff)
version 7.201901227.20190122
Diffstat (limited to 'Benchmark.hs')
-rw-r--r--Benchmark.hs53
1 files changed, 53 insertions, 0 deletions
diff --git a/Benchmark.hs b/Benchmark.hs
new file mode 100644
index 0000000..35ae9ef
--- /dev/null
+++ b/Benchmark.hs
@@ -0,0 +1,53 @@
+{- git-annex benchmark infrastructure
+ -
+ - Copyright 2019 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+module Benchmark where
+
+import Common
+import Types.Benchmark
+import Types.Command
+import CmdLine.Action
+import CmdLine
+import CmdLine.GitAnnex.Options
+import qualified Annex
+import qualified Annex.Branch
+import Annex.Action
+
+import qualified Options.Applicative as O
+
+{- Given a list of all git-annex Commands, and the user's input,
+ - generates an IO action to benchmark that runs the specified
+ - commands. -}
+mkGenerator :: MkBenchmarkGenerator
+mkGenerator cmds userinput = do
+ -- Get the git-annex branch updated, to avoid the overhead of doing
+ -- so skewing the runtime of the first action that will be
+ -- benchmarked.
+ Annex.Branch.commit "benchmarking"
+ Annex.Branch.update
+ l <- mapM parsesubcommand $ split [";"] userinput
+ return $ do
+ forM_ l $ \(cmd, seek, st) ->
+ -- The cmd is run for benchmarking without startup or
+ -- shutdown actions.
+ Annex.eval st $ performCommandAction cmd seek noop
+ -- Since the cmd will be run many times, some zombie
+ -- processes that normally only occur once per command
+ -- will build up; reap them.
+ reapZombies
+ where
+ -- Simplified versio of CmdLine.dispatch, without support for fuzzy
+ -- matching or out-of-repo commands.
+ parsesubcommand ps = do
+ (cmd, seek, globalconfig) <- liftIO $ O.handleParseResult $
+ parseCmd "git-annex" "benchmarking" gitAnnexGlobalOptions ps cmds cmdparser
+ -- Make an entirely separate Annex state for each subcommand,
+ -- and prepare it to run the cmd.
+ st <- liftIO . Annex.new =<< Annex.getState Annex.repo
+ ((), st') <- liftIO $ Annex.run st $
+ prepRunCommand cmd globalconfig
+ return (cmd, seek, st')