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

Commit 0efa7c23245f7111e3501d890080574ca57736b8
Parent: 8bb23c2078666e141f05f866f4284d39187e4582
Author: mcol <mcol@posteo.net>
Date: 2021-09-26 17:53:47 +0100
Committer: mcol <mcol@posteo.net>
Committed: 2021-09-26 18:58:31 +0100

Add fileTemplate and generate new HTML file per file in tree

Lots of work left to make this not so ugly:
 - some logic is repeated from the commit stuff
 - file contents and metadata is not shown

templates/tree.html Modified

@@ -14,7 +14,7 @@
     <p>{{- description }}</p>
     <p>git clone {{ host }}/{{- name }}</p>
     {% for file in tree %}
-    <p>{{- file.path }}</p>
+		<p><a href="{{ host }}/{{ name }}/files/{{ file.href }}">{{- file.path }}</a></p>
     {% endfor %}
   </body>
 </html>

templates/file.html Added

@@ -0,0 +1,22 @@
+<!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 }} -- {{ file.path }}</title>
+    <link rel="stylesheet" href="{{- host }}/style.css" />
+  </head>
+
+  <body>
+    <p>{{- name }}</p>
+    <hr>
+		<p>File <b>{{ file.path }}</b></p>
+		<p><b>{{ commit.title }}</b></p>
+    <p>{{ commit.body }}</p>
+    <hr>
+		<p>Authored {{ commit.authored }} by: {{ commit.author }} ({{ commit.author_email }})</p>
+		<p>Committed {{ commit.committed }} by: {{ commit.committer }} ({{ commit.committer_email }})</p>
+    <hr>
+  </body>
+</html>

src/Templates.hs Modified

@@ -24,7 +24,7 @@
 import Text.Ginger.Html (htmlSource, Html)
 import Text.Ginger.Run (easyRenderM, Run, RuntimeError)
 
-import Config (Config, templateDirectory, indexTemplate, commitTemplate)
+import Config (Config, templateDirectory, indexTemplate, commitTemplate, fileTemplate)
 
 data Template = Template
     { templatePath :: FilePath
@@ -75,10 +75,13 @@
 
 {-
 This is used to filter files in the template directory to exclude those specified by the
-config settings ``indexTemplate`` or ``commitTemplate``.
+config settings ``indexTemplate``, ``commitTemplate`` or ``fileTemplate``.
 -}
 isScoped :: Config -> FilePath -> Bool
-isScoped config path = path /= indexTemplate config && path /= commitTemplate config
+isScoped config path =
+    path /= indexTemplate config &&
+    path /= commitTemplate config &&
+    path /= fileTemplate config
 
 {-
 This wraps getDirectoryContents so that we get a list of fully qualified paths of the

src/Repositories.hs Modified

@@ -15,7 +15,8 @@
 import Data.Default (def)
 import Data.Either (fromRight)
 import Data.Tagged
-import Data.Text (pack, unpack, Text, strip, breakOn)
+import Data.Text (pack, unpack, Text, strip, breakOn, replace, append)
+import Data.Text.Encoding (decodeUtf8)
 import Data.Maybe (mapMaybe)
 import Git
 import Git.Libgit2 (lgFactory, LgRepo)
@@ -28,7 +29,7 @@
 import Text.Ginger.Parse (SourcePos)
 import qualified Data.HashMap.Strict as HashMap
 
-import Config (Config, repoPaths, outputDirectory, host, commitTemplate)
+import Config (Config, repoPaths, outputDirectory, host)
 import Templates (Template, generate, templatePath)
 
 {-
@@ -36,9 +37,15 @@
 repositories, reading from them and writing out their web pages using the given
 templates.
 -}
-run :: Config -> [Template] -> Maybe Template -> Maybe Template -> IO ()
-run config templates indexT commitT = do
-    foldMap (processRepo config templates commitT) . repoPaths $ config
+run
+    :: Config
+    -> [Template]
+    -> Maybe Template
+    -> Maybe Template
+    -> Maybe Template
+    -> IO ()
+run config templates indexT commitT fileT = do
+    foldMap (processRepo config templates commitT fileT) . repoPaths $ config
     runIndex config indexT
 
 ----------------------------------------------------------------------------------------
@@ -48,13 +55,25 @@
 repository doesn't exist or is unreadable in any way we can forget about it and move on
 (after informing the user of course).
 -}
-processRepo :: Config -> [Template] -> Maybe Template -> FilePath -> IO ()
-processRepo config templates commitT path = withRepository lgFactory path $
-    processRepo' config templates commitT path
+processRepo
+    :: Config
+    -> [Template]
+    -> Maybe Template
+    -> Maybe Template
+    -> FilePath
+    -> IO ()
+processRepo config templates commitT fileT path = withRepository lgFactory path $
+    processRepo' config templates commitT fileT path
 
 -- This is split out to make type reasoning a bit easier.
-processRepo' :: Config -> [Template] -> Maybe Template -> FilePath -> ReaderT LgRepo IO ()
-processRepo' config templates commitT path = do
+processRepo'
+    :: Config
+    -> [Template]
+    -> Maybe Template
+    -> Maybe Template
+    -> FilePath
+    -> ReaderT LgRepo IO ()
+processRepo' config templates commitT fileT path = do
     let name = takeFileName path
     let output = outputDirectory config </> name
     liftIO $ createDirectoryIfMissing True output
@@ -71,7 +90,7 @@
             -- commits: A list of `Git.Commit` objects to HEAD.
             commits <- getCommits gitHead
 
-            -- tree: A list of `(TreeFilePath, TreeEntry r)` objects at HEAD.
+            -- tree: A list of `TreeFile` objects at HEAD.
             tree <- getTree gitHead
 
             -- Run the generator --
@@ -79,6 +98,8 @@
             liftIO . mapM (generate output repo) $ templates
             let commitScope = packageCommit config name description
             liftIO . mapM (generateCommit config name commitScope commitT) $ commits
+            let fileScope = packageFile config name description
+            liftIO . mapM (generateFile config name fileScope fileT) $ tree
             return ()
 
 {-
@@ -165,6 +186,7 @@
 treeAsLookup :: TreeFile -> Text -> Maybe (GVal m)
 treeAsLookup treefile = \case
     "path" -> Just . toGVal . treeFilePath $ treefile
+    "href" -> Just . toGVal . flip append ".html" . replace "/" "." . decodeUtf8 . treeFilePath $ treefile
     _ -> Nothing
 
 ----------------------------------------------------------------------------------------
@@ -226,12 +248,12 @@
     -> Commit LgRepo
     -> IO ()
 generateCommit _ _ _ Nothing _ = return ()
-generateCommit config name commitScope (Just template) commit = do
-    let id = unpack . renderObjOid . commitOid $ commit
-    let template' = template { templatePath = id ++ ".html" }
+generateCommit config name scope (Just template) commit = do
+    let hash = unpack . renderObjOid . commitOid $ commit
+    let template' = template { templatePath = hash ++ ".html" }
     let output = outputDirectory config </> name </> "commits"
     liftIO $ createDirectoryIfMissing True output
-    generate output (commitScope commit) template'
+    generate output (scope commit) template'
     return ()
 
 packageCommit
@@ -246,3 +268,34 @@
     , ("description", toGVal description)
     , ("commit", toGVal commit)
     ]
+
+-- TODO: DRY
+
+generateFile
+    :: Config
+    -> FilePath
+    -> (TreeFile -> HashMap.HashMap Text (GVal (Run SourcePos IO Html)))
+    -> Maybe Template
+    -> TreeFile
+    -> IO ()
+generateFile _ _ _ Nothing _ = return ()
+generateFile config name scope (Just template) file = do
+    let path = unpack . replace "/" "." . decodeUtf8 . treeFilePath $ file
+    let template' = template { templatePath = path ++ ".html" }
+    let output = outputDirectory config </> name </> "files"
+    liftIO $ createDirectoryIfMissing True output
+    generate output (scope file) template'
+    return ()
+
+packageFile
+    :: Config
+    -> FilePath
+    -> Text
+    -> TreeFile
+    -> HashMap.HashMap Text (GVal (Run SourcePos IO Html))
+packageFile config name description file = HashMap.fromList
+    [ ("host", toGVal $ host config)
+    , ("name", toGVal $ pack name)
+    , ("description", toGVal description)
+    , ("file", toGVal file)
+    ]

src/Main.hs Modified

@@ -4,7 +4,7 @@
     main
 ) where
 
-import Config (getConfig, indexTemplate, commitTemplate)
+import Config (getConfig, indexTemplate, commitTemplate, fileTemplate)
 import Repositories (run)
 import Templates (loadTemplates, loadTemplate)
 
@@ -14,4 +14,5 @@
     templates <- loadTemplates config
     indexT <- loadTemplate $ indexTemplate config
     commitT <- loadTemplate $ commitTemplate config
-    run config templates indexT commitT
+    fileT <- loadTemplate $ fileTemplate config
+    run config templates indexT commitT fileT

src/Config.hs Modified

@@ -7,6 +7,7 @@
     templateDirectory,
     indexTemplate,
     commitTemplate,
+    fileTemplate,
     getConfig,
     outputDirectory,
     host
@@ -19,6 +20,7 @@
     , templateDirectory :: FilePath
     , indexTemplate :: FilePath
     , commitTemplate :: FilePath
+    , fileTemplate :: FilePath
     , outputDirectory :: FilePath
     , host :: Text
     }

config.dhall Modified

@@ -15,6 +15,7 @@
     , templateDirectory = "./templates"
     , indexTemplate = "./templates/index-main.html"
     , commitTemplate = "./templates/commit.html"
+    , fileTemplate = "./templates/file.html"
     , outputDirectory = "./output"
     , host = "http://localhost"
     }

README.rst Modified

@@ -34,7 +34,7 @@
 -----
 
 [x] Generate html file per commit with commit scope
-[ ] Generate html file per tree file with file scope
+[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