mirror of
https://github.com/carp-lang/Carp.git
synced 2024-10-26 13:51:50 +03:00
fix: render submodules in html docs (#1242)
* fix: render submodules in html docs * fix: also render deeply nested modules * feat: no prefixes in nested submodule doc rendering * fix: fix text alignment of module index for sdl * feat: make submodules expandable
This commit is contained in:
parent
62dff785ab
commit
f7785ad93d
@ -17,6 +17,7 @@
|
||||
quartiles (Array Double),
|
||||
iqr Double
|
||||
])
|
||||
(hidden Summary)
|
||||
|
||||
(doc mean "Compute the mean of the samples data.")
|
||||
(defn mean [data]
|
||||
|
@ -2,6 +2,7 @@
|
||||
|
||||
(defmodule Test
|
||||
(deftype State [passed Int, failed Int])
|
||||
(hidden State)
|
||||
(use Color.Id)
|
||||
(hidden handler)
|
||||
(defn handler [state expected actual descr what op]
|
||||
|
@ -18,10 +18,10 @@ a:hover {
|
||||
}
|
||||
|
||||
.logo {
|
||||
text-align: right;
|
||||
float: right;
|
||||
width: 150px;
|
||||
font-family: "Hasklig", "Lucida Console", monospace;
|
||||
width: 20%;
|
||||
margin-right: 10%;
|
||||
}
|
||||
|
||||
.logo img {
|
||||
@ -29,6 +29,18 @@ a:hover {
|
||||
margin-bottom: 1em;
|
||||
}
|
||||
|
||||
details summary {
|
||||
cursor: pointer;
|
||||
}
|
||||
|
||||
details summary > * {
|
||||
display: inline;
|
||||
}
|
||||
|
||||
.index {
|
||||
text-align: left;
|
||||
}
|
||||
|
||||
.args {
|
||||
background-color: #eee;
|
||||
padding: 3px;
|
||||
@ -42,6 +54,7 @@ ul {
|
||||
list-style-type: none;
|
||||
font-family: "Hasklig", "Lucida Console", monospace;
|
||||
line-height: 1.4em;
|
||||
padding-left: 1em;
|
||||
}
|
||||
|
||||
.title {
|
||||
@ -49,9 +62,13 @@ ul {
|
||||
}
|
||||
|
||||
.content {
|
||||
margin: 3em auto auto auto;
|
||||
width: 80%;
|
||||
width: 100%;
|
||||
}
|
||||
|
||||
.module {
|
||||
max-width: 800px;
|
||||
margin: auto;
|
||||
margin-top: 5em;
|
||||
}
|
||||
|
||||
h1 {
|
||||
@ -75,20 +92,6 @@ h3 {
|
||||
margin: 3.5em 0em 0em 0em;
|
||||
}
|
||||
|
||||
.deprecation-notice {
|
||||
background-color: #f99;
|
||||
text-transform: uppercase;
|
||||
float: right;
|
||||
padding: 5px;
|
||||
margin: -5px;
|
||||
}
|
||||
|
||||
.deprecation-text {
|
||||
background-color: #f99;
|
||||
padding-left: 5px;
|
||||
padding-right: 5px;
|
||||
}
|
||||
|
||||
.sig {
|
||||
font-family: "Hasklig", "Source Code Pro", "Lucida Console", monospace;
|
||||
}
|
||||
|
@ -18,10 +18,10 @@ a:hover {
|
||||
}
|
||||
|
||||
.logo {
|
||||
text-align: right;
|
||||
float: right;
|
||||
width: 150px;
|
||||
font-family: "Hasklig", "Lucida Console", monospace;
|
||||
width: 20%;
|
||||
margin-right: 10%;
|
||||
}
|
||||
|
||||
.logo img {
|
||||
@ -29,6 +29,18 @@ a:hover {
|
||||
margin-bottom: 1em;
|
||||
}
|
||||
|
||||
details summary {
|
||||
cursor: pointer;
|
||||
}
|
||||
|
||||
details summary > * {
|
||||
display: inline;
|
||||
}
|
||||
|
||||
.index {
|
||||
text-align: left;
|
||||
}
|
||||
|
||||
.args {
|
||||
background-color: #eee;
|
||||
padding: 3px;
|
||||
@ -42,6 +54,7 @@ ul {
|
||||
list-style-type: none;
|
||||
font-family: "Hasklig", "Lucida Console", monospace;
|
||||
line-height: 1.4em;
|
||||
padding-left: 1em;
|
||||
}
|
||||
|
||||
.title {
|
||||
@ -49,9 +62,13 @@ ul {
|
||||
}
|
||||
|
||||
.content {
|
||||
margin: 3em auto auto auto;
|
||||
width: 80%;
|
||||
width: 100%;
|
||||
}
|
||||
|
||||
.module {
|
||||
max-width: 800px;
|
||||
margin: auto;
|
||||
margin-top: 5em;
|
||||
}
|
||||
|
||||
h1 {
|
||||
|
@ -1,6 +1,6 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module Obj where
|
||||
|
||||
@ -228,6 +228,10 @@ isTypeDef (XObj (Lst (XObj (Deftype _) _ _ : _)) _ _) = True
|
||||
isTypeDef (XObj (Lst (XObj (DefSumtype _) _ _ : _)) _ _) = True
|
||||
isTypeDef _ = False
|
||||
|
||||
isMod :: XObj -> Bool
|
||||
isMod (XObj (Mod _ _) _ _) = True
|
||||
isMod _ = False
|
||||
|
||||
-- | This instance is needed for the dynamic Dictionary
|
||||
instance Ord Obj where
|
||||
compare (Str a) (Str b) = compare a b
|
||||
|
@ -37,9 +37,11 @@ saveDocsForEnvs ctx pathsAndEnvBinders =
|
||||
let dir = projectDocsDir ctx
|
||||
title = projectTitle ctx
|
||||
generateIndex = projectDocsGenerateIndex ctx
|
||||
allEnvNames = fmap (getModuleName . fst . getEnvAndMetaFromBinder . snd) pathsAndEnvBinders
|
||||
dependencies = getDependenciesForEnvs (Prelude.map (\(p, b) -> (p, fst (getEnvAndMetaFromBinder b))) pathsAndEnvBinders)
|
||||
pathsAndEnvBinders' = pathsAndEnvBinders ++ dependencies
|
||||
allEnvNames = fmap fst pathsAndEnvBinders'
|
||||
in do
|
||||
mapM_ (saveDocsForEnvBinder ctx allEnvNames) pathsAndEnvBinders
|
||||
mapM_ (saveDocsForEnvBinder ctx allEnvNames) pathsAndEnvBinders'
|
||||
when
|
||||
generateIndex
|
||||
( writeFile
|
||||
@ -47,6 +49,21 @@ saveDocsForEnvs ctx pathsAndEnvBinders =
|
||||
(projectIndexPage ctx allEnvNames)
|
||||
)
|
||||
putStrLn ("Generated docs to '" ++ dir ++ "'")
|
||||
where
|
||||
getDependenciesForEnvs = Prelude.concat . Prelude.map getEnvDependencies
|
||||
getEnvDependencies (SymPath ps p, e) =
|
||||
let envs =
|
||||
Prelude.map
|
||||
(\(n, b) -> (SymPath (ps ++ [p]) n, b))
|
||||
( Prelude.filter
|
||||
(\(_, Binder _ x) -> isMod x)
|
||||
( Prelude.filter
|
||||
shouldEmitDocsForBinder
|
||||
(Map.toList (envBindings e))
|
||||
)
|
||||
)
|
||||
in envs
|
||||
++ getDependenciesForEnvs (Prelude.map (\(n, Binder _ (XObj (Mod env _) _ _)) -> (n, env)) envs)
|
||||
|
||||
-- | This function expects a binder that contains an environment, anything else is a runtime error.
|
||||
getEnvAndMetaFromBinder :: Binder -> (Env, MetaData)
|
||||
@ -55,7 +72,7 @@ getEnvAndMetaFromBinder envBinder =
|
||||
Binder meta (XObj (Mod env _) _ _) -> (env, meta)
|
||||
_ -> error "Binder's not a module. This should be detected in 'commandSaveDocsInternal'."
|
||||
|
||||
projectIndexPage :: Project -> [String] -> String
|
||||
projectIndexPage :: Project -> [SymPath] -> String
|
||||
projectIndexPage ctx moduleNames =
|
||||
let logo = projectDocsLogo ctx
|
||||
url = projectDocsURL ctx
|
||||
@ -91,17 +108,17 @@ headOfPage css =
|
||||
getModuleName :: Env -> String
|
||||
getModuleName env = fromMaybe "Global" (envModuleName env)
|
||||
|
||||
saveDocsForEnvBinder :: Project -> [String] -> (SymPath, Binder) -> IO ()
|
||||
saveDocsForEnvBinder :: Project -> [SymPath] -> (SymPath, Binder) -> IO ()
|
||||
saveDocsForEnvBinder ctx moduleNames (envPath, envBinder) =
|
||||
do
|
||||
let SymPath _ moduleName = envPath
|
||||
let moduleName = show envPath
|
||||
dir = projectDocsDir ctx
|
||||
fullPath = dir </> moduleName ++ ".html"
|
||||
string = renderHtml (envBinderToHtml envBinder ctx (show envPath) moduleNames)
|
||||
createDirectoryIfMissing False dir
|
||||
writeFile fullPath string
|
||||
|
||||
envBinderToHtml :: Binder -> Project -> String -> [String] -> H.Html
|
||||
envBinderToHtml :: Binder -> Project -> String -> [SymPath] -> H.Html
|
||||
envBinderToHtml envBinder ctx moduleName moduleNames =
|
||||
let (env, meta) = getEnvAndMetaFromBinder envBinder
|
||||
title = projectTitle ctx
|
||||
@ -126,26 +143,42 @@ envBinderToHtml envBinder ctx moduleName moduleNames =
|
||||
--span_ "CARP DOCS FOR"
|
||||
H.div ! A.class_ "title" $ H.toHtml title
|
||||
moduleIndex moduleNames
|
||||
H.h1 (H.toHtml moduleName)
|
||||
H.div ! A.class_ "module-description" $ H.preEscapedToHtml moduleDescriptionHtml
|
||||
mapM_ (binderToHtml . snd) (Prelude.filter shouldEmitDocsForBinder (Map.toList (envBindings env)))
|
||||
H.div ! A.class_ "module" $
|
||||
do
|
||||
H.h1 (H.toHtml moduleName)
|
||||
H.div ! A.class_ "module-description" $ H.preEscapedToHtml moduleDescriptionHtml
|
||||
mapM_ (binderToHtml moduleName . snd) (Prelude.filter shouldEmitDocsForBinder (Map.toList (envBindings env)))
|
||||
|
||||
shouldEmitDocsForBinder :: (String, Binder) -> Bool
|
||||
shouldEmitDocsForBinder (_, Binder meta _) =
|
||||
not (metaIsTrue meta "hidden")
|
||||
|
||||
moduleIndex :: [String] -> H.Html
|
||||
moduleIndex :: [SymPath] -> H.Html
|
||||
moduleIndex moduleNames =
|
||||
H.div ! A.class_ "index" $
|
||||
H.ul $
|
||||
mapM_ moduleLink moduleNames
|
||||
H.div ! A.class_ "index" $ grouped moduleNames
|
||||
where
|
||||
grouped names = H.ul $ mapM_ gen (order names)
|
||||
gen (m, subs) =
|
||||
H.li $
|
||||
if Prelude.null subs
|
||||
then moduleLink m
|
||||
else H.details $
|
||||
do
|
||||
H.summary (moduleLink m)
|
||||
grouped subs
|
||||
order [] = []
|
||||
order (m : mods) =
|
||||
let (isIn, isNotIn) = List.partition (symBelongsToMod m) mods
|
||||
in (m, isIn) : order isNotIn
|
||||
symBelongsToMod (SymPath xs x) (SymPath ys y) =
|
||||
List.isPrefixOf (xs ++ [x]) (ys ++ [y])
|
||||
|
||||
moduleLink :: String -> H.Html
|
||||
moduleLink name =
|
||||
H.li $ H.a ! A.href (H.stringValue (name ++ ".html")) $ H.toHtml name
|
||||
moduleLink :: SymPath -> H.Html
|
||||
moduleLink p@(SymPath _ name) =
|
||||
H.a ! A.href (H.stringValue (show p ++ ".html")) $ H.toHtml name
|
||||
|
||||
binderToHtml :: Binder -> H.Html
|
||||
binderToHtml (Binder meta xobj) =
|
||||
binderToHtml :: String -> Binder -> H.Html
|
||||
binderToHtml moduleName (Binder meta xobj) =
|
||||
let name = getSimpleName xobj
|
||||
maybeNameAndArgs = getSimpleNameWithArgs xobj
|
||||
description = getBinderDescription xobj
|
||||
@ -169,7 +202,9 @@ binderToHtml (Binder meta xobj) =
|
||||
H.a ! A.class_ "anchor" ! A.href (H.stringValue ("#" ++ name)) $
|
||||
H.h3 ! A.id (H.stringValue name) $
|
||||
do
|
||||
H.toHtml name
|
||||
if isMod xobj
|
||||
then H.a ! A.href (H.stringValue (moduleName ++ "." ++ pretty xobj ++ ".html")) $ H.toHtml (pretty xobj)
|
||||
else H.toHtml name
|
||||
when isDeprecated $
|
||||
H.span ! A.class_ "deprecation-notice" $
|
||||
H.toHtml ("deprecated" :: String)
|
||||
|
@ -125,7 +125,8 @@ functionModule =
|
||||
where
|
||||
bindEnv env =
|
||||
let Just name = envModuleName env
|
||||
in (name, Binder emptyMeta (XObj (Mod env E.empty) Nothing Nothing))
|
||||
meta = Meta.set "hidden" trueXObj emptyMeta
|
||||
in (name, Binder meta (XObj (Mod env E.empty) Nothing Nothing))
|
||||
bindings = Map.fromList (map (bindEnv . generateInnerFunctionModule) [0 .. maxArity])
|
||||
|
||||
-- | Each arity of functions need their own module to enable copying and string representation
|
||||
|
Loading…
Reference in New Issue
Block a user