Lay out module listings hierarchically

Closes #115

Distribution/Package/ModuleForest.hs

@@ -0,0 +1,41 @@
+-- Adopted from https://github.com/haskell/hackage-server/blob/master/Distribution/Server/Packages/ModuleForest.hs
+
+module Distribution.Package.ModuleForest
+    ( moduleName
+    , moduleForest
+    , ModuleTree(..)
+    , ModuleForest
+    , NameComponent
+    ) where
+
+import           Distribution.ModuleName (ModuleName)
+import qualified Distribution.ModuleName as ModuleName
+import           Import
+
+type NameComponent = Text
+
+type ModuleForest = [ModuleTree]
+data ModuleTree = Node { component  :: NameComponent
+                       , isModule   :: Bool
+                       , subModules :: ModuleForest
+                       }
+                deriving (Show, Eq)
+
+moduleName :: Text -> ModuleName
+moduleName = ModuleName.fromString . unpack
+
+moduleForest :: [ModuleName] -> ModuleForest
+moduleForest = foldr (addToForest . map pack . ModuleName.components) []
+
+addToForest :: [NameComponent] -> ModuleForest -> ModuleForest
+addToForest [] trees = trees
+addToForest comps [] = mkSubTree comps
+addToForest comps@(comp1:cs) (t@(component -> comp2):ts) = case
+  compare comp1 comp2 of
+    GT -> t : addToForest comps ts
+    EQ -> Node comp2 (isModule t || null cs) (addToForest cs (subModules t)) : ts
+    LT -> mkSubTree comps ++ t : ts
+
+mkSubTree :: [Text] -> ModuleForest
+mkSubTree []     = []
+mkSubTree (c:cs) = [Node c (null cs) (mkSubTree cs)]

Handler/Package.hs

@@ -14,10 +14,12 @@ import           Data.Tag
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.Text.Lazy as LT
+import           Distribution.Package.ModuleForest
 
 import           Database.Esqueleto ((^.))
 import qualified Database.Esqueleto as E
 import qualified Database.Persist as P
+
 import           Formatting
 import           Import
 import qualified Text.Blaze.Html.Renderer.Text as LT
@@ -78,6 +80,26 @@ packagePage mversion pname = do
             toPkgVer x y = concat [x, "-", y]
         $(widgetFile "package")
   where enumerate = zip [0::Int ..]
+        renderModules sname version = renderForest [] . moduleForest . map moduleName
+          where
+            renderForest _ [] = mempty
+            renderForest pathRev trees =
+              [hamlet|<ul .docs-list>
+                        $forall tree <- trees
+                          ^{renderTree tree}
+              |]
+              where
+                renderTree (Node{..}) = [hamlet|
+                  <li>
+                    $if isModule
+                      <a href=@{haddockUrl sname version path'}>#{path'}
+                    $else
+                      #{path'}
+                    ^{renderForest pathRev' subModules}
+                |]
+                  where
+                    pathRev' = component:pathRev
+                    path'    = T.intercalate "." $ reverse pathRev'
 
 -- | An identifier specified in a package. Because this field has
 -- quite liberal requirements, we often encounter various forms. A

stackage-server.cabal

@@ -23,6 +23,7 @@ library
                      Data.Tag
                      Data.GhcLinks
                      Data.WebsiteContent
+                     Distribution.Package.ModuleForest
                      Types
 
                      -- once stabilized, will likely move into its own package

templates/package.hamlet

@@ -89,10 +89,7 @@ $newline never
                     $if null modules
                         <p>There are no documented modules for this package.
                     $else
-                        <ul .docs-list>
+                        ^{renderModules sname (toPkgVer pname' version) modules}
-                            $forall mname <- modules
-                                <li>
-                                    <a href=@{haddockUrl sname (toPkgVer pname' version) mname}>#{mname}
 
 $if not (LT.null (LT.renderHtml (packageDescription package)))
     <div .markdown-container .readme-container>

templates/package.lucius

@@ -52,17 +52,57 @@ h3 {
   margin-top: 0.5em;
   padding-top: 0.5em;
 }
+
 .docs {
   margin-top: 0.5em;
   border-top: 1px solid #ddd;
   padding-top: 0.5em;
   ul {
     list-style-type: none;
-    margin-left: 0;
-    padding-left: 0;
     li { line-height: 1.5em }
   }
 }
+
+.docs, .docs ul, .docs li {
+  position: relative;
+}
+
+.docs ul {
+  list-style:none;
+  padding-left: 10px;
+}
+
+.docs li::before, .docs li::after {
+  content: "";
+  position: absolute;
+  left: -12px;
+}
+
+.docs li::before {
+  border-top: 1px solid #DDD;
+  top: 9px;
+  width: 8px;
+  height: 0;
+}
+
+.docs li::after {
+  border-left: 1px solid #DDD;
+  height: 100%;
+  width: 0px;
+  top: 0;
+}
+.docs ul > li:last-child::after {
+    height: 9px;
+}
+
+.docs > ul > li::after {
+  border-left: none;
+}
+
+.docs > ul > li::before {
+  border-top: none;
+}
+
 .downloads {
   margin-left: 1em;
 }
@@ -251,3 +291,4 @@ div.plain-text {
   padding: 0.5em;
   background: #eef;
 }
+