We planned to upgrade GitLab and Mattermost to the latest version this Friday morning (early). You may experience some downtime!

Verified Commit 00d1cc7d authored by Camil Staps's avatar Camil Staps 🚀

Add CSS/JS assets; pretty-printed type definitions; basic HTML framework

parent 0efd1451
Pipeline #14404 passed with stage
in 59 seconds
[submodule "data/cleandoc-default/modules/clean-highlighter"]
path = data/cleandoc-default/modules/clean-highlighter
url = git@github.com:clean-cloogle/clean-highlighter
body, html {
margin: 0;
padding: 0;
}
#container {
position: relative;
}
#container > div {
display: inline-block;
vertical-align: top;
}
#sidebar {
min-width: 200px;
overflow: auto;
resize: horizontal;
width: 15%;
}
#content {
left: 20%;
position: absolute;
right: 0;
top: 0;
}
(function(){
/* Highlight Clean code */
var codes = document.getElementsByClassName('clean-code');
for (var i = 0; i < codes.length; i++) {
codes[i].innerHTML = highlightClean(codes[i].innerHTML);
}
/* Resizable sidebar */
var sidebar = document.getElementById('sidebar');
sidebar.onmouseup = function () { /* not every browser supports onresize on div */
console.log(this);
var content = document.getElementById('content');
content.style.left = this.offsetWidth + 'px';
};
sidebar.onmouseup();
})();
Subproject commit f2282f689b4654f68beaf078f8a3badaf1830ee0
......@@ -10,6 +10,7 @@ from System.FilePath import :: FilePath
:: Described element doc =
{ name :: !String
, repr :: !Maybe String
, elem :: !element
, doc :: !Maybe doc
}
......
......@@ -7,6 +7,7 @@ import Clean.Doc
import Clean.ModuleFinder
import Clean.Parse
import Clean.Parse.Comments
from Clean.PrettyPrint import class cpp(cpp), instance cpp ParsedDefinition
import Control.Monad
import Data.Either
import Data.Error
......@@ -36,6 +37,7 @@ collectModule mfo fp w
_ -> Nothing
# moddesc =
{ name = mod.mod_ident.id_name
, repr = Nothing
, elem =
{ mod_type_defs = [collectTypeDef documentation pd \\ pd=:(PD_Type _) <- dcldefs]
}
......@@ -46,6 +48,7 @@ where
collectTypeDef :: !CollectedComments !ParsedDefinition -> DescribedTypeDef
collectTypeDef cc pd=:(PD_Type ptd) =
{ name = ptd.td_ident.id_name
, repr = Just (cpp pd)
, elem = ()
, doc = case parseDoc <$> getComment pd cc of
Just (Right (doc,_)) -> Just doc
......
implementation module Clean.Doc.ModuleCollection.HTML
import StdArray
import StdBool
import StdFile
import StdList
import StdTuple
......@@ -12,8 +14,10 @@ from Data.Func import $, mapSt, instance Functor ((->) a)
import Data.Functor
import Data.List
import System.Directory
import System.Environment
import System.File
import System.FilePath
import Text => qualified join
import Text.HTML
import Clean.Doc.ModuleCollection
......@@ -21,8 +25,34 @@ import Clean.Doc.ModuleCollection
:: HTMLSite :== [(FilePath, HtmlTag)]
generateHTML :: !ModuleCollection -> HTMLSite
generateHTML mcoll = map moduleFile mcoll
generateHTML mcoll = map (\(fp,html) -> (fp,finalizeHTML fp html)) $
map moduleFile mcoll
where
finalizeHTML :: FilePath HtmlTag -> HtmlTag
finalizeHTML fp html = HtmlTag [LangAttr "en"]
[ HeadTag []
[ TitleTag [] [Text "Documentation"]
, MetaTag [CharsetAttr "utf-8"] []
, LinkTag [RelAttr "stylesheet", TypeAttr "text/css", HrefAttr (relativePath "modules/clean-highlighter/clean.css")] []
, LinkTag [RelAttr "stylesheet", TypeAttr "text/css", HrefAttr (relativePath "css/style.css")] []
, ScriptTag [DeferAttr "defer", TypeAttr "text/javascript", SrcAttr (relativePath "modules/clean-highlighter/clean.js")] []
, ScriptTag [DeferAttr "defer", TypeAttr "text/javascript", SrcAttr (relativePath "js/cleandoc.js")] []
]
, BodyTag []
[ DivTag [IdAttr "container"]
[ DivTag [IdAttr "sidebar"] [Text "sidebar"]
, DivTag [IdAttr "content"] [html]
]
]
]
where
relativePath :: FilePath -> FilePath
relativePath to = concat (repeatn (dirLength fp-1) {'.','.',pathSeparator}) +++ to
dirLength :: FilePath -> Int
dirLength "" = 0
dirLength fp = 1 + dirLength (takeDirectory fp)
moduleFile :: !(Described ModuleDescription ModuleDoc) -> (FilePath, HtmlTag)
moduleFile m = ("mod" </> m.name +++ ".html", html)
where
......@@ -43,6 +73,7 @@ where
html dtd = DivTag [IdAttr ("td-" +++ dtd.name)] $ catMaybes
[ Just $ H2Tag [] [Text dtd.name]
, DivTag [] <$> pure <$> Text <$> (docDescription =<< dtd.doc)
, Just $ PreTag [ClassAttr "clean-code"] [Text (fromJust dtd.repr)]
]
classes = []
......@@ -53,9 +84,18 @@ where
writeHTMLSite :: !FilePath !HTMLSite !*World -> *(![String], !*World)
writeHTMLSite root site w
# (assets,w) = findAssetsDirectory w
| isError assets = ([fromError assets], w)
# assets = fromOk assets
# (_,w) = recursiveDelete root w
# (errs,w) = mapSt (uncurry handle) site w
= (flatten errs,w)
# (errs,w) = syncDirectory
(\fp fi ->
fi.directory ||
endsWith ".js" fp ||
endsWith ".css" fp)
assets root w
# (errs2,w) = mapSt (uncurry handle) site w
= (errs ++ flatten errs2,w)
where
handle :: !FilePath !HtmlTag !*World -> *(![String], !*World)
handle fp contents w
......@@ -65,3 +105,45 @@ where
# (err,w) = writeFile fp (toString contents) w
| isError err = ([toString (fromError err)], w)
= ([], w)
findAssetsDirectory :: !*World -> *(!MaybeError String FilePath, !*World)
findAssetsDirectory w
# (home,w) = getEnvironmentVariable "CLEAN_HOME" w
# homepath = fromJust home </> "data" </> "cleandoc-default"
# (exi,w) = fileExists homepath w
| isJust home && exi = (Ok homepath, w)
# (cur,w) = getCurrentDirectory w
| isError cur = (Error (snd (fromError cur)), w)
= findHigher (fromOk cur) w
where
findHigher :: !FilePath !*World -> *(!MaybeError String FilePath, !*World)
findHigher "" w = (Error "cleandoc assets could not be found", w)
findHigher dir w
# path = dir </> "data" </> "cleandoc-default"
# (exi,w) = fileExists path w
| exi = (Ok path, w)
= findHigher (takeDirectory dir) w
syncDirectory :: !(FilePath FileInfo -> Bool) !FilePath !FilePath !*World -> *(![String], !*World)
syncDirectory include fr to w
# (err,w) = ensureDirectoryExists to w
| isError err = ([snd (fromError err)], w)
# (fps,w) = readDirectory fr w
| isError fps = ([snd (fromError fps)], w)
# fps = [fp \\ fp <- fromOk fps | fp <> "." && fp <> ".."]
# (errs,w) = mapSt copy fps w
= (flatten errs, w)
where
copy :: !FilePath !*World -> *(![String], !*World)
copy fp w
# fp = fr </> fp
# (fi,w) = getFileInfo fp w
| isError fi = ([snd (fromError fi)], w)
# fi = fromOk fi
| not (include fp fi) = ([], w)
| fi.directory = syncDirectory include fp (to </> dropDirectory fp) w
# (contents,w) = readFile fp w
| isError contents = ([toString (fromError contents)], w)
# (ok,w) = writeFile (to </> dropDirectory fp) (fromOk contents) w
| isError ok = ([toString (fromError ok)], w)
= ([], w)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment