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

Commit eaba5d50d606abce1ac39a1d6d2d0d282efc975a
Parent: 437063ec4c87b45d57f8e8518b01c21d55a48229
Author: mcol <mcol@posteo.net>
Date: 2021-12-04 23:01:08 +0300
Committer: mcol <mcol@posteo.net>
Committed: 2021-12-04 23:01:08 +0300

Qualify Text module & strip leading periods from file.href

Closes #23

test/test.sh Modified

@@ -31,17 +31,18 @@
 declare -a TESTS
 TESTS=(
     "index.html"
-    "link.html"
-    "style.css"
+    "link.html"  # Symbolic link at top level
+    "style.css"  # Static file at top level
     "so_called_binary_file"
-    "static/a_nice_file"
+    "static/a_nice_file"  # Static folder at top level
     "gitserve/index.html"
     "gitserve/commit/0292014748caae952bbc8dd6225680d83c0a5135.html"
     "gitserve/file/test.expected.gitserve.file.html"
     "gitserve/file/test.templates.style.css.html"
     "gitserve/file/test.templates.so_called_binary_file.html"
-    "gitserve/log.html"
-    "gitserve/static/another_file"
+    "gitserve/file/github.FUNDING.yml.html"  # Drops leading period
+    "gitserve/log.html"  # Symbolic link inside repo/
+    "gitserve/static/another_file"  # Static folder inside repo/
 )
 
 stack run -- -c test/config.dhall -q || exit 1

test/templates/repo/file.html Modified

@@ -1,5 +1,5 @@
 {% extends "../title.html.include" -%}
-{%- block title -%}{{ file.path }}{%- endblock -%}
+{%- block title -%}{{ file }}{%- endblock -%}
 
 {% block body %}
 scope: file

test/expected/gitserve/file/github.FUNDING.yml.html Added

@@ -0,0 +1,23 @@
+.github/FUNDING.yml
+scope: file
+file: .github/FUNDING.yml
+file.path: .github/FUNDING.yml
+file.href: github.FUNDING.yml.html
+file.contents: github: [&quot;m-col&quot;]
+custom: [&quot;https://liberapay.com/mcol&quot;]
+file.mode: Plain
+file.mode_octal: 00644
+file.mode_symbolic: -rw-r--r--
+if file.is_directory then "directory" else "file": "file"
+
+file scope also should have data from repo scope available:
+host: https://github.com/m-col/gitserve
+repos: gitserve
+name: gitserve
+description: 🐙 Templated web page generator for your git repositories
+commits: (skipped)
+tree: (skipped)
+tags: 1
+branches: 1
+readme.path: README.rst
+license.path: LICENSE

src/Types.hs Modified

@@ -15,7 +15,6 @@
 import Control.Monad.Catch (throwM)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Reader (ReaderT)
-import Data.ByteString.UTF8 (toString)
 import Data.Default (def)
 import Data.Maybe (listToMaybe)
 import Data.Tagged (untag)
@@ -108,7 +107,7 @@
 objects contained therein.
 -}
 data TreeFile = TreeFile
-    { treeFilePath :: TreeFilePath
+    { treeFilePath :: Text
     , treeFileContents :: TreeFileContents
     , treeFileMode :: TreeEntryMode
     }
@@ -168,8 +167,8 @@
     toGVal :: TreeFile -> GVal RunRepo
     toGVal treefile =
         def
-            { asHtml = html . pack . toString . treeFilePath $ treefile
-            , asText = pack . show . treeFilePath $ treefile
+            { asHtml = html . treeFilePath $ treefile
+            , asText = treeFilePath treefile
             , asLookup = Just . treeAsLookup $ treefile
             , asBoolean = True -- Used for conditionally checking readme/license template variables.
             }
@@ -180,16 +179,16 @@
     toGVal (FileContents text) = toGVal . strip $ text
     toGVal (FolderContents treeFiles) =
         def
-            { asHtml = html . pack . show . fmap (toString . treeFilePath) $ treeFiles
-            , asText = pack . show . fmap (toString . treeFilePath) $ treeFiles
+            { asHtml = html . pack . show . fmap treeFilePath $ treeFiles
+            , asText = pack . show . fmap treeFilePath $ treeFiles
             , asList = Just . fmap toGVal $ treeFiles
             }
 
 treeAsLookup :: TreeFile -> Text -> Maybe (GVal RunRepo)
 treeAsLookup treefile = \case
     "path" -> Just . toGVal . treeFilePath $ treefile
-    "name" -> Just . toGVal . takeFileName . toString . treeFilePath $ treefile
-    "href" -> Just . toGVal . treePathToHref . treeFilePath $ treefile
+    "name" -> Just . toGVal . takeFileName . T.unpack . treeFilePath $ treefile
+    "href" -> Just . toGVal . treePathToHref $ treefile
     "contents" -> Just . toGVal . treeFileContents $ treefile
     "mode" -> Just . toGVal . drop 4 . show . treeFileMode $ treefile
     "mode_octal" -> Just . toGVal . modeToOctal . treeFileMode $ treefile
@@ -209,10 +208,10 @@
     _ -> False
 
 {-
-Get the name of a tree file path's HTML file.
+Get the name of a tree file path's HTML file. Leading periods are dropped.
 -}
-treePathToHref :: TreeFilePath -> Text
-treePathToHref = flip T.append ".html" . T.replace "/" "." . decodeUtf8With lenientDecode
+treePathToHref :: TreeFile -> Text
+treePathToHref = T.dropWhile (== '.') . flip T.append ".html" . T.replace "/" "." . treeFilePath
 
 {-
 Data to store information about references: tags and branches.

src/Repositories.hs Modified

@@ -15,14 +15,14 @@
 import Control.Monad.Extra (ifM)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Reader (ReaderT)
-import Data.ByteString.UTF8 (toString)
 import Data.Either (isRight)
 import qualified Data.HashMap.Strict as HashMap
 import Data.Maybe (catMaybes, fromJust, mapMaybe)
 import Data.Tagged
-import Data.Text (Text, isPrefixOf, pack, strip, stripPrefix, toLower, unpack)
-import Data.Text.Encoding (decodeUtf8With)
-import Data.Text.Encoding.Error (lenientDecode)
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.Text.Encoding.Error as T
 import Git
 import Git.Libgit2 (LgRepo, lgFactory)
 import Path (Abs, Dir, File, Path, Rel, dirname, parseRelDir, parseRelFile, toFilePath, (</>))
@@ -76,9 +76,9 @@
         )
         >>= \case
             Just file ->
-                strip . pack <$> readFile file
+                T.strip . T.pack <$> readFile file
             Nothing ->
-                return . pack . toFilePath . dirname $ dir
+                return . T.pack . toFilePath . dirname $ dir
   where
     inTop = toFilePath dir FP.</> "description"
     inGit = toFilePath dir FP.</> ".git" FP.</> "description"
@@ -151,10 +151,10 @@
     HashMap.fromList
         [ ("host", toGVal . envHost $ env)
         , ("repositories", toGVal repos)
-        , ("name", toGVal . pack . init . toFilePath $ name)
+        , ("name", toGVal . T.pack . init . toFilePath $ name)
         , ("description", toGVal description)
         , ("commits", toGVal commits)
-        , ("tree", toGVal . filter (notElem FP.pathSeparator . toString . treeFilePath) $ tree)
+        , ("tree", toGVal . filter (notElem FP.pathSeparator . T.unpack . treeFilePath) $ tree)
         , ("tree_recursive", toGVal tree)
         , ("tags", toGVal tags)
         , ("branches", toGVal branches)
@@ -188,7 +188,7 @@
     let entries' = fmap (prependParent parent) entries
     contents <- mapM getEntryContents entries'
     modes <- mapM (getEntryModes . snd) entries'
-    return $ zipWith3 TreeFile (fmap fst entries') contents modes
+    return $ zipWith3 TreeFile (fmap treePaths entries') contents modes
 
 prependParent :: TreeFilePath -> (TreeFilePath, TreeEntry LgRepo) -> (TreeFilePath, TreeEntry LgRepo)
 prependParent "" pathentry = pathentry
@@ -197,13 +197,16 @@
 getEntryContents :: (TreeFilePath, TreeEntry LgRepo) -> ReaderT LgRepo IO TreeFileContents
 getEntryContents (_, BlobEntry oid _) = getBlobContents oid
 getEntryContents (path, TreeEntry oid) = FolderContents <$> getTree' path oid
-getEntryContents (_, CommitEntry oid) = return . FileContents . pack . show . untag $ oid
+getEntryContents (_, CommitEntry oid) = return . FileContents . T.pack . show . untag $ oid
 
 getEntryModes :: TreeEntry LgRepo -> ReaderT LgRepo IO TreeEntryMode
 getEntryModes (BlobEntry _ kind) = return . blobkindToMode $ kind
 getEntryModes (TreeEntry _) = return ModeDirectory
 getEntryModes (CommitEntry _) = return ModeSubmodule
 
+treePaths :: (TreeFilePath, TreeEntry LgRepo) -> Text
+treePaths = T.decodeUtf8With T.lenientDecode . fst
+
 {-
 Find a file in the tree starting with the specified prefix. The prefix is looked for on
 the full path, so will only find files in the top level directory.
@@ -212,7 +215,7 @@
 findFile _ [] = Nothing
 findFile prefix (f : fs) = if isReadme f then Just f else findFile prefix fs
   where
-    isReadme = isPrefixOf prefix . toLower . decodeUtf8With lenientDecode . treeFilePath
+    isReadme = T.isPrefixOf prefix . T.toLower . treeFilePath
 
 {-
 Collect information about references. TODO: Find a more canonical way to split
@@ -220,12 +223,12 @@
 -}
 getRefs :: Text -> ReaderT LgRepo IO [Ref]
 getRefs ref = do
-    names <- filter (isPrefixOf ref) <$> listReferences
+    names <- filter (T.isPrefixOf ref) <$> listReferences
     maybeOids <- mapM resolveReference names
     let names' = catMaybes . zipWith dropName maybeOids $ names
     objs <- mapM lookupObject . catMaybes $ maybeOids
     maybeCommits <- mapM refObjToCommit objs
-    let names'' = map (fromJust . stripPrefix ref) . catMaybes . zipWith dropName maybeCommits $ names'
+    let names'' = map (fromJust . T.stripPrefix ref) . catMaybes . zipWith dropName maybeCommits $ names'
     return . zipWith Ref names'' . catMaybes $ maybeCommits
   where
     refObjToCommit :: Object r (ReaderT LgRepo IO) -> ReaderT LgRepo IO (Maybe (Commit r))
@@ -268,7 +271,7 @@
     category = const "commit"
 
 instance Target TreeFile where
-    identify = unpack . treePathToHref . treeFilePath
+    identify = T.unpack . treePathToHref
     category = const "file"
 
 genTarget ::
@@ -287,5 +290,5 @@
     exists <- liftIO . doesFileExist $ output'
     when (force || not exists) $ do
         liftIO . unless quiet . putStrLn $ "Writing " <> toFilePath output'
-        let scope' = scope <> HashMap.fromList [(pack . category $ target, toGVal target)]
+        let scope' = scope <> HashMap.fromList [(T.pack . category $ target, toGVal target)]
         generate output' scope' template