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

Verified Commit 0efd1451 authored by Camil Staps's avatar Camil Staps 🚀

Start with type definitions

parent f3b51448
Pipeline #14386 failed with stage
in 50 seconds
definition module Clean.Doc.ModuleCollection
from Clean.Doc import :: ModuleDoc, :: TypeDoc
from Clean.ModuleFinder import :: ModuleFindingOptions
from Data.Error import :: MaybeError
from Data.Maybe import :: Maybe
from System.FilePath import :: FilePath
:: ModuleCollection :== [ModuleDescription]
:: ModuleCollection :== [DescribedModule]
:: Described element doc =
{ name :: !String
, elem :: !element
, doc :: !Maybe doc
}
:: DescribedModule :== Described ModuleDescription ModuleDoc
:: ModuleDescription =
{ mod_name :: !String
, mod_description :: !Maybe String
{ mod_type_defs :: ![DescribedTypeDef]
}
:: DescribedTypeDef :== Described () TypeDoc
collectModule :: !ModuleFindingOptions !FilePath !*World
-> *(!MaybeError String ModuleDescription, !*World)
-> *(!MaybeError String DescribedModule, !*World)
......@@ -15,10 +15,14 @@ import Data.Maybe
from syntax import
:: Ident{id_name},
:: Module{mod_defs,mod_ident}
:: Module{mod_defs,mod_ident},
:: ParsedDefinition(PD_Type),
:: ParsedTypeDef,
:: RhsDefsOfType,
:: TypeDef{td_ident}
collectModule :: !ModuleFindingOptions !FilePath !*World
-> *(!MaybeError String ModuleDescription, !*World)
-> *(!MaybeError String DescribedModule, !*World)
collectModule mfo fp w
# (comments,w) = scanComments fp w
# (dcl,w) = readModule fp w
......@@ -27,14 +31,23 @@ collectModule mfo fp w
# (mod,dcldefs,documentation) = (dcl, dcl.mod_defs, case comments of
Error _ -> emptyCollectedComments
Ok comments -> collectComments comments dcl)
# moddoc = moddoc
with
moddoc :: Maybe ModuleDoc
moddoc = case parseDoc <$> getComment mod documentation of
Just (Right (doc,_)) -> Just doc
_ -> Nothing
# moddoc = case parseDoc <$> getComment mod documentation of
Just (Right (doc,_)) -> Just doc
_ -> Nothing
# moddesc =
{ mod_name = mod.mod_ident.id_name
, mod_description = docDescription =<< moddoc
{ name = mod.mod_ident.id_name
, elem =
{ mod_type_defs = [collectTypeDef documentation pd \\ pd=:(PD_Type _) <- dcldefs]
}
, doc = moddoc
}
= (Ok moddesc, w)
where
collectTypeDef :: !CollectedComments !ParsedDefinition -> DescribedTypeDef
collectTypeDef cc pd=:(PD_Type ptd) =
{ name = ptd.td_ident.id_name
, elem = ()
, doc = case parseDoc <$> getComment pd cc of
Just (Right (doc,_)) -> Just doc
_ -> Nothing
}
definition module Clean.Doc.ModuleCollection.HTML
from Clean.Doc import :: ModuleDoc, :: TypeDoc
from System.FilePath import :: FilePath
from Text.HTML import :: HtmlTag
from Clean.Doc.ModuleCollection import :: ModuleCollection, :: ModuleDescription
from Clean.Doc.ModuleCollection import
:: Described, :: DescribedModule,
:: ModuleCollection, :: ModuleDescription
:: HTMLSite
......
......@@ -4,7 +4,9 @@ import StdFile
import StdList
import StdTuple
import Clean.Doc => qualified :: ParamDoc{name}
import Control.Applicative
import Control.Monad
import Data.Error
from Data.Func import $, mapSt, instance Functor ((->) a)
import Data.Functor
......@@ -21,14 +23,34 @@ import Clean.Doc.ModuleCollection
generateHTML :: !ModuleCollection -> HTMLSite
generateHTML mcoll = map moduleFile mcoll
where
moduleFile :: !ModuleDescription -> (FilePath, HtmlTag)
moduleFile m = ("mod" </> m.mod_name +++ ".html", html)
moduleFile :: !(Described ModuleDescription ModuleDoc) -> (FilePath, HtmlTag)
moduleFile m = ("mod" </> m.name +++ ".html", html)
where
html = DivTag [] $ catMaybes
[ Just $ H1Tag [] [Text m.mod_name]
, DivTag [] <$> pure <$> Text <$> m.mod_description
[ Just $ H1Tag [IdAttr "mod_name"] [Text m.name]
, DivTag [IdAttr "mod_description"] <$> pure <$> Text <$> (docDescription =<< m.doc)
, Just $ DivTag [IdAttr "type_defs"] typedefs
, Just $ DivTag [IdAttr "classes"] classes
, Just $ DivTag [IdAttr "macros"] macros
, Just $ DivTag [IdAttr "functions"] functions
]
typedefs =
[ H1Tag [] [Text "Type definitions"]
: map html m.elem.mod_type_defs
]
where
html dtd = DivTag [IdAttr ("td-" +++ dtd.name)] $ catMaybes
[ Just $ H2Tag [] [Text dtd.name]
, DivTag [] <$> pure <$> Text <$> (docDescription =<< dtd.doc)
]
classes = []
macros = []
functions = []
writeHTMLSite :: !FilePath !HTMLSite !*World -> *(![String], !*World)
writeHTMLSite root site w
# (_,w) = recursiveDelete root 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