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

Commit 32b4a293e4b61c388dd3c7112d1ca57482ae4025
Parent: 5fb5632025430b5e4dd9f126300c39d7f24492c6
Author: mcol <mcol@posteo.net>
Date: 2021-09-24 11:10:46 +0100
Committer: mcol <mcol@posteo.net>
Committed: 2021-09-24 11:10:46 +0100

Let hashmap accept other GVals and add instance for commits

src/Templates.hs Modified

@@ -17,7 +17,7 @@
 import System.FilePath ((</>))
 import System.IO.Error (tryIOError)
 import qualified Text.Ginger.AST as G
-import qualified Text.Ginger.Parse as G
+import Text.Ginger.Parse (SourcePos, parseGingerFile)
 import Text.Ginger.GVal (GVal)
 import Text.Ginger.Html (htmlSource, Html)
 import Text.Ginger.Run (easyRenderM, Run, RuntimeError)
@@ -26,7 +26,7 @@
 
 data Template = Template
     { templatePath :: FilePath
-    , templateGinger :: G.Template G.SourcePos
+    , templateGinger :: G.Template SourcePos
     }
 
 {-
@@ -36,7 +36,7 @@
 loadTemplates :: Config -> IO [Template]
 loadTemplates config = do
     files <- getFiles config
-    parsed <- sequence $ G.parseGingerFile includeResolver <$> files 
+    parsed <- sequence $ parseGingerFile includeResolver <$> files
     return $ Template <$> files <*> rights parsed
 
 ----------------------------------------------------------------------------------------
@@ -87,7 +87,7 @@
 Ginger to render templates using them.
 -}
 generate
-    :: HashMap.HashMap Text Text
+    :: HashMap.HashMap Text (GVal (Run SourcePos IO Html))
     -> Template
-    -> IO (Either (RuntimeError G.SourcePos) (GVal (Run G.SourcePos IO Html)))
+    -> IO (Either (RuntimeError SourcePos) (GVal (Run SourcePos IO Html)))
 generate context template = easyRenderM writeTo context (templateGinger template)

src/Repositories.hs Modified

@@ -1,5 +1,7 @@
 {-# Language LambdaCase #-}
 {-# Language OverloadedStrings #-}  -- Needed for resolveReference
+{-# Language FlexibleInstances #-}  -- Needed for `instance ToGVal`
+{-# Language MultiParamTypeClasses #-}  -- Needed for `instance ToGVal`
 
 module Repositories (
     run
@@ -9,6 +11,7 @@
 import Control.Monad ((<=<))
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Reader (ReaderT)
+import Data.Default (def)
 import Data.Either (fromRight)
 import Data.Tagged
 import Data.Text (pack, Text)
@@ -18,6 +21,10 @@
 import System.Directory (createDirectoryIfMissing)
 import System.FilePath ((</>), takeFileName)
 import System.IO.Error (tryIOError)
+import Text.Ginger.GVal (GVal, toGVal, ToGVal, asText, asHtml)
+import Text.Ginger.Html (Html, html)
+import Text.Ginger.Run (Run)
+import Text.Ginger.Parse (SourcePos)
 import qualified Data.HashMap.Strict as HashMap
 
 import Config (Config, repoPaths, outputDirectory, host)
@@ -82,13 +89,13 @@
     -> Text
     -> [Commit LgRepo]
     -> [(TreeFilePath, TreeEntry r)]
-    -> HashMap.HashMap Text Text
+    -> HashMap.HashMap Text (GVal (Run SourcePos IO Html))
 package config name description commits tree = HashMap.fromList
-    [ ("host", host config)
-    , ("name", pack name)
-    , ("description", description)
-    , ("commits", "commits")
-    , ("tree", "tree")
+    [ ("host", toGVal $ host config)
+    , ("name", toGVal $ pack name)
+    , ("description", toGVal description)
+    , ("commits", toGVal commits)
+    , ("tree", toGVal ("tree" :: String))
     ]
 
 getCommits :: CommitOid LgRepo -> ReaderT LgRepo IO [Commit LgRepo]
@@ -105,3 +112,9 @@
 
 getDescription :: FilePath -> IO Text
 getDescription path = fromRight "" <$> tryIOError (pack <$> readFile path)
+
+instance ToGVal m (Commit LgRepo) where
+    toGVal x = def
+        { asHtml = html . pack . show . commitLog $ x
+        , asText = pack . show . commitLog $ x
+        }

gitserve.cabal Modified

@@ -20,6 +20,7 @@
   default-language:    Haskell2010
   build-depends:       base >= 4.7 && < 5
                      , conduit
+                     , data-default
                      , dhall
                      , directory
                      , filepath