Browse Source

Lay out module listings hierarchically

Closes #115
zudov-ghc-7.10
Konstantin Zudov 6 years ago
parent
commit
ebbeba08b7
  1. 41
      Distribution/Package/ModuleForest.hs
  2. 22
      Handler/Package.hs
  3. 1
      stackage-server.cabal
  4. 5
      templates/package.hamlet
  5. 45
      templates/package.lucius

41
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)]

22
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

1
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

5
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>
$forall mname <- modules
<li>
<a href=@{haddockUrl sname (toPkgVer pname' version) mname}>#{mname}
^{renderModules sname (toPkgVer pname' version) modules}
$if not (LT.null (LT.renderHtml (packageDescription package)))
<div .markdown-container .readme-container>

45
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;
}

Loading…
Cancel
Save