Verified Commit 853c70f5 authored by Camil Staps's avatar Camil Staps 🚀

Add basic search functionality

parent 22b422b4
Pipeline #14540 failed with stage
in 54 seconds
[submodule "data/cleandoc-default/modules/clean-highlighter"]
path = data/cleandoc-default/modules/clean-highlighter
url = git@github.com:clean-cloogle/clean-highlighter
url = https://github.com/clean-cloogle/clean-highlighter
[submodule "data/cleandoc-default/modules/lunr.js"]
path = data/cleandoc-default/modules/lunr.js
url = https://github.com/olivernn/lunr.js
......@@ -27,17 +27,34 @@ body, html {
width: 15%;
}
#sidebar > div {
box-sizing: border-box;
padding: 1em;
}
#toc {
height: 70%;
outline: 1px solid black;
overflow: auto;
}
#toc h1 {
margin: 0;
}
#toc ul {
padding-left: 1.5em;
}
#search {
height: 30%;
overflow: auto;
}
#search-results ul {
padding-left: 1.5em;
}
#content {
left: 20%;
padding: 0 1em;
......
var lunr_items;
var lunr_index;
function build_lunr(items) {
lunr_items = items;
lunr_index = lunr(function(){
this.field('name');
this.field('description');
for (var i in items) {
items[i].id = i;
this.add(items[i]);
}
});
}
function make_relative_url(url) {
var current_path = this_relative_url.split('/').reverse();
var new_url = '';
for (var i = 0; i < current_path.length-1; i++)
new_url += '../';
new_url += url;
return new_url;
}
(function(){
/* Highlight Clean code */
let codes = document.getElementsByClassName('clean-code');
......@@ -32,4 +56,31 @@
head.onclick();
}
}
/* search field */
let searchfield = document.getElementById('search-field');
let searchresults = document.getElementById('search-results').querySelector('ul');
searchfield.oninput = function () {
searchresults.innerHTML = '';
if (this.value == '')
return;
var results = lunr_index.search(this.value);
if (results.length == 0) {
searchresults.innerHTML = '<em>no results</em>';
return;
}
for (let i in results) {
let elem = lunr_items[results[i].ref];
let li = document.createElement('li');
let a = document.createElement('a');
a.href = make_relative_url('mod/' + elem.module + '.html#' + elem.htmlid);
a.innerHTML = '<code>' + elem.name + '</code> in <code>' + elem.module + '</code>';
li.appendChild(a);
searchresults.appendChild(li);
}
};
})();
Subproject commit 3a003702ac1b561e5635ea5de1670f908f5410a7
......@@ -2,7 +2,8 @@ definition module Clean.Doc.ModuleCollection
from StdOverloaded import class <
from Clean.Doc import :: ClassDoc, :: FunctionDoc, :: ModuleDoc, :: TypeDoc
from Clean.Doc import :: ClassDoc, :: FunctionDoc, :: ModuleDoc, :: TypeDoc,
class docDescription
from Clean.ModuleFinder import :: ModuleFindingOptions
from Data.Error import :: MaybeError
from Data.Maybe import :: Maybe
......@@ -26,11 +27,16 @@ instance < (Described e d)
, mod_functions :: ![DescribedFunction]
}
:: DescribedTypeDef :== Described () TypeDoc
:: DescribedTypeDef :== Described TypeDefDescription TypeDoc
:: TypeDefDescription = TypeDefDescription
:: DescribedClass :== Described [DescribedFunction] ClassDoc
:: DescribedClass :== Described ClassDescription ClassDoc
:: ClassDescription =
{ class_members :: ![DescribedFunction]
}
:: DescribedFunction :== Described () FunctionDoc
:: DescribedFunction :== Described FunctionDescription FunctionDoc
:: FunctionDescription = FunctionDescription
collectModule :: !ModuleFindingOptions !FilePath !*World
-> *(!MaybeError String DescribedModule, !*World)
......@@ -59,7 +59,7 @@ where
collectTypeDef cc pd=:(PD_Type ptd) =
{ name = ptd.td_ident.id_name
, repr = Just (cpp pd)
, elem = ()
, elem = TypeDefDescription
, doc = case parseDoc <$> getComment pd cc of
Just (Right (doc,_)) -> Just doc
_ -> Nothing
......@@ -69,7 +69,9 @@ where
collectClass cc pd=:(PD_Class cd members) =
{ name = cd.class_ident.id_name
, repr = Just (cpp pd)
, elem = [collectFunction cc m \\ m <- members]
, elem =
{ class_members = [collectFunction cc m \\ m <- members]
}
, doc = case parseDoc <$> getComment pd cc of
Just (Right (doc,_)) -> Just doc
_ -> Nothing
......@@ -79,7 +81,7 @@ where
collectFunction cc pd=:(PD_TypeSpec _ id _ _ _) =
{ name = id.id_name
, repr = Just (cpp pd)
, elem = ()
, elem = FunctionDescription
, doc = case parseDoc <$> getComment pd cc of
Just (Right (doc,_)) -> Just doc
_ -> Nothing
......
......@@ -8,9 +8,9 @@ from Clean.Doc.ModuleCollection import
:: Described, :: DescribedModule,
:: ModuleCollection, :: ModuleDescription
:: HTMLSite
:: WebSite
generateHTML :: !ModuleCollection -> HTMLSite
generateHTML :: !ModuleCollection -> WebSite
/**
* Write a HTML site to disk.
......@@ -21,4 +21,4 @@ generateHTML :: !ModuleCollection -> HTMLSite
* @param The site
* @result A list of errors occurred, in human-readable format
*/
writeHTMLSite :: !FilePath !HTMLSite !*World -> *(![String], !*World)
writeHTMLSite :: !FilePath !WebSite !*World -> *(![String], !*World)
......@@ -19,34 +19,44 @@ import System.Environment
import System.File
import System.FilePath
import Text => qualified join
import Text.GenJSON
import Text.HTML
import Clean.Doc.ModuleCollection
import Clean.Doc.ModuleCollection.Index => qualified :: IndexItem{name}
:: HTMLSite :== [(FilePath, HtmlTag)]
:: WebSite :== [(FilePath, String)]
generateHTML :: !ModuleCollection -> HTMLSite
generateHTML mcoll = map (\(fp,html) -> (fp,finalizeHTML fp html)) $
[ ("index.html", Text "")
: map moduleFile mcoll
]
generateHTML :: !ModuleCollection -> WebSite
generateHTML mcoll =
[("js/lunr-index.js", "build_lunr(" +++ (toString $ toJSON $ indexModuleCollection mcoll) +++ ");")] ++
map (\(fp,html) -> (fp,finalizeHTML fp html))
[ ("index.html", Text "")
: map moduleFile mcoll
]
where
finalizeHTML :: FilePath HtmlTag -> HtmlTag
finalizeHTML fp html = HtmlTag [LangAttr "en"]
finalizeHTML :: FilePath HtmlTag -> String
finalizeHTML fp html = (+++) "<!DOCTYPE html>" $ toString $ 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 [] [Text ("var this_relative_url = '" +++ fp +++ "'")]
, ScriptTag [DeferAttr "defer", SrcAttr (relativePath "modules/clean-highlighter/clean.js")] []
, ScriptTag [DeferAttr "defer", SrcAttr (relativePath "js/cleandoc.js")] []
, ScriptTag [DeferAttr "defer", SrcAttr (relativePath "modules/lunr.js/lunr.js")] []
, ScriptTag [DeferAttr "defer", SrcAttr (relativePath "js/lunr-index.js")] []
]
, BodyTag []
[ DivTag [IdAttr "container"]
[ DivTag [IdAttr "content"] [html]
, DivTag [IdAttr "sidebar"]
[ DivTag [IdAttr "toc"] [H1Tag [] [Text "Documentation"], UlTag [] (map sidebarLink (sort mcoll))]
, DivTag [IdAttr "search"] [Text "(search functionality not implemented yet)"]
, DivTag [IdAttr "search"]
[ InputTag [IdAttr "search-field", TypeAttr "text", PlaceholderAttr "search"]
, DivTag [IdAttr "search-results"] [UlTag [] []]
]
]
]
]
......@@ -67,7 +77,7 @@ where
moduleFile m = ("mod" </> m.name +++ ".html", html)
where
html = DivTag [] $ catMaybes
[ Just $ H1Tag [IdAttr "mod_name"] [Text m.name]
[ Just $ H1Tag [IdAttr ("mod-" +++ m.name)] [Text m.name]
, DivTag [IdAttr "mod_description"] <$> pure <$> Text <$> (docDescription =<< m.doc)
, Just $ DivTag [IdAttr "type_defs"] typedefs
, Just $ DivTag [IdAttr "classes"] classes
......@@ -119,7 +129,7 @@ where
, DivTag [ClassAttr "collapsable-body"] [html body]
]
writeHTMLSite :: !FilePath !HTMLSite !*World -> *(![String], !*World)
writeHTMLSite :: !FilePath !WebSite !*World -> *(![String], !*World)
writeHTMLSite root site w
# (assets,w) = findAssetsDirectory w
| isError assets = ([fromError assets], w)
......@@ -128,6 +138,7 @@ writeHTMLSite root site w
# (errs,w) = syncDirectory
(\fp fi
| endsWith "node_modules" fp -> False
| indexOf "lunr.js" fp >= 0 && not (endsWith "lunr.js" fp) -> False
| fi.directory -> True
| endsWith ".js" fp -> True
| endsWith ".css" fp -> True
......@@ -136,12 +147,12 @@ writeHTMLSite root site w
# (errs2,w) = mapSt (uncurry handle) site w
= (errs ++ flatten errs2,w)
where
handle :: !FilePath !HtmlTag !*World -> *(![String], !*World)
handle :: !FilePath !String !*World -> *(![String], !*World)
handle fp contents w
# fp = root </> fp
# (err,w) = ensureDirectoryExists (takeDirectory fp) w
| isError err = ([snd (fromError err)], w)
# (err,w) = writeFile fp ("<!DOCTYPE html>" <+ contents) w
# (err,w) = writeFile fp contents w
| isError err = ([toString (fromError err)], w)
= ([], w)
......
definition module Clean.Doc.ModuleCollection.Index
from Clean.Doc import class docDescription
from Data.Maybe import :: Maybe
from Text.GenJSON import :: JSONNode, generic JSONEncode
from Clean.Doc.ModuleCollection import :: Described, :: ModuleDescription,
:: ModuleDoc, :: DescribedModule, :: ModuleCollection
:: IndexItem =
{ modul :: String
, name :: String
, kind :: IndexItemKind
, description :: Maybe String
}
:: IndexItemKind
= IIK_Module
| IIK_TypeDef
| IIK_Class
| IIK_Function
derive JSONEncode IndexItem
indexModuleCollection :: ModuleCollection -> [IndexItem]
implementation module Clean.Doc.ModuleCollection.Index
import StdMisc
import StdString
import Clean.Doc
import Control.Monad
from Data.Func import $, instance Functor ((->) a)
import Data.Functor
import Data.List
import Data.Maybe
import Data.Tuple
import Text.GenJSON
import Clean.Doc.ModuleCollection
JSONEncode{|IndexItemKind|} _ iik = [JSONString case iik of
IIK_Module -> "module"
IIK_TypeDef -> "typedef"
IIK_Class -> "class"
IIK_Function -> "function"]
JSONEncode{|IndexItem|} _ ii = [JSONObject $ catMaybes
[ Just ("module", JSONString ii.modul)
, Just ("name", JSONString ii.IndexItem.name)
, Just ("htmlid", JSONString (kind +++ "-" +++ ii.IndexItem.name))
, tuple "description" <$> JSONString <$> ii.IndexItem.description
]]
where
kind = case ii.kind of
IIK_Module -> "mod"
IIK_TypeDef -> "td"
IIK_Class -> "class"
IIK_Function -> "fun"
class kind a :: a -> IndexItemKind
instance kind ModuleDescription where kind _ = IIK_Module
instance kind TypeDefDescription where kind _ = IIK_TypeDef
instance kind ClassDescription where kind _ = IIK_Class
instance kind FunctionDescription where kind _ = IIK_Function
indexModuleCollection :: ModuleCollection -> [IndexItem]
indexModuleCollection mcoll = concatMap indexModule mcoll
indexModule :: DescribedModule -> [IndexItem]
indexModule mod =
[ { modul = mod.Described.name
, name = mod.Described.name
, kind = IIK_Module
, description = docDescription =<< mod.doc
}
: map indexTypeDef mod.elem.mod_type_defs ++
map indexClass mod.elem.mod_classes ++
map indexFunction mod.elem.mod_functions
]
where
//index :: (Described e d) -> IndexItem
index d =
{ modul = mod.Described.name
, name = d.Described.name
, kind = undef
, description = docDescription =<< d.doc
}
indexTypeDef dtd = {index dtd & kind=IIK_TypeDef}
indexClass dc = {index dc & kind=IIK_Class}
indexFunction df = {index df & kind=IIK_Function}
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