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

Commit 528d545f3e355e91555265e61ac46de7f93906e7
Parent: 7889de50d07eabbb36b9d0b9099b8c3c0c86b606
Author: mcol <mcol@posteo.net>
Date: 2021-10-05 20:52:27 +0100
Committer: mcol <mcol@posteo.net>
Committed: 2021-10-05 20:52:27 +0100

Add file modes to tree entries

src/Repositories.hs Modified

@@ -122,7 +122,22 @@
 loadCommit (CommitObjOid oid) = Just $ lookupCommit oid
 loadCommit _ = Nothing
 
-data TreeFileContents = FileContents Text | FolderContents [TreeFilePath]
+{-
+Valid modes:
+040000 Directory
+100644 Regular non-executable file
+100755 Regular executable file
+120000 Symbolic link
+160000 Submodule
+-}
+data TreeEntryMode = ModeDirectory | ModePlain | ModeExecutable | ModeSymlink | ModeSubmodule
+
+toMode :: BlobKind -> TreeEntryMode
+toMode PlainBlob = ModePlain
+toMode ExecutableBlob = ModeExecutable
+toMode SymlinkBlob = ModeSymlink
+
+data TreeFileContents = FileContents (TreeEntryMode, Text) | FolderContents [TreeFilePath]
 
 data TreeFile = TreeFile
     { treeFilePath :: TreeFilePath
@@ -136,9 +151,10 @@
     return $ zipWith TreeFile (fmap fst entries) contents
 
 gvalTreeEntry :: TreeEntry LgRepo -> ReaderT LgRepo IO TreeFileContents
-gvalTreeEntry (BlobEntry oid _) = FileContents . decodeUtf8With lenientDecode <$> catBlob oid
+gvalTreeEntry (BlobEntry oid kind) =
+    FileContents . (,) (toMode kind) . decodeUtf8With lenientDecode <$> catBlob oid
 gvalTreeEntry (TreeEntry oid) = FolderContents . fmap fst <$> (listTreeEntries =<< lookupTree oid)
-gvalTreeEntry (CommitEntry _) = return . FileContents $ "No contents"
+gvalTreeEntry (CommitEntry _) = return . FileContents $ (ModeSubmodule, "No contents")  -- TODO
 
 
 {-
@@ -181,7 +197,7 @@
 
 instance ToGVal m TreeFileContents where
     toGVal :: TreeFileContents -> GVal m
-    toGVal (FileContents text) = toGVal text
+    toGVal (FileContents (_, text)) = toGVal text
     toGVal (FolderContents filePaths) = def
         { asHtml = html . pack . show $ filePaths
         , asText = pack . show $ filePaths