diff --git a/core/Statistics.carp b/core/Statistics.carp index 47e61138..21c3f090 100644 --- a/core/Statistics.carp +++ b/core/Statistics.carp @@ -17,6 +17,7 @@ quartiles (Array Double), iqr Double ]) + (hidden Summary) (doc mean "Compute the mean of the samples data.") (defn mean [data] diff --git a/core/Test.carp b/core/Test.carp index cbb55f43..88582737 100644 --- a/core/Test.carp +++ b/core/Test.carp @@ -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] diff --git a/docs/core/carp_style.css b/docs/core/carp_style.css index 40694dde..0ed34680 100644 --- a/docs/core/carp_style.css +++ b/docs/core/carp_style.css @@ -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; } diff --git a/docs/sdl/carp_style.css b/docs/sdl/carp_style.css index 8d75849b..0ed34680 100644 --- a/docs/sdl/carp_style.css +++ b/docs/sdl/carp_style.css @@ -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 { diff --git a/src/Obj.hs b/src/Obj.hs index 1491530b..0edb9e44 100644 --- a/src/Obj.hs +++ b/src/Obj.hs @@ -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 diff --git a/src/RenderDocs.hs b/src/RenderDocs.hs index 640fcd3a..56cee97c 100644 --- a/src/RenderDocs.hs +++ b/src/RenderDocs.hs @@ -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) diff --git a/src/StartingEnv.hs b/src/StartingEnv.hs index 6aa41b21..3d6a15f0 100644 --- a/src/StartingEnv.hs +++ b/src/StartingEnv.hs @@ -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