parent
3f8d0b3916
commit
ebbeba08b7
5 changed files with 108 additions and 6 deletions
41
Distribution/Package/ModuleForest.hs
Normal file
41
Distribution/Package/ModuleForest.hs
Normal file
|
@ -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)]
|
|
@ -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
|
||||
|
|
|
@ -23,6 +23,7 @@ library
|
|||
Data.Tag
|
||||
Data.GhcLinks
|
||||
Data.WebsiteContent
|
||||
Distribution.Package.ModuleForest
|
||||
Types
|
||||
|
||||
-- once stabilized, will likely move into its own package
|
||||
|
|
|
@ -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>
|
||||
|
|
|
@ -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…
Reference in a new issue