src/Types.hs Modified

@@ -60,7 +60,7 @@
     , treeFileMode :: TreeEntryMode
     }
 
-data TreeFileContents = FileContents Text | FolderContents [TreeFilePath]
+data TreeFileContents = FileContents Text | FolderContents [TreeFile]
 
 data TreeEntryMode = ModeDirectory | ModePlain | ModeExecutable | ModeSymlink | ModeSubmodule
     deriving stock (Show)
@@ -109,11 +109,11 @@
 instance ToGVal m TreeFileContents where
     toGVal :: TreeFileContents -> GVal m
     toGVal (FileContents text) = toGVal text
-    toGVal (FolderContents filePaths) =
+    toGVal (FolderContents treeFiles) =
         def
-            { asHtml = html . pack . show $ filePaths
-            , asText = pack . show $ filePaths
-            , asList = Just . fmap toGVal $ filePaths
+            { asHtml = html . pack . show . fmap (toString . treeFilePath) $ treeFiles
+            , asText = pack . show . fmap (toString . treeFilePath) $ treeFiles
+            , asList = Just . fmap toGVal $ treeFiles
             }
 
 treeAsLookup :: TreeFile -> Text -> Maybe (GVal m)

src/Repositories.hs Modified

@@ -119,19 +119,28 @@
 loadCommit _ = Nothing
 
 {-
-Collect tree information.
+Collect tree information for the given commit. Recurses on directories to list their
+contents.
 -}
 getTree :: CommitOid LgRepo -> ReaderT LgRepo IO [TreeFile]
-getTree commitID = do
-    entries <- listTreeEntries =<< lookupTree . commitTree =<< lookupCommit commitID
-    contents <- mapM (getEntryContents . snd) entries
-    modes <- mapM (getEntryModes . snd) entries
-    return $ zipWith3 TreeFile (fmap fst entries) contents modes
-
-getEntryContents :: TreeEntry LgRepo -> ReaderT LgRepo IO TreeFileContents
-getEntryContents (BlobEntry oid _) = FileContents . decodeUtf8With lenientDecode <$> catBlob oid
-getEntryContents (TreeEntry oid) = FolderContents . fmap fst <$> (listTreeEntries =<< lookupTree oid)
-getEntryContents (CommitEntry oid) = return . FileContents . pack . show . untag $ oid
+getTree = getTree' "" . commitTree <=< lookupCommit
+
+getTree' :: TreeFilePath -> TreeOid LgRepo -> ReaderT LgRepo IO [TreeFile]
+getTree' parent toid = do
+    entries <- listTreeEntries =<< lookupTree toid
+    let entries' = fmap (prependParent parent) entries
+    contents <- mapM getEntryContents entries'
+    modes <- mapM (getEntryModes . snd) entries'
+    return $ zipWith3 TreeFile (fmap fst entries') contents modes
+
+prependParent :: TreeFilePath -> (TreeFilePath, TreeEntry LgRepo) -> (TreeFilePath, TreeEntry LgRepo)
+prependParent "" pathentry = pathentry
+prependParent parent (path, entry) = (mconcat [parent, "/", path], entry)
+
+getEntryContents :: (TreeFilePath, TreeEntry LgRepo) -> ReaderT LgRepo IO TreeFileContents
+getEntryContents (_, BlobEntry oid _) = FileContents . decodeUtf8With lenientDecode <$> catBlob oid
+getEntryContents (path, TreeEntry oid) = FolderContents <$> getTree' path oid
+getEntryContents (_, CommitEntry oid) = return . FileContents . pack . show . untag $ oid
 
 getEntryModes :: TreeEntry LgRepo -> ReaderT LgRepo IO TreeEntryMode
 getEntryModes (BlobEntry _ kind) = return . blobkindToMode $ kind