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

Commit c8ffa6a73a9e46f46ec431d3ed6f3c94b9c5109a
Parent: 2e6d4647b33adc81472e633fbe299146c09757ea
Author: mcol <mcol@posteo.net>
Date: 2021-11-27 18:43:00 +0000
Committer: mcol <mcol@posteo.net>
Committed: 2021-11-27 18:43:00 +0000

filter symlinks when finding template files

src/Templates.hs Modified

@@ -9,10 +9,10 @@
 ) where
 
 import Control.Monad (filterM, join, void, (<=<))
+import Control.Monad.Extra (findM)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Reader (ReaderT)
 import qualified Data.HashMap.Strict as HashMap
-import Data.List (find)
 import Data.Maybe (catMaybes)
 import Data.Text (Text, unpack)
 import Git.Libgit2 (LgRepo)
@@ -79,11 +79,14 @@
 
     -- Load files from template directory
     indexT <- collectTemplates files
-    commitT <- fmap join . mapM loadTemplate . find ((==) "commit.html" . toFilePath . filename) $ filesRepo
-    fileT <- fmap join . mapM loadTemplate . find ((==) "file.html" . toFilePath . filename) $ filesRepo
-    repoT <- collectTemplates . filter (flip notElem ["commit.html", "file.html"] . toFilePath . filename) $ filesRepo
-
-    -- Global environment
+    commitT <- findTemplate "commit.html" filesRepo
+    fileT <- findTemplate "file.html" filesRepo
+    repoT <-
+        collectTemplates
+            . filter (flip notElem ["commit.html", "file.html"] . toFilePath . filename)
+            $ filesRepo
+
+    -- App environment
     return
         Env
             { envConfig = config
@@ -98,9 +101,6 @@
             , envForce = force
             }
   where
-    collectTemplates :: [Path Abs File] -> IO [Template]
-    collectTemplates = fmap catMaybes . mapM loadTemplate . filter ((==) ".html" . FP.takeExtension . toFilePath)
-
     ls :: FilePath -> IO ([Path Abs Dir], [Path Abs File])
     ls dir = do
         canon <- parseAbsDir =<< canonicalizePath dir
@@ -109,6 +109,20 @@
             then listDir canon
             else return ([], [])
 
+    collectTemplates :: [Path Abs File] -> IO [Template]
+    collectTemplates = fmap catMaybes . mapM loadTemplate <=< filterM isMatch
+      where
+        isMatch p = do
+            ((FP.takeExtension . toFilePath $ p) == ".html" &&)
+                <$> (fmap not . pathIsSymbolicLink . toFilePath $ p)
+
+    findTemplate :: FilePath -> [Path Abs File] -> IO (Maybe Template)
+    findTemplate name = fmap join . mapM loadTemplate <=< findM isMatch
+      where
+        isMatch p =
+            ((toFilePath . filename $ p) == name &&)
+                <$> (fmap not . pathIsSymbolicLink . toFilePath $ p)
+
 {-
 This is the generator function that receives repository-specific variables and uses
 Ginger to render templates using them.

gitserve.cabal Modified

@@ -24,6 +24,7 @@
                      , data-default
                      , dhall
                      , directory
+                     , extra
                      , filepath
                      , ginger >= 0.10.3.0
                      , gitlib