templates/index-main.html Modified

@@ -20,7 +20,7 @@
 
     <tbody>
       {% for repo in repositories %}
-      <tr><td><a href="{{ repo.name }}">{{ repo.name }}</a></td><td>{{ repo.description }}</td><td>{{ repo.updated }}</td></tr>
+      <tr><td><a href="{{ repo.name }}">{{ repo.name }}</a></td><td>{{ repo.description }}</td><td>{{ repo.head.authored[:16] }}</td></tr>
       {% endfor %}
     </tbody>
   </table>

src/Types.hs Modified

@@ -19,10 +19,37 @@
 import Data.Text.Encoding.Error (lenientDecode)
 import Git
 import Git.Libgit2 (LgRepo)
+import System.FilePath (takeFileName)
 import Text.Ginger.GVal (GVal, ToGVal, asBoolean, asHtml, asList, asLookup, asText, toGVal)
 import Text.Ginger.Html (html)
 
 {-
+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.
+-}
+data Repo = Repo
+    { repositoryPath :: FilePath
+    , repositoryDescription :: Text
+    , repositoryHead :: Maybe (Commit LgRepo)
+    }
+
+instance ToGVal m Repo where
+    toGVal :: Repo -> GVal m
+    toGVal repo =
+        def
+            { asHtml = html . pack . show . takeFileName . repositoryPath $ repo
+            , asText = pack . show . takeFileName . repositoryPath $ repo
+            , asLookup = Just . repoAsLookup $ repo
+            }
+
+repoAsLookup :: Repo -> Text -> Maybe (GVal m)
+repoAsLookup repo = \case
+    "name" -> Just . toGVal . takeFileName . repositoryPath $ repo
+    "description" -> Just . toGVal . repositoryDescription $ repo
+    "head" -> Just . toGVal . repositoryHead $ repo
+    _ -> Nothing
+
+{-
 GVal implementation for `Git.Commit r`, allowing commits to be rendered in Ginger
 templates.
 -}

src/Repositories.hs Modified

@@ -13,6 +13,7 @@
 import Control.Monad (when, (<=<))
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Reader (ReaderT)
+import Data.Either (fromRight)
 import qualified Data.HashMap.Strict as HashMap
 import Data.Maybe (catMaybes, fromJust, mapMaybe)
 import Data.Tagged
@@ -23,13 +24,13 @@
 import Git.Libgit2 (LgRepo, lgFactory)
 import System.Directory (createDirectoryIfMissing, doesFileExist)
 import System.FilePath (takeFileName, (</>))
+import System.IO.Error (tryIOError)
 import Text.Ginger.GVal (GVal, ToGVal, toGVal)
 import Text.Ginger.Html (Html)
 import Text.Ginger.Parse (SourcePos)
 import Text.Ginger.Run (Run)
 
 import Config
-import Index
 import Templates
 import Types
 
@@ -37,26 +38,45 @@
 This is the entrypoint maps over our repositories, reading from them and writing out
 their web pages using the loaded templates.
 -}
-run :: Env -> [Repo] -> IO ()
-run = mapM_ . processRepo
+run :: Env -> IO [Repo]
+run env = mapM (processRepo env) =<< loadRepos env
 
 ----------------------------------------------------------------------------------------
 -- Private -----------------------------------------------------------------------------
 
 {-
+Get paths along with their descriptions.
+-}
+loadRepos :: Env -> IO [Repo]
+loadRepos env = do
+    descs <- mapM getDescription paths
+    return $ ($ Nothing) <$> zipWith Repo paths descs
+  where
+    paths = repoPaths . envConfig $ env
+
+{-
+Pass the repository's folder, get its description.
+-}
+getDescription :: FilePath -> IO Text
+getDescription = fmap (fromRight "") . tryIOError . fmap pack . readFile . (</> "description")
+
+{-
 This receives a file path to a single repository and tries to process it. If the
 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 :: Env -> Repo -> IO ()
-processRepo env repo = withRepository lgFactory (Index.repoPath repo) $ processRepo' env repo
+processRepo :: Env -> Repo -> IO Repo
+processRepo env repo = withRepository lgFactory (repositoryPath repo) $ processRepo' env repo
 
-processRepo' :: Env -> Repo -> ReaderT LgRepo IO ()
+processRepo' :: Env -> Repo -> ReaderT LgRepo IO Repo
 processRepo' env repo = do
-    let name = takeFileName . Index.repoPath $ repo
+    let name = takeFileName . repositoryPath $ repo
     let output = outputDirectory (envConfig env) </> name
+
     resolveReference "HEAD" >>= \case
-        Nothing -> liftIO . print $ "gitserve: " <> name <> ": Failed to resolve HEAD."
+        Nothing -> do
+            liftIO . print $ "gitserve: " <> name <> ": Failed to resolve HEAD."
+            return repo
         Just commitID -> do
             let gitHead = Tagged commitID
 
@@ -65,7 +85,7 @@
             tree <- getTree gitHead
             tags <- getRefs "refs/tags/"
             branches <- getRefs "refs/heads/"
-            let scope = package env name (repoDescription repo) commits tree tags branches
+            let scope = package env name (repositoryDescription repo) commits tree tags branches
 
             -- Create the destination folders
             liftIO . createDirectoryIfMissing True $ output </> "commit"
@@ -77,6 +97,9 @@
             liftIO . mapM_ (genTarget output scope force $ envCommitTemplate env) $ commits
             liftIO . mapM_ (genTarget output scope True $ envFileTemplate env) $ tree -- TODO: detect file changes
 
+            -- Return the repo with the head so the index page can use it. --
+            return $ repo{repositoryHead = Just . head $ commits}
+
 {-
 The role of the function above is to gather information about a git repository and
 package it all together in such a way that various parts can be accessed and used by

src/Main.hs Modified

@@ -8,8 +8,9 @@
 
 import Data.Version (showVersion)
 import qualified Options.Applicative as O
+import System.Directory (createDirectoryIfMissing)
 
-import Config (getConfig)
+import Config (getConfig, outputDirectory)
 import Index (runIndex)
 import Repositories (run)
 import Templates (loadTemplates)
@@ -62,6 +63,6 @@
         then putStrLn $ "Your gitserve version is: " <> showVersion version
         else do
             conf <- getConfig (config options)
+            createDirectoryIfMissing True $ outputDirectory conf
             env <- loadTemplates (force options) conf
-            repos <- runIndex env
-            run env repos
+            runIndex env =<< run env

src/Index.hs Modified

@@ -1,78 +1,37 @@
--- Needed for `instance ToGVal`
-{-# LANGUAGE FlexibleInstances #-}
--- Needed for toGVal type signature
-{-# LANGUAGE InstanceSigs #-}
-{-# LANGUAGE LambdaCase #-}
--- Needed for `instance ToGVal`
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Index (
     runIndex,
-    Repo,
-    repoAsLookup,
-    repoPath,
-    repoDescription,
 ) where
 
-import Data.Default (def)
-import Data.Either (fromRight)
 import qualified Data.HashMap.Strict as HashMap
-import Data.Text (Text, pack)
-import System.Directory (createDirectoryIfMissing)
-import System.FilePath (takeFileName, (</>))
-import System.IO.Error (tryIOError)
-import Text.Ginger.GVal (GVal, ToGVal, asHtml, asLookup, asText, toGVal)
-import Text.Ginger.Html (Html, html)
+import Data.Text (Text)
+import System.FilePath ((</>))
+import Text.Ginger.GVal (GVal, toGVal)
+import Text.Ginger.Html (Html)
 import Text.Ginger.Parse (SourcePos)
 import Text.Ginger.Run (Run)
 
 import Config
 import Templates
+import Types
 
 {-
 This creates the main index file from the index template, using information from all
 configured respositories.
 -}
-runIndex :: Env -> IO [Repo]
-runIndex env =
+runIndex :: Env -> [Repo] -> IO ()
+runIndex env repos =
     case envIndexTemplate env of
         Nothing ->
-            return []
-        Just template -> do
-            let config = envConfig env
-            createDirectoryIfMissing True $ outputDirectory config
-            let output = outputDirectory config </> "index.html"
-            repos <- loadRepos config
-            let scope = packageIndex config repos
-            generate output scope template
-            return repos
-
-{-
-The unique variable in the index scope is the list of repositories, which can be looped
-over and each entry has some properties that can be accessed. Those are defined here.
-The type is exported so that within the scope of a single repository, its name and
-description is available.
--}
-data Repo = Repo
-    { repoPath :: FilePath
-    , repoDescription :: Text
-    }
-
-instance ToGVal m Repo where
-    toGVal :: Repo -> GVal m
-    toGVal repo =
-        def
-            { asHtml = html . pack . show . takeFileName . repoPath $ repo
-            , asText = pack . show . takeFileName . repoPath $ repo
-            , asLookup = Just . repoAsLookup $ repo
-            }
-
-repoAsLookup :: Repo -> Text -> Maybe (GVal m)
-repoAsLookup repo = \case
-    "name" -> Just . toGVal . takeFileName . repoPath $ repo
-    "description" -> Just . toGVal . repoDescription $ repo
-    _ -> Nothing
+            return ()
+        Just template ->
+            generate
+                (outputDirectory config </> "index.html")
+                (packageIndex config repos)
+                template
+          where
+            config = envConfig env
 
 ----------------------------------------------------------------------------------------
 -- Private -----------------------------------------------------------------------------
@@ -89,17 +48,3 @@
         [ ("host", toGVal $ host config)
         , ("repositories", toGVal repos)
         ]
-
-{-
-Get paths along with their descriptions.
--}
-loadRepos :: Config -> IO [Repo]
-loadRepos config = zipWith ($) (Repo <$> paths) <$> mapM getDescription paths
-  where
-    paths = repoPaths config
-
-{-
-Pass the repository's folder, get its description.
--}
-getDescription :: FilePath -> IO Text
-getDescription = fmap (fromRight "") . tryIOError . fmap pack . readFile . (</> "description")