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

Commit 2cdfc7332b46fe5d9a8c602e055e8a7239031024
Parent: 20645a2fd7201ab9bb7f2b7b820d1afd8e43f138
Author: mcol <mcol@posteo.net>
Date: 2021-11-24 19:44:44 +0000
Committer: mcol <mcol@posteo.net>
Committed: 2021-11-24 20:18:53 +0000

move ginger parser into git repository monad context

src/Types.hs Modified

@@ -10,6 +10,7 @@
 
 module Types where
 
+import Control.Monad.Trans.Reader (ReaderT)
 import Data.ByteString.UTF8 (toString)
 import Data.Default (def)
 import Data.Maybe (listToMaybe)
@@ -22,7 +23,9 @@
 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)
+import Text.Ginger.Html (Html, html)
+import Text.Ginger.Parse (SourcePos)
+import Text.Ginger.Run (Run)
 
 {-
 GVal implementation for a repository, accessed in the scope of an individual repository,
@@ -126,8 +129,8 @@
 GVal implementations for data definitions above, allowing commits to be rendered in
 Ginger templates.
 -}
-instance ToGVal m TreeFile where
-    toGVal :: TreeFile -> GVal m
+instance ToGVal (Run SourcePos (ReaderT LgRepo IO) Html) TreeFile where
+    toGVal :: TreeFile -> GVal (Run SourcePos (ReaderT LgRepo IO) Html)
     toGVal treefile =
         def
             { asHtml = html . pack . toString . treeFilePath $ treefile
@@ -136,8 +139,8 @@
             , asBoolean = True -- Used for conditionally checking readme/license template variables.
             }
 
-instance ToGVal m TreeFileContents where
-    toGVal :: TreeFileContents -> GVal m
+instance ToGVal (Run SourcePos (ReaderT LgRepo IO) Html) TreeFileContents where
+    toGVal :: TreeFileContents -> GVal (Run SourcePos (ReaderT LgRepo IO) Html)
     toGVal (FileContents text) = toGVal text
     toGVal (FolderContents treeFiles) =
         def
@@ -146,7 +149,7 @@
             , asList = Just . fmap toGVal $ treeFiles
             }
 
-treeAsLookup :: TreeFile -> Text -> Maybe (GVal m)
+treeAsLookup :: TreeFile -> Text -> Maybe (GVal (Run SourcePos (ReaderT LgRepo IO) Html))
 treeAsLookup treefile = \case
     "path" -> Just . toGVal . treeFilePath $ treefile
     "href" -> Just . toGVal . treePathToHref . treeFilePath $ treefile

src/Templates.hs Modified

@@ -20,11 +20,14 @@
 ) where
 
 import Control.Monad (void, (<=<))
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Trans.Reader (ReaderT)
 import Data.Char (toLower)
 import qualified Data.HashMap.Strict as HashMap
 import Data.List (isSuffixOf)
 import Data.Maybe (catMaybes)
 import Data.Text (Text, unpack)
+import Git.Libgit2 (LgRepo)
 import Path (Abs, Dir, File, Path, dirname, filename, parseAbsDir, toFilePath, (</>))
 import Path.IO (copyDirRecur, copyFile, ensureDir, listDir)
 import System.Directory (makeAbsolute)
@@ -85,12 +88,12 @@
 -}
 generate ::
     FilePath ->
-    HashMap.HashMap Text (GVal (Run SourcePos IO Html)) ->
+    HashMap.HashMap Text (GVal (Run SourcePos (ReaderT LgRepo IO) Html)) ->
     Template ->
-    IO ()
+    ReaderT LgRepo IO ()
 generate output context template = do
-    writeFile output "" -- Clear contents of file if it exists
-    void $ runGingerT (easyContext (writeTo output) context) . templateGinger $ template
+    liftIO $ writeFile output "" -- Clear contents of file if it exists
+    void . runGingerT (easyContext (writeTo output) context) . templateGinger $ template
 
 ----------------------------------------------------------------------------------------
 -- Private -----------------------------------------------------------------------------
@@ -166,5 +169,5 @@
 {-
 This function gets the output HTML data and is responsible for saving it to file.
 -}
-writeTo :: FilePath -> Html -> IO ()
-writeTo path = appendFile path . unpack . htmlSource
+writeTo :: FilePath -> Html -> ReaderT LgRepo IO ()
+writeTo path = liftIO . appendFile path . unpack . htmlSource

src/Repositories.hs Modified

@@ -93,9 +93,9 @@
 
             -- Run the generator --
             let force = envForce env
-            liftIO . mapM_ (genRepo output scope) $ envTemplates env
-            liftIO . mapM_ (genTarget output scope force $ envCommitTemplate env) $ commits
-            liftIO . mapM_ (genTarget output scope True $ envFileTemplate env) $ tree -- TODO: detect file changes
+            mapM_ (genRepo output scope) $ envTemplates env
+            mapM_ (genTarget output scope force $ envCommitTemplate env) commits
+            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}
@@ -114,7 +114,7 @@
     [TreeFile] ->
     [Ref] ->
     [Ref] ->
-    HashMap.HashMap Text (GVal (Run SourcePos IO Html))
+    HashMap.HashMap Text (GVal (Run SourcePos (ReaderT LgRepo IO) Html))
 package env name description commits tree tags branches =
     HashMap.fromList
         [ ("host", toGVal . host . envConfig $ env)
@@ -204,9 +204,9 @@
 
 genRepo ::
     FilePath ->
-    HashMap.HashMap Text (GVal (Run SourcePos IO Html)) ->
+    HashMap.HashMap Text (GVal (Run SourcePos (ReaderT LgRepo IO) Html)) ->
     Template ->
-    IO ()
+    ReaderT LgRepo IO ()
 genRepo output scope template = generate output' scope template
   where
     output' = (</>) output . takeFileName . templatePath $ template
@@ -221,7 +221,7 @@
 commitTemplate. The Target class generalises how each target is represented so that
 genTarget can work on any target type.
 -}
-class ToGVal (Run SourcePos IO Html) a => Target a where
+class ToGVal (Run SourcePos (ReaderT LgRepo IO) Html) a => Target a where
     identify :: a -> FilePath
     category :: a -> FilePath
 
@@ -236,16 +236,16 @@
 genTarget ::
     Target a =>
     FilePath ->
-    HashMap.HashMap Text (GVal (Run SourcePos IO Html)) ->
+    HashMap.HashMap Text (GVal (Run SourcePos (ReaderT LgRepo IO) Html)) ->
     Bool ->
     Maybe Template ->
     a ->
-    IO ()
+    ReaderT LgRepo IO ()
 genTarget _ _ _ Nothing _ = return ()
 genTarget output scope force (Just template) target = do
     let output' = output </> category target </> identify target
-    exists <- doesFileExist output'
+    exists <- liftIO . doesFileExist $ output'
     when (force || not exists) $ do
-        putStrLn $ "Writing " <> output'
+        liftIO $ putStrLn $ "Writing " <> output'
         let scope' = scope <> HashMap.fromList [(pack . category $ target, toGVal target)]
         generate output' scope' template

src/Index.hs Modified

@@ -4,13 +4,14 @@
     runIndex,
 ) where
 
+import Control.Monad (void)
 import qualified Data.HashMap.Strict as HashMap
-import Data.Text (Text)
+import Data.Text (Text, unpack)
 import System.FilePath ((</>))
 import Text.Ginger.GVal (GVal, toGVal)
-import Text.Ginger.Html (Html)
+import Text.Ginger.Html (Html, htmlSource)
 import Text.Ginger.Parse (SourcePos)
-import Text.Ginger.Run (Run)
+import Text.Ginger.Run (Run, easyRenderM)
 
 import Config
 import Templates
@@ -25,13 +26,16 @@
     case envIndexTemplate env of
         Nothing ->
             return ()
-        Just template ->
-            generate
-                (outputDirectory config </> "index.html")
-                (packageIndex config repos)
-                template
+        Just template -> do
+            writeFile output "" -- Clear contents of file if it exists
+            void $
+                easyRenderM
+                    (appendFile output . unpack . htmlSource)
+                    (packageIndex config repos)
+                    (templateGinger template)
           where
             config = envConfig env
+            output = outputDirectory config </> "index.html"
 
 ----------------------------------------------------------------------------------------
 -- Private -----------------------------------------------------------------------------