🐙 Templated web page generator for your git repositories
git clone https://github.com/m-col/gitja
Files | Refs | Readme | License

Commit 32db3a70cb523e9cfcbf003c68891cdc3cd5f042
Parent: 1d1f251113c47f743ea4276c531887b2c9ad00f8
Author: mcol <mcol@posteo.net>
Date: 2021-10-07 01:41:40 +0100
Committer: mcol <mcol@posteo.net>
Committed: 2021-10-07 09:59:33 +0100

Add branches and tags as available data in templates

Adds `Ref` data type to represent them.

Example template files are added for each one.

templates/tags.html Added

@@ -0,0 +1,21 @@
+<!doctype html>
+<html lang="en">
+  <head>
+    <meta charset="utf-8">
+    <meta http-equiv="x-ua-compatible" content="ie=edge">
+    <meta name="viewport" content="width=device-width, initial-scale=1">
+    <title>{{ name }} -- tags</title>
+    <link rel="stylesheet" href="{{- host }}/style.css" />
+  </head>
+
+  <body>
+    <p>{{ name }}</p>
+    <hr>
+    <p>{{ description }}</p>
+    <p>git clone {{ host }}/{{ name }}</p>
+    <hr>
+    {% for tag in tags %}
+		<p><b>{{ tag.name }}</b> {{ tag.id[:7] }} {{ tag.title }}</p>
+    {% endfor %}
+  </body>
+</html>

templates/index.html Modified

@@ -15,5 +15,7 @@
     <p>git clone {{ host }}/{{- name }}</p>
 		<p><a href="./log.html">Log</a></p>
 		<p><a href="./tree.html">Tree</a></p>
+		<p><a href="./tags.html">Tags</a></p>
+		<p><a href="./branches.html">Branches</a></p>
   </body>
 </html>

templates/branches.html Added

@@ -0,0 +1,21 @@
+<!doctype html>
+<html lang="en">
+  <head>
+    <meta charset="utf-8">
+    <meta http-equiv="x-ua-compatible" content="ie=edge">
+    <meta name="viewport" content="width=device-width, initial-scale=1">
+    <title>{{ name }} -- tags</title>
+    <link rel="stylesheet" href="{{- host }}/style.css" />
+  </head>
+
+  <body>
+    <p>{{ name }}</p>
+    <hr>
+    <p>{{ description }}</p>
+    <p>git clone {{ host }}/{{ name }}</p>
+    <hr>
+    {% for branch in branches %}
+		<p><b>{{ branch.name }}</b> {{ branch.id[:7] }} {{ branch.title }}</p>
+    {% endfor %}
+  </body>
+</html>

src/Types.hs Modified

@@ -130,3 +130,25 @@
 -}
 treePathToHref :: TreeFilePath -> Text
 treePathToHref = flip T.append ".html" . T.replace "/" "." .  decodeUtf8With lenientDecode
+
+{-
+Data to store information about references: tags and branches.
+-}
+data Ref = Ref
+    { refName :: RefName
+    , refCommit :: Commit LgRepo
+    }
+
+instance ToGVal m Ref where
+    toGVal :: Ref -> GVal m
+    toGVal ref = def
+        { asHtml = html . refName $ ref
+        , asText = refName ref
+        , asLookup = Just . refAsLookup $ ref
+        }
+
+refAsLookup :: Ref -> Text -> Maybe (GVal m)
+refAsLookup ref = \case
+    "name" -> Just . toGVal . refName $ ref
+    "commit" -> Just . toGVal . refCommit $ ref
+    key -> commitAsLookup (refCommit ref) key

src/Repositories.hs Modified

@@ -14,10 +14,10 @@
 import Control.Monad.Trans.Reader (ReaderT)
 import Data.Either (fromRight)
 import Data.Tagged
-import Data.Text (pack, unpack, Text)
+import Data.Text (pack, unpack, Text, isPrefixOf, stripPrefix)
 import Data.Text.Encoding (decodeUtf8With)
 import Data.Text.Encoding.Error (lenientDecode)
-import Data.Maybe (mapMaybe)
+import Data.Maybe (mapMaybe, catMaybes, fromJust)
 import Git
 import Git.Libgit2 (lgFactory, LgRepo)
 import System.Directory (createDirectoryIfMissing)
@@ -50,6 +50,7 @@
 getDescription :: FilePath -> IO Text
 getDescription = fmap (fromRight "") . tryIOError . fmap pack . readFile . (</> "description")
 
+
 ----------------------------------------------------------------------------------------
 -- Private -----------------------------------------------------------------------------
 
@@ -76,14 +77,19 @@
             -- it exists.
             description <- liftIO . getDescription $ path
 
-            -- commits: A list of `Git.Commit` objects to HEAD.
+            -- commits: A list of `Commit` objects to HEAD.
             commits <- getCommits gitHead
 
             -- tree: A list of `TreeFile` objects at HEAD.
             tree <- getTree gitHead
 
+            -- tags and branches: Lists of `Ref` objects that wrap `Commit` and
+            -- `Refname` (Text).
+            tags <- getRefs "refs/tags/"
+            branches <- getRefs "refs/heads/"
+
             -- Run the generator --
-            let scope = package env name description commits tree
+            let scope = package env name description commits tree tags branches
             liftIO . mapM (generate output scope) $ envTemplates env
             liftIO . mapM (genTarget output scope $ envCommitTemplate env) $ commits
             liftIO . mapM (genTarget output scope $ envFileTemplate env) $ tree
@@ -101,13 +107,17 @@
     -> Text
     -> [Commit LgRepo]
     -> [TreeFile]
+    -> [Ref]
+    -> [Ref]
     -> HashMap.HashMap Text (GVal (Run SourcePos IO Html))
-package env name description commits tree = HashMap.fromList
+package env name description commits tree tags branches = HashMap.fromList
     [ ("host", toGVal . host . envConfig $ env)
     , ("name", toGVal . pack $ name)
     , ("description", toGVal description)
     , ("commits", toGVal . reverse $ commits)  -- Could be optimised
     , ("tree", toGVal tree)
+    , ("tags", toGVal tags)
+    , ("branches", toGVal branches)
     ]
 
 {-
@@ -142,6 +152,30 @@
 getEntryModes (TreeEntry _) = return ModeDirectory
 getEntryModes (CommitEntry _) = return ModeSubmodule
 
+{-
+Collect information about references. TODO: Find a more canonical way to split
+references into tags or branches rather than filtering the refnames.
+-}
+getRefs :: Text -> ReaderT LgRepo IO [Ref]
+getRefs ref = do
+    names <- filter (isPrefixOf ref) <$> listReferences
+    maybeOids <- mapM resolveReference names
+    let names' = catMaybes . zipWith dropName maybeOids $ names
+    objs <- mapM lookupObject . catMaybes $ maybeOids
+    maybeCommits <- mapM refObjToCommit objs
+    let names'' = map (fromJust . stripPrefix ref) . catMaybes . zipWith dropName maybeCommits $ names'
+    return . zipWith Ref names'' . catMaybes $ maybeCommits
+
+  where
+    refObjToCommit :: Object r m -> ReaderT LgRepo IO (Maybe (Commit r))
+    refObjToCommit (CommitObj obj) = return . Just $ obj
+    refObjToCommit _ = return Nothing
+
+    dropName :: Maybe a -> RefName -> Maybe RefName
+    dropName (Just _) name = Just name
+    dropName Nothing _ = Nothing
+
+
 ----------------------------------------------------------------------------------------
 -- Targets -----------------------------------------------------------------------------
 

README.rst Modified

@@ -37,7 +37,7 @@
 [x] Generate html file per tree file with file scope
 [ ] Expose readme url in repo scope for convenient hyperlinking
 [ ] Expose license url in repo scope for convenient hyperlinking
-[ ] Expose repo branches and tags in repo scope
+[x] Expose repo branches and tags in repo scope
 [ ] Commit diffs
 [x] Tree entry filemodes
 [ ] Generate RSS?