Include tags in latest-summaries.json and display them
authorJoachim Breitner <mail@joachim-breitner.de>
Sun, 31 May 2015 16:22:35 +0000 (18:22 +0200)
committerJoachim Breitner <mail@joachim-breitner.de>
Sun, 31 May 2015 16:42:44 +0000 (18:42 +0200)
example/settings.yaml
ghc/settings.yaml
gipeda.cabal
site/index.html
site/js/gipeda.js
src/BenchmarkSettings.hs
src/Development/Shake/Gitlib.hs
src/IndexReport.hs [deleted file]
src/Shake.hs
src/gipeda.hs

index b67796e..ee0b96c 100644 (file)
@@ -3,6 +3,7 @@ cgitLink: https://github.com/nomeata/gipeda/commit/
 # logLink: https://raw.githubusercontent.com/nomeata/ghc-speed-logs/master/{{rev}}.log
 limitRecent: 20
 start: 65b3eede043ff5d4718724d220a82bbc8adc3280
+interestingTags: "*"
 
 benchmarks:
   - match: "*"
index 47ebf1b..5af21ce 100644 (file)
@@ -3,6 +3,7 @@ cgitLink: https://git.haskell.org/ghc.git
 logLink: https://raw.githubusercontent.com/nomeata/ghc-speed-logs/master/{{rev}}.log
 limitRecent: 50
 start: 55e7ab1210975e6276f3cab3ac0e1f35bcd772f0
+interestingTags: "*-release"
 
 benchmarks:
   - match: "*"
index a452030..c88cf77 100644 (file)
@@ -46,7 +46,6 @@ executable gipeda
     BenchmarksInCSV,
     BenchNames,
     GraphReport,
-    IndexReport,
     JsonSettings,
     JsonUtils,
     ParentMap,
index 43eaa26..1555ed7 100644 (file)
@@ -195,6 +195,55 @@ html {
   </table>
 </script>
 
+<script id="tags"  type="text/x-handlebars-template">
+  <h2>Tags</h2>
+  <table class="table tag-table">
+   {{#each tags}}
+     {{#with (lookup ../revisions this)}}
+      {{#with this.summary}}
+      <tr
+       class="
+        tag-row
+        {{#if stats.improvementCount}}summary-improvement{{/if}}
+        {{#if stats.regressionCount}}summary-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}}">
+         <code>{{shortRev hash}}</code>
+       </a>
+       </td>
+       <td class="col-md-7">
+        <strong>{{ @key }}</strong>
+        {{ gitSubject }}
+       </td>
+       <td class="col-md-2 text-right">
+       {{> summary-icons stats}}
+       </td>
+      </tr>
+      {{/with}}
+     {{else}}
+      <tr
+       title="This tag has not been benchmarked yet"
+       class="tag-row">
+       <td class="col-md-2 text-right">
+       </td>
+       <td class="col-md-1">
+         <code>{{shortRev this}}</code>
+       </td>
+       <td class="col-md-7">
+        {{ @key }}
+       </td>
+       <td class="col-md-2 text-right">
+       </td>
+      </tr>
+     {{/with}}
+   {{/each}}
+  </table>
+</script>
+
 <script id="revTooltip" type="text/x-handlebars-template">
  <a href="{{revisionLink hash}}"><code>{{shortRev hash}}</code></a>:
  {{ value }}<br/>
@@ -274,6 +323,7 @@ html {
  <div class="container">
   <h1>Recent commits</h1>
   {{> summary-list (recentCommits revisions)}}
+  {{> tags }}
  </div>
  <div class="container">
   <p class="text-center">
@@ -287,6 +337,7 @@ html {
  <div class="container">
   <h1>All commits</h1>
   {{> summary-list (allCommits revisions)}}
+  {{> tags }}
  </div>
 </script>
 
index c612194..f090a86 100644 (file)
@@ -146,7 +146,7 @@ $(function ()  {
     templates[id] = Handlebars.compile(source);
   });
 
-  var partials_ids =  ["nav", "summary-icons", "summary-list", "nothing"];
+  var partials_ids =  ["nav", "summary-icons", "summary-list", "nothing", "tags"];
   partials_ids.forEach(function(id) {
     var source = $("#" + id).html();
     Handlebars.registerPartial(id, source);
index 278edb0..14a5b65 100644 (file)
@@ -88,6 +88,7 @@ data Settings = Settings
    , logLink :: Maybe String
    , limitRecent :: Integer
    , start :: String
+   , interestingTags :: Maybe String
    , benchSettings :: BenchName -> BenchSettings
    }
 
@@ -98,6 +99,7 @@ instance FromJSON Settings where
                  <*> v .:? "logLink"
                  <*> v .: "limitRecent"
                  <*> v .: "start"
+                 <*> v .:? "interestingTags"
                  <*> (unS <$> v.: "benchmarks")
     parseJSON _ = mzero
 
index ceb27a7..c0e37ce 100644 (file)
@@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedStrings, DeriveDataTypeable, GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleInstances #-}
 module Development.Shake.Gitlib
     ( defaultRuleGitLib
+    , getGitReference
     , getGitContents
     , doesGitFileExist
     , readGitFile
@@ -44,6 +45,11 @@ instance Rule GetGitFileRefQ (Maybe T.Text) where
         ref' <- getGitReference' repoPath name
         Just <$> getGitFileRef' repoPath ref' filename
 
+getGitReference :: RepoPath -> String -> Action String
+getGitReference repoPath refName = do
+    GitSHA ref' <- apply1 $ GetGitReferenceQ (repoPath, T.pack refName)
+    return $ T.unpack ref'
+
 getGitContents :: RepoPath -> Action [FilePath]
 getGitContents repoPath = do
     GitSHA ref' <- apply1 $ GetGitReferenceQ (repoPath, "HEAD")
diff --git a/src/IndexReport.hs b/src/IndexReport.hs
deleted file mode 100644 (file)
index d3ad06e..0000000
+++ /dev/null
@@ -1,19 +0,0 @@
-module IndexReport where
-
-import qualified Data.ByteString.Lazy as BS
-import Data.Aeson
-import Control.Monad
-
-import Paths
-import JsonUtils
-
-
-indexReportsMain :: [FilePath] -> IO ()
-indexReportsMain revs = do
-    g <- forM revs $ \rev -> do
-        json <- BS.readFile (summaryOf rev)
-        case eitherDecode json of
-            Left e -> fail e
-            Right rep -> return (rep :: Value)
-
-    BS.putStr (encode (merges g))
index bd38d7e..218cd45 100644 (file)
@@ -12,7 +12,10 @@ import Data.Functor
 import Data.List
 import System.IO.Extra (newTempFile)
 import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
 import qualified System.Directory
+import Data.Aeson
+import qualified Data.Text as T
 
 import Development.Shake.Gitlib
 
@@ -20,6 +23,7 @@ import Paths hiding (Hash)
 import ParentMap
 import BenchmarksInCSV
 import qualified BenchmarkSettings as S
+import JsonUtils
 
 {- Global settings -}
 cGRAPH_HISTORY :: Integer
@@ -150,6 +154,18 @@ shakeMain = do
            Nothing ->
                 fail "Head has no parent with logs?"
 
+    "site/out/tags.txt" *> \ out -> do
+        alwaysRerun
+
+        need ["settings.yaml"]
+        s <- liftIO $ S.readSettings "settings.yaml"
+        case S.interestingTags s of
+            Nothing ->
+                writeFileChanged out ""
+            Just pattern -> do
+                Stdout tags <- git "tag" ["-l", pattern]
+                writeFileChanged out tags
+
     "graphs" ~> do
         [latest] <- readFileLines "site/out/latest.txt"
         need [resultsOf latest]
@@ -204,11 +220,26 @@ shakeMain = do
 
     "site/out/latest-summaries.json" *> \out -> do
         [latest] <- readFileLines "site/out/latest.txt"
-        r <- recent cGRAPH_HISTORY latest
-        need (map summaryOf r)
-
-        Stdout json <- self "IndexReport" r
-        writeFile' out json
+        recentCommits <- recent cGRAPH_HISTORY latest
+
+        tags <- readFileLines "site/out/tags.txt"
+        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 ]]
+        liftIO $ LBS.writeFile out (encode o)
+        tagCommits <- filterM (doesLogExist logSource) (map snd tagsAndHashes)
+
+        let revs = nub $ recentCommits ++ tagCommits
+
+        need $ map summaryOf revs
+
+        g <- forM revs $ \rev -> do
+            json <- liftIO $ LBS.readFile (summaryOf rev)
+            case eitherDecode json of
+                Left e -> fail e
+                Right rep -> return (rep :: Value)
+        liftIO $ LBS.writeFile out (encode (merges (o:g)))
     want ["site/out/latest-summaries.json"]
 
     "site/out/graph-summaries.json" *> \out -> do
@@ -237,11 +268,15 @@ shakeMain = do
         range <- gitRange
         Stdout range <- git "log" ["--format=%H",range]
         let hashes = words range
-        withLogs <- filterM (doesLogExist logSource) hashes
-        need (map summaryOf withLogs)
-
-        Stdout json <- self "IndexReport" withLogs
-        writeFile' out json
+        revs <- filterM (doesLogExist logSource) hashes
+        need (map summaryOf revs)
+
+        g <- forM revs $ \rev -> do
+            json <- liftIO $ LBS.readFile (summaryOf rev)
+            case eitherDecode json of
+                Left e -> fail e
+                Right rep -> return (rep :: Value)
+        liftIO $ LBS.writeFile out (encode (merges g))
     want ["site/out/all-summaries.json"]
 
     "site/out/settings.json" *> \out -> do
index 17ec35a..2204228 100644 (file)
@@ -8,7 +8,6 @@ import JsonSettings
 import RevReport
 import WithLatestLogs
 import Summary
-import IndexReport
 import GraphReport
 import BenchNames
 import GraphSummaries
@@ -35,7 +34,6 @@ main = do
 
 
     case args of 
-        "IndexReport":opts    -> indexReportsMain opts
         "JsonSettings":_      -> jsonSettingsMain
         "Summary":opts        -> summaryMain opts
         "RevReport":opts      -> revReportMain opts