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: ["m-col"] +custom: ["https://liberapay.com/mcol"] +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