A more sensible branch overview
authorJoachim Breitner <mail@joachim-breitner.de>
Sat, 23 Apr 2016 18:36:44 +0000 (20:36 +0200)
committerJoachim Breitner <mail@joachim-breitner.de>
Sat, 23 Apr 2016 18:36:44 +0000 (20:36 +0200)
by comparing the branch against the merge base, and not just the
previous commit on the branch. Fixes #21.

site/index.html
site/js/gipeda.js
src/Development/Shake/Gitlib.hs
src/Paths.hs
src/ReportTypes.hs
src/RevReport.hs
src/Shake.hs
src/gipeda.hs

index a2786ba..f9465c0 100644 (file)
@@ -263,51 +263,44 @@ html {
   <h2>Branches</h2>
   <table class="table branch-table">
    {{#each_branch 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}}
+    <tr
+     class="
+       branch-row
+       {{#if branchStats.improvementCount}}branch-improvement{{/if}}
+       {{#if branchStats.regressionCount}}branch-regression{{/if}}
+     ">
+     <td class="col-md-2 text-right">
+       {{#with (lookup ../revisions branchHash)}}
+       <abbrv class="timeago" title="{{ iso8601 this.summary.gitDate }}">{{ humanDate this.summary.gitDate}}</abbrv>
+       {{/with}}
+     </td>
+     <td class="col-md-2">
+      {{# if commitCount }}
+       <a href="{{revisionLink mergeBaseHash}}" title="Merge base of this branch">
+         {{> rev-id hash=mergeBaseHash}}
+       </a>
+       <a href="{{compareLink mergeBaseHash branchHash}}" title="Compare against merge base">
+         ..{{ commitCount }}..
+       </a>
+       <a href="{{revisionLink branchHash}}" title="Show branch tip">
+         {{> rev-id hash=branchHash}}
+       </a>
+      {{else}}
+        (no results yet)
+      {{/if}}
+     </td>
+     <td class="col-md-2">
+       <strong>{{ @key }}</strong>
+     </td>
+     <td class="col-md-4">
+       {{#with (lookup ../revisions branchHash)}}
+         {{ summary.gitSubject }}
+       {{/with}}
+     </td>
+     <td class="col-md-2 text-right">
+      {{> summary-icons branchStats}}
+     </td>
+    </tr>
    {{/each_branch}}
   </table>
 </script>
index a45e9c1..ef91c8e 100644 (file)
@@ -250,10 +250,10 @@ Handlebars.registerHelper('each_unnaturally', function(context,options){
 Handlebars.registerHelper('each_branch', function(context,options){
     var output = '';
     if (context) {
-       jQuery.map(context, function (b,i) { return {branchHash: b, branchName: i}; })
+       jQuery.map(context, function (b,i) { return {branchData: b, branchName: i}; })
             .sort(function(a,b) {
-                revA = data.revisions[a.branchHash];
-                revB = data.revisions[b.branchHash];
+                revA = data.revisions[a.branchData.branchHash];
+                revB = data.revisions[b.branchData.branchHash];
                if (revA && revB) {
                     return revB.summary.gitDate - revA.summary.gitDate;
                 }
@@ -265,7 +265,7 @@ Handlebars.registerHelper('each_branch', function(context,options){
                 }
                 return naturalSort(a.branchName, b.branchName);
             }).map(function (b,i) {
-                output += options.fn(b.branchHash, {data: {key: b.branchName, index: i}});
+                output += options.fn(b.branchData, {data: {key: b.branchName, index: i}});
             });
     }
     return output;
index 682b5f2..60c418b 100644 (file)
@@ -6,6 +6,7 @@ module Development.Shake.Gitlib
     , doesGitFileExist
     , readGitFile
     , isGitAncestor
+    , getGitMergeBase
     ) where
 
 import System.IO
@@ -41,6 +42,9 @@ newtype GetGitFileRefQ = GetGitFileRefQ (RepoPath, RefName, FilePath)
 newtype IsGitAncestorQ = IsGitAncestorQ (RepoPath, RefName, RefName)
     deriving (Typeable,Eq,Hashable,Binary,NFData,Show)
 
+newtype GetGitMergeBase = GetGitMergeBase (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
@@ -54,6 +58,10 @@ instance Rule IsGitAncestorQ Bool where
     storedValue _ (IsGitAncestorQ (repoPath, ancestor, child)) = do
         Just <$> isGitAncestor' repoPath ancestor child
 
+instance Rule GetGitMergeBase GitSHA where
+    storedValue _ (GetGitMergeBase (repoPath, baseBranchName, featureBranchName)) = do
+        Just <$> getGitMergeBase' repoPath baseBranchName featureBranchName
+
 getGitReference :: RepoPath -> String -> Action String
 getGitReference repoPath refName = do
     GitSHA ref' <- apply1 $ GetGitReferenceQ (repoPath, T.pack refName)
@@ -63,6 +71,12 @@ isGitAncestor :: RepoPath -> String -> String -> Action Bool
 isGitAncestor repoPath ancName childName = do
     apply1 $ IsGitAncestorQ (repoPath, T.pack ancName, T.pack childName)
 
+getGitMergeBase :: RepoPath -> String -> String -> Action String
+getGitMergeBase repoPath baseBranchName featureBranchName = do
+    GitSHA ref <- apply1 $ GetGitMergeBase (repoPath, T.pack baseBranchName, T.pack featureBranchName)
+    return $ T.unpack ref
+
+
 getGitContents :: RepoPath -> Action [FilePath]
 getGitContents repoPath = do
     GitSHA ref' <- apply1 $ GetGitReferenceQ (repoPath, "HEAD")
@@ -96,6 +110,12 @@ isGitAncestor' repoPath ancName childName = do
     Exit c <- cmd ["git", "-C", repoPath, "merge-base", "--is-ancestor", T.unpack ancName, T.unpack childName]
     return (c == ExitSuccess)
 
+getGitMergeBase' :: RepoPath -> RefName -> RefName -> IO GitSHA
+-- Easier using git
+getGitMergeBase' repoPath baseBranchName featureBranchName = do
+    Stdout sha <- cmd ["git", "-C", repoPath, "merge-base", T.unpack baseBranchName, T.unpack featureBranchName]
+    return (GitSHA (T.pack (head (words sha))))
+
 getGitFileRef' :: RepoPath -> T.Text -> FilePath -> IO (Maybe T.Text)
 getGitFileRef' repoPath ref' fn = do
     withRepository lgFactory repoPath $ do
@@ -130,4 +150,6 @@ defaultRuleGitLib = do
         liftIO $ getGitFileRef' repoPath ref' fn
     rule $ \(IsGitAncestorQ (repoPath, ancName, childName)) -> Just $ liftIO $
         isGitAncestor' repoPath ancName childName
+    rule $ \(GetGitMergeBase (repoPath, baseBranchName, featureBranchName)) -> Just $ liftIO $
+        getGitMergeBase' repoPath baseBranchName featureBranchName
 
index 2761698..2b7fc5b 100644 (file)
@@ -3,14 +3,19 @@ module Paths where
 import System.FilePath
 
 type Hash = String
+type BranchName = String
 
 out :: FilePath
 out = "site" </> "out"
 
-resultsOf, reportOf, summaryOf, logsOf, graphFile :: Hash -> FilePath
+resultsOf, reportOf, summaryOf, logsOf :: Hash -> FilePath
+graphFile :: String -> FilePath
+branchSummaryOf, branchMergebaseOf :: BranchName -> FilePath
 
 logsOf hash = "logs" </> hash <.> "log"
 resultsOf hash = out </> "results" </> hash <.> "csv"
 reportOf hash = out </> "reports" </> hash <.> "json"
 summaryOf hash = out </> "summaries" </> hash <.> "json"
 graphFile bench = out </> "graphs" </> bench <.> "json"
+branchSummaryOf branch = out </> "branches" </> branch <.> "json"
+branchMergebaseOf branch = out </> "branches" </> branch <.> "mergebase"
index 4945fe8..fbcf584 100644 (file)
@@ -27,6 +27,7 @@ data GlobalReport = GlobalReport
     , benchmarks :: Maybe (M.Map BenchName ())
     , revisions :: Maybe (M.Map Hash RevReport)
     , benchGroups :: Maybe [BenchGroup]
+    , branches :: Maybe (M.Map BranchName BranchReport)
     }
 
 instance ToJSON GlobalReport where
@@ -34,14 +35,15 @@ instance ToJSON GlobalReport where
         ( "settings"    .=? settings ) ++
         ( "benchmarks"  .=? benchmarks ) ++
         ( "revisions"   .=? revisions ) ++
-        ( "benchGroups" .=? benchGroups )
+        ( "benchGroups" .=? benchGroups ) ++
+        ( "branches"    .=? branches )
       where
         k .=? Just v  = [ k .= toJSON v ]
         _ .=? Nothing = []
 
 
 emptyGlobalReport :: GlobalReport
-emptyGlobalReport = GlobalReport Nothing Nothing Nothing Nothing
+emptyGlobalReport = GlobalReport Nothing Nothing Nothing Nothing Nothing
 
 
 data SummaryStats = SummaryStats
@@ -82,6 +84,17 @@ data RevReport = RevReport
 instance ToJSON RevReport
 instance FromJSON RevReport
 
+data BranchReport = BranchReport
+    { branchHash :: Hash
+    , mergeBaseHash :: Hash
+    , branchStats :: SummaryStats
+    , commitCount :: Int
+    }
+
+ deriving (Generic)
+instance ToJSON BranchReport
+instance FromJSON BranchReport
+
 data ChangeType = Improvement | Boring | Regression
  deriving (Eq, Generic)
 instance ToJSON ChangeType
@@ -241,6 +254,24 @@ toGroup n res = BenchGroup
     }
 -}
 
+createBranchReport ::
+    S.Settings -> Hash -> Hash ->
+    ResultMap -> ResultMap ->
+    Int ->
+    BranchReport
+createBranchReport settings this other thisM otherM commitCount = BranchReport
+    { branchHash = this
+    , mergeBaseHash = other
+    , branchStats = toSummaryStats $ M.elems results
+    , commitCount = commitCount
+    }
+  where
+    results = M.fromList
+        [ (name, toResult s name value (M.lookup name otherM))
+        | (name, value) <- M.toAscList thisM
+        , let s = S.benchSettings settings name
+        ]
+
 createReport ::
     S.Settings -> Hash -> [Hash] ->
     ResultMap -> ResultMap ->
index 303c3a2..b1d918e 100644 (file)
@@ -38,4 +38,19 @@ revReportMain (this:parents) = do
     let doc = emptyGlobalReport { revisions = Just (M.singleton this rep) }
 
     BS.putStr (encode doc)
-    
+
+branchReportMain :: [String]-> IO ()
+branchReportMain [branchName, this, other] = do
+    settings <- S.readSettings "gipeda.yaml"
+
+    thisM <- readCSV this
+    otherM <- readCSV other
+
+    log <- fromStdout <$> git ["log", "--oneline", other ++ ".."++ this]
+    let commits = length (lines log)
+
+    let rep = createBranchReport settings this other thisM otherM commits
+    let doc = emptyGlobalReport { branches = Just (M.singleton branchName rep) }
+    BS.putStr (encode doc)
+
+
index 169b64c..6d6c23a 100644 (file)
@@ -202,15 +202,15 @@ shakeMain = do
     let pred h = do { hist <- history; findPred logSource hist h }
     let predOrSelf h = do { hist <- history; findPredOrSelf logSource hist h }
     let recent n h = do { hist <- history; findRecent logSource hist n h }
+    let predOrSelf' h = do
+        pred <- predOrSelf h
+        case pred of Just pred -> return pred
+                     Nothing -> fail $ h ++ " has no parent with logs?"
 
     "site/out/latest.txt" *> \ out -> do
         [head] <- readFileLines "site/out/head.txt"
-        latestM <- predOrSelf head
-        case latestM of
-           Just latest ->
-                writeFileChanged out latest
-           Nothing ->
-                fail "Head has no parent with logs?"
+        latest <- predOrSelf' head
+        writeFileChanged out latest
 
     "site/out/tags.txt" *> \ out -> do
         alwaysRerun
@@ -274,6 +274,25 @@ shakeMain = do
         Stdout json <- self "GraphReport" (bench : r)
         writeFile' out json
 
+    "site/out/branches//*.mergebase" *> \out -> do
+        let branch = dropDirectory1 (dropDirectory1 (dropDirectory1 (dropExtension out)))
+        mb <- getGitMergeBase "repository" "refs/heads/master" ("refs/heads/"++branch)
+        writeFile' out mb
+
+    "site/out/branches//*.json" *> \out -> do
+        let branch = dropDirectory1 (dropDirectory1 (dropDirectory1 (dropExtension out)))
+
+        branchHead <- getGitReference "repository" ("refs/heads/" ++ branch)
+        branchHead <- predOrSelf' branchHead
+
+        mergeBase <- readFile' $ branchMergebaseOf branch
+        mergeBase <- predOrSelf' mergeBase
+
+        need [resultsOf branchHead, resultsOf mergeBase]
+
+        Stdout json <- self "BranchReport" [branch, branchHead, mergeBase]
+        writeFile' out json
+
     "site/out/reports/*.json" *> \out -> do
         let hash = takeBaseName out
         need [resultsOf hash]
@@ -296,21 +315,25 @@ shakeMain = do
         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)
+        tagsHashes <- forM tags $ \t -> do
+            getGitReference "repository" ("refs/tags/" ++ t)
 
         branches <- readFileLines "site/out/branches.txt"
-        branchesAndHashes <- forM branches $ \t -> do
-            h <- getGitReference "repository" ("refs/heads/" ++ t)
-            return $ (t, h)
+        branchHashes <- forM branches $ \branch -> do
+            getGitReference "repository" ("refs/heads/" ++ branch)
+
+        need $ map branchSummaryOf branches
+        branchesData <- forM branches $ \branch -> do
+            json <- liftIO $ LBS.readFile (branchSummaryOf branch)
+            case eitherDecode json of
+                Left e -> fail e
+                Right rep -> return (rep :: Value)
 
         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 ]
+                [ T.pack "tags" .= object [ (T.pack t .= h) | (t,h) <- zip tags tagsHashes ]
                 ]
         liftIO $ LBS.writeFile out (encode o)
-        extraCommits <- filterM (doesLogExist logSource) (map snd tagsAndHashes ++ map snd branchesAndHashes)
+        extraCommits <- filterM (doesLogExist logSource) (tagsHashes ++ branchHashes)
 
         let revs = nub $ recentCommits ++ extraCommits
 
@@ -321,7 +344,8 @@ shakeMain = do
             case eitherDecode json of
                 Left e -> fail e
                 Right rep -> return (rep :: Value)
-        liftIO $ LBS.writeFile out (encode (merges (o:g)))
+
+        liftIO $ LBS.writeFile out (encode (merges (o : branchesData ++ g)))
     want ["site/out/latest-summaries.json"]
 
     "site/out/graph-summaries.json" *> \out -> do
index b58e7ca..3693ed9 100644 (file)
@@ -37,6 +37,7 @@ main = do
         "JsonSettings":_      -> jsonSettingsMain
         "Summary":opts        -> summaryMain opts
         "RevReport":opts      -> revReportMain opts
+        "BranchReport":opts   -> branchReportMain opts
         "GraphReport":opts    -> graphReportMain opts
         "WithLatestLogs":opts -> withLatestLogsMain opts
         "BenchNames":opts     -> benchNamesMain opts