packages feed

gipeda 0.1.2.1 → 0.2

raw patch · 10 files changed

+200/−66 lines, 10 filesdep ~aeson

Dependency ranges changed: aeson

Files

README.md view
@@ -14,7 +14,7 @@ the `logs/` directory, gipeda is happy.  Gipeda produces static pages. In fact, the (single) html file and the-accompagning JavaScript code is completely static. Giepda just generates a+accompagning JavaScript code is completely static. Gipeda just generates a large number of json files. This has the advantage of easy deployment: Just put gipeda in your webspace of copy the files to some static web hosting and you are done. This putts very little load on your server, is cache friendly and has@@ -32,10 +32,10 @@ -------------   * Clone gipeda somewhere, possibly directly into your webspace.- * Install a Haskell compiler, including the `cablal` tool.+ * Install a Haskell compiler, including the `cabal` tool.  * Install a few packages -        apt-get install git unzip libfile-slurp-perl libipc-run-perl+        apt-get install git unzip libfile-slurp-perl libipc-run-perl libicu-dev   * Install the dependencies: @@ -69,7 +69,7 @@ into the directory `logs`, named `<gitrev>.log`, e.g. `logs/0279a7d327a3b962ffa93a95d47ea5d9ee31e25c.log`. -Then create a script `log2csv` that expects the filename of such a log on on+Then create a script `log2csv` that expects the filename of such a log on the command line and produces the desired CSV file.  Running gipeda
gipeda.cabal view
@@ -1,5 +1,5 @@ name:                gipeda-version:             0.1.2.1+version:             0.2 category:            Development synopsis:            Git Performance Dashboard description:@@ -77,7 +77,7 @@       vector               >= 0.10 && <0.12,       cassava              >= 0.4  && <0.5,       yaml                 >= 0.8  && <0.9,-      aeson                >= 0.7  && <0.10,+      aeson                >= 0.7  && <0.11,       scientific           >= 0.3  && <0.4,       gitlib               >= 3.1  && <3.2,       gitlib-libgit2,
install-jslibs.sh view
@@ -33,5 +33,5 @@ 	rm -f bootstrap-3.3.1-dist.zip 	cd .. 	}-test -e naturalSort.j ||+test -e naturalSort.js || 	wget -c https://raw.githubusercontent.com/overset/javascript-natural-sort/master/naturalSort.js
site/index.html view
@@ -84,6 +84,13 @@     background-color: #fcf8e3; } +.branch-improvement , .row-Improvement {+    background-color: #dff0d8;+}+.branch-regression, .row-Regression {+    background-color: #fcf8e3;+}+ .benchmark-name a.graph-link {     visibility:hidden; }@@ -252,6 +259,59 @@   </table> </script> +<script id="branches"  type="text/x-handlebars-template">+  <h2>Branches</h2>+  <table class="table branch-table">+   {{#each_unnaturally branches}}+     {{#with (lookup ../revisions this)}}+      {{#with this.summary}}+      <tr+       class="+         branch-row+         {{#if stats.improvementCount}}branch-improvement{{/if}}+         {{#if stats.regressionCount}}branch-regression{{/if}}+       ">+       <td class="col-md-2 text-right">+	 <abbrv class="timeago" title="{{ iso8601 this.gitDate }}">{{ humanDate this.gitDate}}</abbrv>+       </td>+       <td class="col-md-1">+	<a href="{{revisionLink hash}}">+          {{> rev-id hash=hash}}+	</a>+       </td>+       <td class="col-md-2">+	 <strong>{{ @key }}</strong>+       </td>+       <td class="col-md-5">+	 {{ gitSubject }}+       </td>+       <td class="col-md-2 text-right">+        {{> summary-icons stats}}+       </td>+      </tr>+      {{/with}}+     {{else}}+      <tr+       title="The tip of this branch has not been benchmarked yet"+       class="branch-row">+       <td class="col-md-2 text-right">+       </td>+       <td class="col-md-1">+          {{> rev-id hash=this}}+       </td>+       <td class="col-md-2">+	 {{ @key }}+       </td>+       <td class="col-md-5">+       </td>+       <td class="col-md-2 text-right">+       </td>+      </tr>+     {{/with}}+   {{/each_unnaturally}}+  </table>+</script>+ <script id="revTooltip" type="text/x-handlebars-template">  <a href="{{revisionLink hash}}">   {{> rev-id hash=hash}}@@ -333,13 +393,16 @@  <div class="container">   <h1>Recent commits</h1>   {{> summary-list (recentCommits revisions)}}-  {{> tags }}- </div>- <div class="container">   <p class="text-center">     <a href="{{allLink}}">view older commits...</a>   </p>  </div>+ <div class="container">+  {{> tags }}+ </div>+ <div class="container">+  {{> branches }}+ </div> </script>  <script id="complete" type="text/x-handlebars-template">@@ -348,6 +411,7 @@   <h1>All commits</h1>   {{> summary-list (allCommits revisions)}}   {{> tags }}+  {{> branches }}  </div> </script> @@ -364,20 +428,15 @@     </h2>     <p>     {{#if rev.summary.parents}}-    Displaying changes since:+    Parent:     {{#with (lookup rev.summary.parents 0)}}       <a href="{{revisionLink this}}"> 	{{> rev-id hash=this}}-      </a> –-      <a href="{{diffLink this ../rev.summary.hash}}">View diff</a>+      </a>     {{/with}} –-    {{#logLink rev.summary.hash }}-      <a href="{{link}}">View buildlog</a> –-    {{/logLink}}-      {{> summary-icons rev.summary.stats }}-    {{else}}-    No parent commit found.     {{/if}}+    {{revisionInfo rev.summary }} –+    {{> summary-icons rev.summary.stats }}     </p>      <pre>{{rev.gitLog}}</pre>     {{/if}}@@ -468,9 +527,7 @@      {{/each}}</br>       <a href="{{revisionLink rev1.summary.hash}}">{{> rev-id hash=rev1.summary.hash}}</a> <abbrv class="timeago" title="{{ iso8601 gitDate }}">{{ humanDate rev1.summary.gitDate}}</abbrv>:<br/>      <strong>{{ rev1.summary.gitSubject }}</strong><br/>-     {{#logLink rev1.summary.hash }}-      <a href="{{link}}">buildlog</a>-     {{/logLink}}+     {{revisionInfo rev1.summary }}     </p>     <p class="text-center">       ⁞<br/>@@ -484,9 +541,7 @@      {{/each}}</br>       <a href="{{revisionLink rev2.summary.hash}}">{{> rev-id hash=rev2.summary.hash}}</a> <abbrv class="timeago" title="{{ iso8601 gitDate }}">{{ humanDate rev2.summary.gitDate}}</abbrv>:<br/>      <strong>{{ rev2.summary.gitSubject }}</strong><br/>-     {{#logLink rev2.summary.hash }}-      <a href="{{link}}">buildlog</a>-     {{/logLink}}+     {{revisionInfo rev2.summary }}     </p>     {{/if}} {{/if}}    </div>
site/js/gipeda.js view
@@ -150,7 +150,7 @@     templates[id] = Handlebars.compile(source);   }); -  var partials_ids =  ["nav", "summary-icons", "summary-list", "rev-id", "nothing", "tags"];+  var partials_ids =  ["nav", "summary-icons", "summary-list", "rev-id", "nothing", "tags", "branches"];   partials_ids.forEach(function(id) {     var source = $("#" + id).html();     Handlebars.registerPartial(id, source);@@ -174,14 +174,20 @@     return "#" + routes.graph.url(benchName,hls); }); Handlebars.registerHelper('diffLink', function(rev1, rev2) {-    return Handlebars.compile(data.settings.diffLink)({base: rev1, rev: rev2});+    if (data.settings.diffLink) {+	return Handlebars.compile(data.settings.diffLink)({base: rev1, rev: rev2});+    } else {+	return 'javascript:alert("No diffLink defined in settings")';+    } });-Handlebars.registerHelper('logLink', function(rev, options) {-  if (data.settings.logLink) {-    var link = Handlebars.compile(data.settings.logLink)({rev: rev});-    $.extend(this,{link:link});-    return options.fn(this);-  }+Handlebars.registerHelper('revisionInfo', function(revSummary) {+    var ctxt = {};+    ctxt.rev = revSummary.hash;+    if (revSummary.parents) {+	ctxt.base=revSummary.parents[0];+    }+    var result = Handlebars.compile(data.settings.revisionInfo)(ctxt);+    return new Handlebars.SafeString(result); }); Handlebars.registerHelper('indexLink', function() {   return "#" + routes.index.url();@@ -234,7 +240,9 @@     if (context) { 	console.log(context); 	var keys = jQuery.map(context, function(v,k) {return k});-	var sorted_keys = keys.sort(naturalSort).reverse();+        // needs https://github.com/overset/javascript-natural-sort/issues/21 fixed+	//var sorted_keys = keys.sort(naturalSort).reverse();+	var sorted_keys = keys.sort().reverse(); 	sorted_keys.map(function (k,i) { 	    output += options.fn(context[k], {data: {key: k, index: i}}); 	});@@ -355,9 +363,9 @@                  if (Math.abs(perc) >= s.threshold) {                     if (perc >= 0) {-                        s.changeType = "Improvement";+                        res.changeType = "Improvement";                     } else {-                        s.changeType = "Regression";+                        res.changeType = "Regression";                     }                 }             }
src/BenchmarkSettings.hs view
@@ -84,22 +84,24 @@  data Settings = Settings    { title :: String-   , diffLink :: String-   , logLink :: Maybe String+   , revisionInfo :: String+   , diffLink :: Maybe String    , limitRecent :: Integer    , start :: String    , interestingTags :: Maybe String+   , interestingBranches :: Maybe String    , benchSettings :: BenchName -> BenchSettings    }  instance FromJSON Settings where     parseJSON (Object v) =         Settings <$> v .: "title"+                 <*> v .: "revisionInfo"                  <*> v .: "diffLink"-                 <*> v .:? "logLink"                  <*> v .: "limitRecent"                  <*> v .: "start"                  <*> v .:? "interestingTags"+                 <*> v .:? "interestingBranches"                  <*> (unS <$> v.: "benchmarks")     parseJSON _ = mzero 
src/Development/Shake/Gitlib.hs view
@@ -5,6 +5,7 @@     , getGitContents     , doesGitFileExist     , readGitFile+    , isGitAncestor     ) where  import System.IO@@ -13,6 +14,7 @@ import qualified Data.Text.Encoding as T import Data.Functor import Data.Maybe+import System.Exit   import Development.Shake@@ -36,6 +38,9 @@ newtype GetGitFileRefQ = GetGitFileRefQ (RepoPath, RefName, FilePath)     deriving (Typeable,Eq,Hashable,Binary,NFData,Show) +newtype IsGitAncestorQ = IsGitAncestorQ (RepoPath, RefName, RefName)+    deriving (Typeable,Eq,Hashable,Binary,NFData,Show)+ instance Rule GetGitReferenceQ GitSHA where     storedValue _ (GetGitReferenceQ (repoPath, name)) = do         Just . GitSHA <$> getGitReference' repoPath name@@ -45,11 +50,19 @@         ref' <- getGitReference' repoPath name         Just <$> getGitFileRef' repoPath ref' filename +instance Rule IsGitAncestorQ Bool where+    storedValue _ (IsGitAncestorQ (repoPath, ancestor, child)) = do+        Just <$> isGitAncestor' repoPath ancestor child+ getGitReference :: RepoPath -> String -> Action String getGitReference repoPath refName = do     GitSHA ref' <- apply1 $ GetGitReferenceQ (repoPath, T.pack refName)     return $ T.unpack ref' +isGitAncestor :: RepoPath -> String -> String -> Action Bool+isGitAncestor repoPath ancName childName = do+    apply1 $ IsGitAncestorQ (repoPath, T.pack ancName, T.pack childName)+ getGitContents :: RepoPath -> Action [FilePath] getGitContents repoPath = do     GitSHA ref' <- apply1 $ GetGitReferenceQ (repoPath, "HEAD")@@ -77,6 +90,12 @@ getGitReference' repoPath refName = do     T.pack . concat . lines . fromStdout <$> cmd ["git", "-C", repoPath, "rev-parse", T.unpack refName++"^{commit}"] +isGitAncestor' :: RepoPath -> RefName -> RefName -> IO Bool+-- Easier using git+isGitAncestor' repoPath ancName childName = do+    Exit c <- cmd ["git", "-C", repoPath, "merge-base", "--is-ancestor", T.unpack ancName, T.unpack childName]+    return (c == ExitSuccess)+ getGitFileRef' :: RepoPath -> T.Text -> FilePath -> IO (Maybe T.Text) getGitFileRef' repoPath ref' fn = do     withRepository lgFactory repoPath $ do@@ -109,4 +128,6 @@     rule $ \(GetGitFileRefQ (repoPath, refName, fn)) -> Just $ do         GitSHA ref' <- apply1 $ GetGitReferenceQ (repoPath, "HEAD")         liftIO $ getGitFileRef' repoPath ref' fn+    rule $ \(IsGitAncestorQ (repoPath, ancName, childName)) -> Just $ liftIO $+        isGitAncestor' repoPath ancName childName 
src/ReportTypes.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveGeneric, ViewPatterns, RecordWildCards, OverloadedStrings #-}+{-# LANGUAGE DeriveGeneric, ViewPatterns, RecordWildCards, OverloadedStrings, CPP #-}  module ReportTypes where @@ -16,8 +16,8 @@  data ClientSettings = ClientSettings    { title :: String-   , diffLink :: String-   , logLink :: String+   , revisionInfo :: String+   , diffLink :: Maybe String    }  deriving (Generic) instance ToJSON ClientSettings@@ -107,6 +107,9 @@  deriving (Generic) instance ToJSON BenchResult where     toJSON = genericToJSON defaultOptions+#if MIN_VERSION_aeson(0,10,0)+    toEncoding = genericToEncoding defaultOptions+#endif instance FromJSON BenchResult where     parseJSON = genericParseJSON defaultOptions @@ -117,11 +120,15 @@     }  deriving (Generic) instance ToJSON GraphPoint where-    toJSON = genericToJSON (defaultOptions { fieldLabelModifier = fixup })+    toJSON = genericToJSON graphPointOptions+#if MIN_VERSION_aeson(0,10,0)+    toEncoding = genericToEncoding graphPointOptions+#endif instance FromJSON GraphPoint where-    parseJSON = genericParseJSON (defaultOptions {fieldLabelModifier = fixup })+    parseJSON = genericParseJSON graphPointOptions -fixup ('g':'p':c:cs) = toLower c : cs+graphPointOptions = defaultOptions { fieldLabelModifier = fixup }+  where fixup ('g':'p':c:cs) = toLower c : cs  benchResultToGraphPoint (BenchResult {..}) = GraphPoint     { gpValue = value
src/RevReport.hs view
@@ -7,6 +7,7 @@ import qualified Data.ByteString.Lazy as BS import Data.Aeson import Development.Shake.Command+import Text.Read  import ReportTypes import ReadResult@@ -28,7 +29,10 @@         _   -> fromStdout <$> git ["show", "-s", this]      msg <- fromStdout <$> git ["show", "--format=%s", "-s", this]-    date <- read . fromStdout <$> git ["show", "--format=%ct","-s",this]+    dateS <- fromStdout <$> git ["show", "--format=%ct","-s",this]+    date <- case readMaybe dateS of+	Just date -> return date+	Nothing -> error $ "Could not parse date " ++ show dateS      let rep = createReport settings this parents thisM parentM log msg date     let doc = emptyGlobalReport { revisions = Just (M.singleton this rep) }
src/Shake.hs view
@@ -38,12 +38,13 @@     -- orderOnly ["gipeda"]     cmd (Traced name) "./gipeda" name args -gitRange :: Action String+gitRange :: Action [String] gitRange = do     s <- liftIO $ S.readSettings "settings.yaml"     let first = S.start s-    [head] <- readFileLines "site/out/head.txt"-    return $ first ++ ".." ++ head+    heads <- readFileLines "site/out/heads.txt"+    Stdout range <- git "log" $ ["--format=%H","^"++first] ++ heads+    return $ words range  needIfThere :: [FilePath] -> Action [FilePath] needIfThere files = do@@ -83,7 +84,7 @@     haveLogs <- System.Directory.doesDirectoryExist "logs"     if haveLogs     then do-        Stdout s <- cmd "git -C logs rev-parse --is-bare-repository"+        (Exit _, Stdouterr s) <- cmd "git -C logs rev-parse --is-bare-repository"         if s == "true\n"         then return BareGit         else return FileSystem@@ -92,7 +93,6 @@ shakeMain :: IO () shakeMain = do     logSource <- determineLogSource-    print logSource      shakeArgs shakeOptions $ do     defaultRuleGitLib@@ -110,17 +110,13 @@         S.limitRecent <$> liftIO (S.readSettings "settings.yaml")      "reports" ~> do-        range <- gitRange-        Stdout range <- git "log" ["--format=%H",range]-        let hashes = words range+        hashes <- gitRange         withLogs <- filterM (doesLogExist logSource) hashes         need $ map reportOf withLogs     want ["reports"]      "summaries" ~> do-        range <- gitRange-        Stdout range <- git "log" ["--format=%H",range]-        let hashes = words range+        hashes <- gitRange         withLogs <- filterM (doesLogExist logSource) hashes         need $ map summaryOf withLogs     want ["summaries"]@@ -130,10 +126,29 @@         Stdout stdout <- git "rev-parse" ["master"]         writeFileChanged out stdout +    "site/out/heads.txt" *> \ out -> do+        tags <- readFileLines "site/out/tags.txt"+        tagHashes <- forM tags $ \t -> do+            getGitReference "repository" ("refs/tags/" ++ t) +        branches <- readFileLines "site/out/branches.txt"+        branchHashes <- forM branches $ \t -> do+            getGitReference "repository" ("refs/heads/" ++ t)++        masterHash <- getGitReference "repository" "refs/heads/master"++        let heads = nub $ masterHash : tagHashes ++ branchHashes+        writeFileChanged out $ unlines $ heads++     "site/out/history.csv" *> \out -> do-        range <- gitRange-        Stdout stdout <- git "log" ["--format=%H;%P",range]+        heads <- readFileLines "site/out/heads.txt"++        s <- liftIO $ S.readSettings "settings.yaml"+        let first = S.start s++        Stdout stdout <- git "log" $+                "--format=%H;%P": ("^"++first) : heads         writeFileChanged out stdout     want ["site/out/history.csv"] @@ -164,8 +179,23 @@                 writeFileChanged out ""             Just pattern -> do                 Stdout tags <- git "tag" ["-l", pattern]-                writeFileChanged out tags+                tags' <- filterM (isGitAncestor "repository" (S.start s)) (lines tags)+                writeFileChanged out (unlines tags') +    "site/out/branches.txt" *> \ out -> do+        alwaysRerun++        need ["settings.yaml"]+        s <- liftIO $ S.readSettings "settings.yaml"+        case S.interestingBranches s of+            Nothing ->+                writeFileChanged out ""+            Just pattern -> do+                Stdout branches <- git "branch" ["--list", pattern]+                branches <- filterM (isGitAncestor "repository" (S.start s)) (map (drop 2) $ lines branches)+                branches <- filterM (\b -> not <$> isGitAncestor "repository" b "master") branches+                writeFileChanged out (unlines branches)+     "graphs" ~> do         [latest] <- readFileLines "site/out/latest.txt"         need [resultsOf latest]@@ -226,11 +256,20 @@         tagsAndHashes <- forM tags $ \t -> do             h <- getGitReference "repository" ("refs/tags/" ++ t)             return $ (t, h)-        let o = object [ T.pack "tags" .= object [ (T.pack t .= h) | (t,h) <- tagsAndHashes ]]++        branches <- readFileLines "site/out/branches.txt"+        branchesAndHashes <- forM branches $ \t -> do+            h <- getGitReference "repository" ("refs/heads/" ++ t)+            return $ (t, h)++        let o = object+                [ T.pack "tags" .= object [ (T.pack t .= h) | (t,h) <- tagsAndHashes ]+                , T.pack "branches" .= object [ (T.pack t .= h) | (t,h) <- branchesAndHashes ]+                ]         liftIO $ LBS.writeFile out (encode o)-        tagCommits <- filterM (doesLogExist logSource) (map snd tagsAndHashes)+        extraCommits <- filterM (doesLogExist logSource) (map snd tagsAndHashes ++ map snd branchesAndHashes) -        let revs = nub $ recentCommits ++ tagCommits+        let revs = nub $ recentCommits ++ extraCommits          need $ map summaryOf revs @@ -265,9 +304,7 @@       "site/out/all-summaries.json" *> \out -> do-        range <- gitRange-        Stdout range <- git "log" ["--format=%H",range]-        let hashes = words range+        hashes <- gitRange         revs <- filterM (doesLogExist logSource) hashes         need (map summaryOf revs)