🐙 Templated web page generator for your git repositories
git clone https://github.com/m-col/gitja
Files | Refs | Readme | License 
Commit 17f1d65b5b2e62dc74beb645c9afaaab9ea65650
Parent: 2a03a60270ab140a0871f717d2a014fb272d6bcc
Author: mcol <mcol@posteo.net>
Date: 2022-05-29 15:38:10 +0100
Committer: mcol <mcol@posteo.net>
Committed: 2022-05-29 15:38:10 +0100

remove generateIndex and use general function

src/Templates.hs Modified 

@@ -5,13 +5,8 @@
     Template (..),
     loadTemplate,
     generate,
-    generateIndex,
 ) where
 
-import Control.Monad.IO.Unlift
-import qualified Data.HashMap.Strict as HashMap
-import Control.Monad.Trans.Reader (ReaderT)
-import Control.Monad.IO.Class (liftIO)
 import Data.IORef (modifyIORef', newIORef, readIORef)
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
@@ -19,7 +14,7 @@
 import Path (Abs, File, Path, Rel, filename, toFilePath)
 import System.IO.Error (tryIOError)
 import qualified Text.Ginger.AST as G
-import Text.Ginger.GVal (GVal, toGVal)
+import Text.Ginger.GVal (GVal)
 import Text.Ginger.Html (Html, htmlSource)
 import Text.Ginger.Parse (ParserError (..), SourcePos, parseGingerFile)
 import Text.Ginger.Run
@@ -54,65 +49,21 @@
     includeResolver p = either (const Nothing) Just <$> tryIOError (readFile p)
 
 {-
-This is the generator function that receives variables and uses Ginger to render
-templates into Text.
--}
-generateIndex ::
-    Template ->
-    HashMap.HashMap T.Text (GVal RunRepo) ->
-    IO TL.Text
-generateIndex template scope = do
-    ioref <- newIORef . TB.fromText $ ""
-
-    let emit :: Html -> IO ()
-        emit = modifyIORef' ioref . flip mappend . TB.fromText . htmlSource
-
-        context = makeContextHtmlM (scopeLookup scope) emit
-
-    runGingerT context (templateGinger template)
-    TB.toLazyText <$> readIORef ioref
-
-  where
-    scopeLookup ::
-        HashMap.HashMap T.Text (GVal RunRepo) ->
-        T.Text ->
-        RunRepo (GVal RunRepo)
-    scopeLookup scope' key = do
-        case key of
-            "file" ->
-                return $ toGVal ("file" :: String)
-            _ ->
-                return $ toGVal $ HashMap.lookup key scope'
-
-
-{-
-This is the generator function that receives variables and uses Ginger to render
-templates into Text.
+This generator function uses Ginger to render templates into Text, using a provided
+lookup function to request data from calling code.
 -}
 generate ::
     (T.Text -> RunRepo (GVal RunRepo)) ->
     Template ->
-    HashMap.HashMap T.Text (GVal RunRepo) ->
     IO TL.Text
-generate repoLookup template scope = do
+generate scopeLookup template = do
     ioref <- newIORef . TB.fromText $ ""
 
     let emit :: Html -> IO ()
         emit = modifyIORef' ioref . flip mappend . TB.fromText . htmlSource
 
-        context = makeContextHtmlM repoLookup emit
+    runGingerT
+        (makeContextHtmlM scopeLookup emit)
+        (templateGinger template)
 
-    runGingerT context (templateGinger template)
     TB.toLazyText <$> readIORef ioref
-
-  --where
-    --scopeLookup ::
-    --    HashMap.HashMap T.Text (GVal RunRepo) ->
-    --    T.Text ->
-    --    RunRepo (GVal RunRepo)
-    --scopeLookup scope' key = do
-    --    case key of
-    --        "fileeeeeeeeeee" ->
-    --            return $ toGVal ("file" :: String)
-    --        _ ->
-    --            return $ toGVal $ HashMap.lookup key scope'

src/Repositories.hs Modified 

@@ -10,13 +10,12 @@
     getRefs,
 ) where
 
-import Control.Monad.IO.Unlift
 import qualified Bindings.Libgit2 as LG
 import Conduit (runConduit, sinkList, (.|))
 import Control.Exception (try)
 import Control.Monad (filterM, unless, when, (<=<))
 import Control.Monad.Extra (ifM, whenJust)
-import Control.Monad.IO.Class (liftIO)
+import Control.Monad.IO.Unlift
 import Control.Monad.Trans.Reader (ReaderT)
 import Data.Bool (bool)
 import qualified Data.ByteString as B
@@ -41,7 +40,7 @@
 import Path.IO (doesFileExist, ensureDir)
 import qualified System.Directory as D
 import qualified System.FilePath as FP
-import Text.Ginger.GVal (GVal, ToGVal, toGVal)
+import Text.Ginger.GVal (GVal, toGVal)
 
 import Env (Env (..))
 import Templates (Template (..), generate)
@@ -130,7 +129,7 @@
                 tree <- getTree gitHead
                 tags <- getRefs "refs/tags/"
                 branches <- getRefs "refs/heads/"
-                let scope = package env repos name (repositoryDescription repo) commits tree tags branches
+                let _scope = package env repos name (repositoryDescription repo) commits tree tags branches
 
                 -- Create the destination folders --
                 commitDir <- liftIO . parseRelDir $ "commit"
@@ -144,27 +143,26 @@
 
                     -- This annotation blocks the first use of gen from making t concrete
                     gen ::
-                        ToGVal RunRepo t =>
-                        (T.Text -> RunRepo (GVal RunRepo)) ->
+                        (ReaderT LgRepo IO (GVal RunRepo) -> IO (GVal RunRepo)) ->
                         Template ->
                         T.Text ->
                         Path Abs Dir ->
                         (t -> FilePath) ->
                         t ->
                         IO ()
-                    gen = genTarget scope quiet force
+                    gen = genTarget quiet force
 
-                withRunInIO \runInIO -> mapM_ (genRepo (repoLookup runInIO) output scope) (envRepoTemplates env)
+                withRunInIO \runInIO -> mapM_ (genRepo runInIO output) (envRepoTemplates env)
 
                 whenJust (envCommitTemplate env) \commitT ->
                     withRunInIO \runInIO -> do
                         output' <- fmap (output </>) . parseRelDir $ "commit"
-                        mapM_ (gen (repoLookup runInIO) commitT "commit" output' commitHref) commits
+                        mapM_ (gen runInIO commitT "commit" output' commitHref) commits
 
                 whenJust (envFileTemplate env) \fileT ->
                     withRunInIO \runInIO -> do
                         output' <- fmap (output </>) . parseRelDir $ "file"
-                        mapM_ (gen (repoLookup runInIO) fileT "file" output' fileHref) tree -- TODO: detect file changes
+                        mapM_ (gen runInIO fileT "file" output' fileHref) tree -- TODO: detect file changes
 
                 -- Copy any static files/folders into the output folder --
                 liftIO . envRepoCopyStatics env $ output
@@ -369,14 +367,13 @@
     dropName Nothing _ = Nothing
 
 genRepo ::
-    (T.Text -> RunRepo (GVal RunRepo)) ->
+    (ReaderT LgRepo IO (GVal RunRepo) -> IO (GVal RunRepo)) ->
     Path Abs Dir ->
-    HashMap.HashMap T.Text (GVal RunRepo) ->
     Template ->
     IO ()
-genRepo repoLookup output scope template =
+genRepo runInIO output template =
     let output' = toFilePath (output </> templatePath template)
-     in TL.writeFile output' =<< generate repoLookup template scope
+     in TL.writeFile output' =<< generate (cbRepoLookup runInIO) template
 
 ----------------------------------------------------------------------------------------
 -- Targets -----------------------------------------------------------------------------
@@ -395,32 +392,28 @@
 fileHref = T.unpack . treePathToHref
 
 genTarget ::
-    ToGVal RunRepo t =>
-    HashMap.HashMap T.Text (GVal RunRepo) ->
     Bool ->
     Bool ->
-    (T.Text -> RunRepo (GVal RunRepo)) ->
+    (ReaderT LgRepo IO (GVal RunRepo) -> IO (GVal RunRepo)) ->
     Template ->
     T.Text ->
     Path Abs Dir ->
     (t -> FilePath) ->
     t ->
     IO ()
-genTarget scope quiet force repoLookup template category output href target = do
+genTarget quiet force runInIO template category output href target = do
     output' <- fmap (output </>) . parseRelFile . href $ target
     exists <- doesFileExist output'
     when (force || not exists) $ do
         let output'' = toFilePath output'
-            scope' = HashMap.insert category (toGVal target) scope
         unless quiet . putStrLn $ "Writing " <> output''
-        TL.writeFile output'' =<< generate repoLookup template scope'
-
+        TL.writeFile output'' =<< generate (cbRepoLookup runInIO) template
 
 -- This loads data from the git repository
-repoLookup ::
+cbRepoLookup ::
     (ReaderT LgRepo IO (GVal RunRepo) -> IO (GVal RunRepo)) ->
     T.Text ->
     RunRepo (GVal RunRepo)
-repoLookup runInIO key = liftIO . runInIO $ case key of
+cbRepoLookup runInIO key = liftIO . runInIO $ case key of
     "tags" -> toGVal <$> getRefs "refs/tags/"
     key' -> return . toGVal $ key'

src/Index.hs Modified 

@@ -13,7 +13,7 @@
 import Text.Ginger.GVal (GVal, toGVal)
 
 import Env (Env (..))
-import Templates (Template (..), generateIndex)
+import Templates (Template (..), generate)
 import Types
 
 {-
@@ -22,7 +22,7 @@
 -}
 runIndex :: Env -> [Repo] -> IO ()
 runIndex env repos =
-    mapM_ (runIndexFile outputDir quiet scope) templates
+    mapM_ (runIndexFile indexLookup outputDir quiet) templates
   where
     outputDir = toFilePath . envOutput $ env
     quiet = envQuiet env
@@ -35,16 +35,19 @@
             , ("repositories", toGVal repos)
             ]
 
+    indexLookup :: T.Text -> RunRepo (GVal RunRepo)
+    indexLookup = return . toGVal . flip HashMap.lookup scope
+
 {-
 Use the scope created above to render a single index template.
 -}
 runIndexFile ::
+    (T.Text -> RunRepo (GVal RunRepo)) ->
     FilePath ->
     Bool ->
-    HashMap.HashMap T.Text (GVal RunRepo) ->
     Template ->
     IO ()
-runIndexFile outputDir quiet scope template = do
+runIndexFile indexLookup outputDir quiet template = do
     let output = combine outputDir . toFilePath . templatePath $ template
     unless quiet . putStrLn $ "Writing " <> output
-    TL.writeFile output =<< generateIndex template scope
+    TL.writeFile output =<< generate indexLookup template