gitja - Also render tree items that are directories with their contents

Commit 149344e72e0f381a8cba9cebf02bcf30b106a3aa
Parent: 6b24e8766cf82b8995512dcc0928626b56cca3c1
Author: mcol <mcol@posteo.net>
Date: 2021-10-04 20:50:33 +0100
Committer: mcol <mcol@posteo.net>
Committed: 2021-10-04 20:50:33 +0100

Also render tree items that are directories with their contents

templates/file.html Modified

@@ -4,16 +4,31 @@
     <meta charset="utf-8">
     <meta http-equiv="x-ua-compatible" content="ie=edge">
     <meta name="viewport" content="width=device-width, initial-scale=1">
-		<title>{{ name }} -- {{ file.path }}</title>
+    <title>{{ name }} -- {{ file.path }}</title>
     <link rel="stylesheet" href="{{- host }}/style.css" />
   </head>
 
   <body>
     <p>{{- name }}</p>
     <hr>
-		<p>File <b>{{ file.path }}</b></p>
+
+{% if file.is_directory %}
+    <p>Directory <b>{{ file.path }}</b></p>
+    <hr>
+      <ul>
+{% for item in file.contents %}
+        <li><a href="{{- host }}/{{ item }}">{{ item }}</a></li>
+{% endfor %}
+      </ul>
+
+{% else %}
+
+    <p>File <b>{{ file.path }}</b></p>
     <hr>
-    {{ file.contents }}
+{{ file.contents }}
+
+{% endif %}
+
     <hr>
   </body>
 </html>

src/Repositories.hs Modified

@@ -26,7 +26,7 @@
 import System.Directory (createDirectoryIfMissing)
 import System.FilePath ((</>), takeFileName)
 import System.IO.Error (tryIOError)
-import Text.Ginger.GVal (GVal, toGVal, ToGVal, asText, asHtml, asLookup)
+import Text.Ginger.GVal (GVal, toGVal, ToGVal, asText, asHtml, asLookup, asList)
 import Text.Ginger.Html (Html, html)
 import Text.Ginger.Run (Run)
 import Text.Ginger.Parse (SourcePos)
@@ -122,9 +122,11 @@
 loadCommit (CommitObjOid oid) = Just $ lookupCommit oid
 loadCommit _ = Nothing
 
+data TreeFileContents = FileContents Text | FolderContents [TreeFilePath]
+
 data TreeFile = TreeFile
     { treeFilePath :: TreeFilePath
-    , treeFileContents :: Text
+    , treeFileContents :: TreeFileContents
     }
 
 getTree :: CommitOid LgRepo -> ReaderT LgRepo IO [TreeFile]
@@ -133,10 +135,10 @@
     contents <- sequence . fmap (gvalTreeEntry . snd) $ entries
     return $ zipWith TreeFile (fmap fst entries) contents
 
-gvalTreeEntry :: TreeEntry LgRepo -> ReaderT LgRepo IO Text
-gvalTreeEntry (BlobEntry oid _) = return . decodeUtf8With lenientDecode =<< catBlob oid
-gvalTreeEntry (TreeEntry _) = return "No contents"
-gvalTreeEntry (CommitEntry _) = return "No contents"
+gvalTreeEntry :: TreeEntry LgRepo -> ReaderT LgRepo IO TreeFileContents
+gvalTreeEntry (BlobEntry oid _) = return . FileContents . decodeUtf8With lenientDecode =<< catBlob oid
+gvalTreeEntry (TreeEntry oid) = return . FolderContents . fmap fst =<< listTreeEntries =<< lookupTree oid
+gvalTreeEntry (CommitEntry _) = return . FileContents $ "No contents"
 
 
 {-
@@ -177,13 +179,28 @@
         , asLookup = Just . treeAsLookup $ treefile
         }
 
+instance ToGVal m TreeFileContents where
+    toGVal :: TreeFileContents -> GVal m
+    toGVal (FileContents text) = toGVal text
+    toGVal (FolderContents filePaths) = def
+        { asHtml = html . pack . show $ filePaths
+        , asText = pack . show $ filePaths
+        , asList = Just . fmap toGVal $ filePaths
+        }
+
 treeAsLookup :: TreeFile -> Text -> Maybe (GVal m)
 treeAsLookup treefile = \case
     "path" -> Just . toGVal . treeFilePath $ treefile
     "href" -> Just . toGVal . treePathToHref . treeFilePath $ treefile
     "contents" -> Just . toGVal . treeFileContents $ treefile
+    "is_directory" -> Just . toGVal . treeFileIsDirectory $ treefile
     _ -> Nothing
 
+treeFileIsDirectory :: TreeFile -> Bool
+treeFileIsDirectory treefile = case treeFileContents treefile of
+    FileContents _ -> False
+    FolderContents _ -> True
+
 {-
 Get the name of a tree file path's HTML file.
 -}