templates/docs/style.css Modified

@@ -98,7 +98,6 @@
     border-collapse: collapse;
 }
 
-
 th {
     background-color: #fcfaff;
     text-decoration: underline #aaa;
@@ -117,3 +116,23 @@
     background-color: #5d479d50;
     color: #333;
 }
+
+.diff {
+    background-color: #eee;
+    padding: 0.6em;
+    overflow-x: scroll;
+    margin: 20px 0;
+}
+
+.diff .status {
+    color: #666;
+    float: right;
+}
+
+.diff .add {
+    color: #0a0;
+}
+
+.diff .sub {
+    color: #a00;
+}

templates/docs/repo/commit.html Modified

@@ -12,4 +12,29 @@
 
 {{ commit.message }}
 </pre>
+
+{%- for diff in commit.diff -%}
+<div class="diff">
+  <p>
+    <b>{{ diff.new_file }}</b>
+    <span class="status">{{ diff.status }}</span>
+  </p>
+
+  {% if diff.newfile != diff.oldfile %}
+  <p>Renamed from {{ diff.old_file }}</p>
+  {% endif %}
+
+  {%- for hunk in diff.hunks -%}
+  {{ hunk.header }}
+
+  <pre>
+    {%- for line in hunk.lines -%}
+      <span class="{{ line.class }}">{{ line.text }}</span>
+    {%- endfor -%}
+  </pre>
+
+  {%- endfor -%}
+</div>
+{%- endfor -%}
+
 {% endblock %}

src/Types.hs Modified

@@ -15,6 +15,7 @@
 import Control.Monad.Catch (throwM)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Reader (ReaderT)
+import Data.ByteString (ByteString)
 import Data.Default (def)
 import Data.Maybe (fromMaybe, listToMaybe)
 import Data.Tagged (untag)
@@ -38,6 +39,12 @@
 -}
 type RunRepo = Run SourcePos (ReaderT LgRepo IO) Html
 
+unquote :: String -> String
+unquote = init . tail
+
+bsToText :: ByteString -> Text
+bsToText = decodeUtf8With lenientDecode
+
 {-
 GVal implementation for a repository, accessed in the scope of an individual repository,
 as well as in a list of all repositories in the index template.
@@ -45,7 +52,7 @@
 data Repo = Repo
     { repositoryPath :: Path Abs Dir
     , repositoryDescription :: Text
-    , repositoryHead :: Maybe (Git.Commit LgRepo)
+    , repositoryHead :: Maybe Commit
     }
 
 instance ToGVal m (Path b t) where
@@ -61,45 +68,121 @@
             , asLookup = Just . repoAsLookup $ repo
             }
 
-unquote :: String -> String
-unquote = init . tail
-
 repoAsLookup :: Repo -> Text -> Maybe (GVal m)
 repoAsLookup repo = \case
     "name" -> Just . toGVal . init . unquote . show . dirname . repositoryPath $ repo
     "description" -> Just . toGVal . repositoryDescription $ repo
     "head" -> Just . toGVal . repositoryHead $ repo
-    "updated" -> toGVal . show . Git.signatureWhen . Git.commitCommitter <$> repositoryHead repo
+    "updated" -> toGVal . show . Git.signatureWhen . Git.commitCommitter . commitGit <$> repositoryHead repo
     _ -> Nothing
 
 {-
-GVal implementation for `Git.Commit r`, allowing commits to be rendered in Ginger
-templates.
+GVal implementation for commits, allowing them to be rendered in Ginger templates.
 -}
-instance ToGVal m (Git.Commit LgRepo) where
-    toGVal :: Git.Commit LgRepo -> GVal m
+data Commit = Commit
+    { commitGit :: Git.Commit LgRepo
+    , commitDiffs :: [Git.Diff]
+    }
+
+instance ToGVal m Commit where
+    toGVal :: Commit -> GVal m
     toGVal commit =
         def
-            { asHtml = html . strip . T.takeWhile (/= '\n') . Git.commitLog $ commit
-            , asText = pack . show . Git.commitLog $ commit
+            { asHtml = html . strip . T.takeWhile (/= '\n') . Git.commitLog . commitGit $ commit
+            , asText = pack . show . Git.commitLog . commitGit $ commit
             , asLookup = Just . commitAsLookup $ commit
             }
 
-commitAsLookup :: Git.Commit LgRepo -> Text -> Maybe (GVal m)
+commitAsLookup :: Commit -> Text -> Maybe (GVal m)
 commitAsLookup commit = \case
-    "id" -> Just . toGVal . show . untag . Git.commitOid $ commit
-    "href" -> Just . toGVal . (<> ".html") . show . untag . Git.commitOid $ commit
-    "title" -> Just . toGVal . strip . T.takeWhile (/= '\n') . Git.commitLog $ commit
-    "body" -> Just . toGVal . strip . T.dropWhile (/= '\n') . Git.commitLog $ commit
-    "message" -> Just . toGVal . strip . Git.commitLog $ commit
-    "author" -> Just . toGVal . strip . Git.signatureName . Git.commitAuthor $ commit
-    "committer" -> Just . toGVal . strip . Git.signatureName . Git.commitCommitter $ commit
-    "author_email" -> Just . toGVal . strip . Git.signatureEmail . Git.commitAuthor $ commit
-    "committer_email" -> Just . toGVal . strip . Git.signatureEmail . Git.commitCommitter $ commit
-    "authored" -> Just . toGVal . show . Git.signatureWhen . Git.commitAuthor $ commit
-    "committed" -> Just . toGVal . show . Git.signatureWhen . Git.commitCommitter $ commit
-    "encoding" -> Just . toGVal . strip . Git.commitEncoding $ commit
-    "parent" -> toGVal . show . untag <$> (listToMaybe . Git.commitParents $ commit)
+    "id" -> Just . toGVal . show . untag . Git.commitOid . commitGit $ commit
+    "href" -> Just . toGVal . (<> ".html") . show . untag . Git.commitOid . commitGit $ commit
+    "title" -> Just . toGVal . strip . T.takeWhile (/= '\n') . Git.commitLog . commitGit $ commit
+    "body" -> Just . toGVal . strip . T.dropWhile (/= '\n') . Git.commitLog . commitGit $ commit
+    "message" -> Just . toGVal . strip . Git.commitLog . commitGit $ commit
+    "author" -> Just . toGVal . strip . Git.signatureName . Git.commitAuthor . commitGit $ commit
+    "committer" -> Just . toGVal . strip . Git.signatureName . Git.commitCommitter . commitGit $ commit
+    "author_email" -> Just . toGVal . strip . Git.signatureEmail . Git.commitAuthor . commitGit $ commit
+    "committer_email" -> Just . toGVal . strip . Git.signatureEmail . Git.commitCommitter . commitGit $ commit
+    "authored" -> Just . toGVal . show . Git.signatureWhen . Git.commitAuthor . commitGit $ commit
+    "committed" -> Just . toGVal . show . Git.signatureWhen . Git.commitCommitter . commitGit $ commit
+    "encoding" -> Just . toGVal . strip . Git.commitEncoding . commitGit $ commit
+    "parent" -> toGVal . show . untag <$> (listToMaybe . Git.commitParents . commitGit $ commit)
+    "diff" -> Just . toGVal . commitDiffs $ commit
+    _ -> Nothing
+
+{-
+With `Diff`s there is a hierarchy:
+
+- A commit has multiple diffs - one per file that changed.
+- Each diff has 1 or more hunks
+- Each hunk has a number of lines
+-}
+instance ToGVal m Git.Diff where
+    toGVal :: Git.Diff -> GVal m
+    toGVal diff =
+        def
+            { asHtml = html . bsToText . Git.diffNewFile $ diff
+            , asText = bsToText . Git.diffNewFile $ diff
+            , asLookup = Just . diffAsLookup $ diff
+            }
+
+diffAsLookup :: Git.Diff -> Text -> Maybe (GVal m)
+diffAsLookup diff = \case
+    "new_file" -> Just . toGVal . Git.diffNewFile $ diff
+    "old_file" -> toGVal <$> Git.diffOldFile diff
+    "status" -> Just . toGVal . drop 5 . show . Git.diffStatus $ diff
+    "hunks" -> Just . toGVal . Git.diffHunks $ diff
+    _ -> Nothing
+
+instance ToGVal m Git.Hunk where
+    toGVal :: Git.Hunk -> GVal m
+    toGVal hunk =
+        def
+            { asHtml = html . bsToText . Git.hunkHeader $ hunk
+            , asText = bsToText . Git.hunkHeader $ hunk
+            , asLookup = Just . hunkAsLookup $ hunk
+            }
+
+hunkAsLookup :: Git.Hunk -> Text -> Maybe (GVal m)
+hunkAsLookup hunk = \case
+    "lines" -> Just . toGVal . fmap makeLine . Git.hunkLines $ hunk
+    "header" -> Just . toGVal . bsToText . Git.hunkHeader $ hunk
+    _ -> Nothing
+
+{-
+Wrap diff lines when accessed so that they can each get a class string indicating
+whether they are additions, subtractions, or context lines. They are primarily a
+convenience for assigning CSS classes.
+-}
+data Line = Line
+    { lineText :: Text
+    , lineClass :: String
+    }
+
+makeLine :: Git.DiffLine -> Line
+makeLine line = Line text (cls . T.head $ text)
+  where
+    text = bsToText line
+    cls :: Char -> String
+    cls = \case
+        '+' -> "add"
+        '-' -> "sub"
+        _ -> "def"
+
+instance ToGVal m Line where
+    toGVal :: Line -> GVal m
+    toGVal line =
+        def
+            { asHtml = html . lineText $ line
+            , asText = lineText line
+            , asLookup = Just . lineAsLookup $ line
+            }
+
+lineAsLookup :: Line -> Text -> Maybe (GVal m)
+lineAsLookup line = \case
+    "text" -> Just . toGVal . lineText $ line
+    "class" -> Just . toGVal . lineClass $ line
     _ -> Nothing
 
 {-
@@ -157,7 +240,7 @@
 
     if toEnum . fromEnum $ isBinary -- This reads weird, but it goes CInt, to Int, to Bool.
         then return BinaryContents
-        else FileContents . decodeUtf8With lenientDecode <$> Git.catBlob oid
+        else FileContents . bsToText <$> Git.catBlob oid
 
 {-
 GVal implementations for data definitions above, allowing commits to be rendered in
@@ -230,7 +313,7 @@
 -}
 data Ref = Ref
     { refName :: Git.RefName
-    , refCommit :: Git.Commit LgRepo
+    , refCommit :: Commit
     }
 
 instance ToGVal RunRepo Ref where

src/Repositories.hs Modified

@@ -17,7 +17,7 @@
 import Control.Monad.Trans.Reader (ReaderT)
 import Data.Either (isRight)
 import qualified Data.HashMap.Strict as HashMap
-import Data.Maybe (catMaybes, fromJust, mapMaybe)
+import Data.Maybe (catMaybes, fromJust, listToMaybe, mapMaybe)
 import Data.Tagged (Tagged (..), untag)
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -105,6 +105,7 @@
             return repo
         Just commitID -> do
             let gitHead = Tagged commitID
+            headCommit <- loadDiff =<< Git.lookupCommit gitHead
 
             -- If a page exists for the head commit, don't do anything else --
             exists <-
@@ -135,10 +136,8 @@
                 -- Copy any static files/folders into the output folder --
                 liftIO . envRepoCopyStatics env $ output
 
-            -- Return the repo with the head so the index page can use it. --
-            repoHead <- Git.lookupCommit gitHead -- Do this in case the block above is skipped.
             return
-                repo{repositoryHead = Just repoHead}
+                repo{repositoryHead = Just headCommit}
 
 {-
 The role of the function above is to gather information about a git repository and
@@ -151,7 +150,7 @@
     [Repo] ->
     Path Rel Dir ->
     Text ->
-    [Git.Commit LgRepo] ->
+    [Commit] ->
     [TreeFile] ->
     [Ref] ->
     [Ref] ->
@@ -174,16 +173,30 @@
 {-
 Collect commit information.
 -}
-getCommits :: Git.CommitOid LgRepo -> ReaderT LgRepo IO [Git.Commit LgRepo]
+getCommits :: Git.CommitOid LgRepo -> ReaderT LgRepo IO [Commit]
 getCommits commitID =
     fmap reverse . sequence . mapMaybe loadCommit
         <=< runConduit
         $ Git.sourceObjects Nothing commitID False .| sinkList
 
-loadCommit :: Git.ObjectOid LgRepo -> Maybe (ReaderT LgRepo IO (Git.Commit LgRepo))
-loadCommit (Git.CommitObjOid oid) = Just $ Git.lookupCommit oid
+loadCommit :: Git.ObjectOid LgRepo -> Maybe (ReaderT LgRepo IO Commit)
+loadCommit (Git.CommitObjOid oid) = Just $ loadDiff =<< Git.lookupCommit oid
 loadCommit _ = Nothing
 
+loadDiff :: Git.Commit LgRepo -> ReaderT LgRepo IO Commit
+loadDiff gitCommit = do
+    let tree = Git.commitTree gitCommit
+    newTree <- Git.lookupTree tree
+    oldTree <-
+        case listToMaybe . Git.commitParents $ gitCommit of
+            Just parent ->
+                fmap Just . Git.lookupTree . Git.commitTree =<< Git.lookupCommit parent
+            Nothing ->
+                return Nothing
+
+    diffs <- Git.diffTreeToTree oldTree (Just newTree)
+    return $ Commit gitCommit diffs
+
 {-
 Collect tree information for the given commit. Recurses on directories to list their
 contents.
@@ -240,8 +253,10 @@
     let names'' = map (fromJust . T.stripPrefix ref) . catMaybes . zipWith dropName maybeCommits $ names'
     return . zipWith Ref names'' . catMaybes $ maybeCommits
   where
-    refObjToCommit :: Git.Object r (ReaderT LgRepo IO) -> ReaderT LgRepo IO (Maybe (Git.Commit r))
-    refObjToCommit (Git.CommitObj obj) = return . Just $ obj
+    refObjToCommit ::
+        Git.Object LgRepo (ReaderT LgRepo IO) ->
+        ReaderT LgRepo IO (Maybe Commit)
+    refObjToCommit (Git.CommitObj obj) = Just <$> loadDiff obj
     refObjToCommit _ = return Nothing
 
     dropName :: Maybe a -> Git.RefName -> Maybe Git.RefName
@@ -275,8 +290,8 @@
         file <- parseRelFile . identify $ t
         return $ dir </> file
 
-instance Target (Git.Commit LgRepo) where
-    identify = (++ ".html") . show . untag . Git.commitOid
+instance Target Commit where
+    identify = (++ ".html") . show . untag . Git.commitOid . commitGit
     category = const "commit"
 
 instance Target TreeFile where