module Futhark.Doc.Generator (renderFiles) where
import CMarkGFM qualified as GFM
import Control.Arrow ((***))
import Control.Monad
import Control.Monad.Reader
import Control.Monad.Writer (Writer, WriterT, runWriter, runWriterT, tell)
import Data.Bifunctor (second)
import Data.Char (isAlpha, isSpace, toUpper)
import Data.List (find, groupBy, inits, intersperse, isPrefixOf, partition, sort, sortOn, tails)
import Data.Map qualified as M
import Data.Maybe
import Data.Ord
import Data.Set qualified as S
import Data.String (fromString)
import Data.Text qualified as T
import Data.Version
import Futhark.Util.Pretty (Doc, docText, pretty)
import Futhark.Version
import Language.Futhark
import Language.Futhark.Semantic
import Language.Futhark.TypeChecker.Monad hiding (warn)
import System.FilePath (makeRelative, splitPath, (-<.>), (</>))
import Text.Blaze.Html5 (AttributeValue, Html, toHtml, (!))
import Text.Blaze.Html5 qualified as H
import Text.Blaze.Html5.Attributes qualified as A
import Prelude hiding (abs)
docToHtml :: Doc a -> Html
docToHtml :: forall a. Doc a -> Html
docToHtml = forall a. ToMarkup a => a -> Html
toHtml forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Doc a -> Text
docText
primTypeHtml :: PrimType -> Html
primTypeHtml :: PrimType -> Html
primTypeHtml = forall a. Doc a -> Html
docToHtml forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty
prettyU :: Uniqueness -> Html
prettyU :: Uniqueness -> Html
prettyU = forall a. Doc a -> Html
docToHtml forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty
renderName :: Name -> Html
renderName :: Name -> Html
renderName Name
name = forall a. Doc a -> Html
docToHtml (forall a ann. Pretty a => a -> Doc ann
pretty Name
name)
joinBy :: Html -> [Html] -> Html
joinBy :: Html -> [Html] -> Html
joinBy Html
_ [] = forall a. Monoid a => a
mempty
joinBy Html
_ [Html
x] = Html
x
joinBy Html
sep (Html
x : [Html]
xs) = Html
x forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Html
sep <>) [Html]
xs
commas :: [Html] -> Html
commas :: [Html] -> Html
commas = Html -> [Html] -> Html
joinBy Html
", "
parens :: Html -> Html
parens :: Html -> Html
parens Html
x = Html
"(" forall a. Semigroup a => a -> a -> a
<> Html
x forall a. Semigroup a => a -> a -> a
<> Html
")"
braces :: Html -> Html
braces :: Html -> Html
braces Html
x = Html
"{" forall a. Semigroup a => a -> a -> a
<> Html
x forall a. Semigroup a => a -> a -> a
<> Html
"}"
brackets :: Html -> Html
brackets :: Html -> Html
brackets Html
x = Html
"[" forall a. Semigroup a => a -> a -> a
<> Html
x forall a. Semigroup a => a -> a -> a
<> Html
"]"
pipes :: [Html] -> Html
pipes :: [Html] -> Html
pipes = Html -> [Html] -> Html
joinBy Html
" | "
type NoLink = S.Set VName
data Context = Context
{ Context -> [Char]
ctxCurrent :: String,
Context -> FileModule
ctxFileMod :: FileModule,
Context -> Imports
ctxImports :: Imports,
Context -> NoLink
ctxNoLink :: NoLink,
Context -> FileMap
ctxFileMap :: FileMap,
Context -> NoLink
ctxVisibleMTys :: S.Set VName
}
type FileMap = M.Map VName (FilePath, Namespace)
type DocM = ReaderT Context (WriterT Documented (Writer Warnings))
data IndexWhat = IndexValue | IndexFunction | IndexModule | IndexModuleType | IndexType
type Documented = M.Map VName IndexWhat
warn :: SrcLoc -> Doc () -> DocM ()
warn :: SrcLoc -> Doc () -> DocM ()
warn SrcLoc
loc Doc ()
s = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ SrcLoc -> Doc () -> Warnings
singleWarning SrcLoc
loc Doc ()
s
document :: VName -> IndexWhat -> DocM ()
document :: VName -> IndexWhat -> DocM ()
document VName
v IndexWhat
what = forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
M.singleton VName
v IndexWhat
what
noLink :: [VName] -> DocM a -> DocM a
noLink :: forall a. [VName] -> DocM a -> DocM a
noLink [VName]
names = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local forall a b. (a -> b) -> a -> b
$ \Context
ctx ->
Context
ctx {ctxNoLink :: NoLink
ctxNoLink = forall a. Ord a => [a] -> Set a
S.fromList [VName]
names forall a. Semigroup a => a -> a -> a
<> Context -> NoLink
ctxNoLink Context
ctx}
selfLink :: AttributeValue -> Html -> Html
selfLink :: AttributeValue -> Html -> Html
selfLink AttributeValue
s = Html -> Html
H.a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
s forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (AttributeValue
"#" forall a. Semigroup a => a -> a -> a
<> AttributeValue
s) forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"self_link"
fullRow :: Html -> Html
fullRow :: Html -> Html
fullRow = Html -> Html
H.tr forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Html -> Html
H.td forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.colspan AttributeValue
"3")
emptyRow :: Html
emptyRow :: Html
emptyRow = Html -> Html
H.tr forall a b. (a -> b) -> a -> b
$ Html -> Html
H.td forall a. Monoid a => a
mempty forall a. Semigroup a => a -> a -> a
<> Html -> Html
H.td forall a. Monoid a => a
mempty forall a. Semigroup a => a -> a -> a
<> Html -> Html
H.td forall a. Monoid a => a
mempty
specRow :: Html -> Html -> Html -> Html
specRow :: Html -> Html -> Html -> Html
specRow Html
a Html
b Html
c =
Html -> Html
H.tr forall a b. (a -> b) -> a -> b
$
(Html -> Html
H.td forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"spec_lhs") Html
a
forall a. Semigroup a => a -> a -> a
<> (Html -> Html
H.td forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"spec_eql") Html
b
forall a. Semigroup a => a -> a -> a
<> (Html -> Html
H.td forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"spec_rhs") Html
c
vnameToFileMap :: Imports -> FileMap
vnameToFileMap :: Imports -> FileMap
vnameToFileMap = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (ImportName, FileModule) -> FileMap
forFile
where
forFile :: (ImportName, FileModule) -> FileMap
forFile (ImportName
file, FileModule TySet
abs Env
file_env Prog
_prog Env
_) =
forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (forall {b} {k}. b -> QualName k -> Map k ([Char], b)
vname Namespace
Type) (forall k a. Map k a -> [k]
M.keys TySet
abs))
forall a. Semigroup a => a -> a -> a
<> Env -> FileMap
forEnv Env
file_env
where
file' :: [Char]
file' = [Char] -> [Char] -> [Char]
makeRelative [Char]
"/" forall a b. (a -> b) -> a -> b
$ ImportName -> [Char]
includeToFilePath ImportName
file
vname :: b -> QualName k -> Map k ([Char], b)
vname b
ns QualName k
v = forall k a. k -> a -> Map k a
M.singleton (forall vn. QualName vn -> vn
qualLeaf QualName k
v) ([Char]
file', b
ns)
vname' :: ((b, b), QualName k) -> Map k ([Char], b)
vname' ((b
ns, b
_), QualName k
v) = forall {b} {k}. b -> QualName k -> Map k ([Char], b)
vname b
ns QualName k
v
forEnv :: Env -> FileMap
forEnv Env
env =
forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map forall {b} {b} {k}. ((b, b), QualName k) -> Map k ([Char], b)
vname' forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList forall a b. (a -> b) -> a -> b
$ Env -> NameMap
envNameMap Env
env)
forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map MTy -> FileMap
forMty forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
M.elems forall a b. (a -> b) -> a -> b
$ Env -> Map VName MTy
envSigTable Env
env)
forMod :: Mod -> FileMap
forMod (ModEnv Env
env) = Env -> FileMap
forEnv Env
env
forMod ModFun {} = forall a. Monoid a => a
mempty
forMty :: MTy -> FileMap
forMty = Mod -> FileMap
forMod forall b c a. (b -> c) -> (a -> b) -> a -> c
. MTy -> Mod
mtyMod
renderFiles :: [ImportName] -> Imports -> ([(FilePath, Html)], Warnings)
renderFiles :: [ImportName] -> Imports -> ([([Char], Html)], Warnings)
renderFiles [ImportName]
important_imports Imports
imports = forall w a. Writer w a -> (a, w)
runWriter forall a b. (a -> b) -> a -> b
$ do
([(ImportName, (Html, Html))]
import_pages, Documented
documented) <- forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Imports
imports forall a b. (a -> b) -> a -> b
$ \(ImportName
current, FileModule
fm) ->
let ctx :: Context
ctx =
Context
{ ctxCurrent :: [Char]
ctxCurrent = [Char] -> [Char] -> [Char]
makeRelative [Char]
"/" forall a b. (a -> b) -> a -> b
$ ImportName -> [Char]
includeToFilePath ImportName
current,
ctxFileMod :: FileModule
ctxFileMod = FileModule
fm,
ctxImports :: Imports
ctxImports = Imports
imports,
ctxNoLink :: NoLink
ctxNoLink = forall a. Monoid a => a
mempty,
ctxFileMap :: FileMap
ctxFileMap = FileMap
file_map,
ctxVisibleMTys :: NoLink
ctxVisibleMTys = Prog -> NoLink
progModuleTypes forall a b. (a -> b) -> a -> b
$ FileModule -> Prog
fileProg FileModule
fm
}
in forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Context
ctx forall a b. (a -> b) -> a -> b
$ do
(Html
first_paragraph, Html
maybe_abstract, Html
maybe_sections) <- Prog -> DocM (Html, Html, Html)
headerDoc forall a b. (a -> b) -> a -> b
$ FileModule -> Prog
fileProg FileModule
fm
Html
synopsis <- (Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"module") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Dec]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
synopsisDecs (forall (f :: * -> *) vn. ProgBase f vn -> [DecBase f vn]
progDecs forall a b. (a -> b) -> a -> b
$ FileModule -> Prog
fileProg FileModule
fm)
Html
description <- [Dec]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
describeDecs forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) vn. ProgBase f vn -> [DecBase f vn]
progDecs forall a b. (a -> b) -> a -> b
$ FileModule -> Prog
fileProg FileModule
fm
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( ImportName
current,
( Html -> Html
H.docTypeHtml forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.lang AttributeValue
"en"
forall a b. (a -> b) -> a -> b
$ [ImportName] -> Imports -> [Char] -> [Char] -> Html -> Html
addBoilerplateWithNav
[ImportName]
important_imports
Imports
imports
([Char]
"doc" [Char] -> [Char] -> [Char]
</> ImportName -> [Char]
includeToFilePath ImportName
current)
(ImportName -> [Char]
includeToString ImportName
current)
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.main
forall a b. (a -> b) -> a -> b
$ Html
maybe_abstract
forall a. Semigroup a => a -> a -> a
<> AttributeValue -> Html -> Html
selfLink AttributeValue
"synopsis" (Html -> Html
H.h2 Html
"Synopsis")
forall a. Semigroup a => a -> a -> a
<> (Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"overview") Html
synopsis
forall a. Semigroup a => a -> a -> a
<> AttributeValue -> Html -> Html
selfLink AttributeValue
"description" (Html -> Html
H.h2 Html
"Description")
forall a. Semigroup a => a -> a -> a
<> Html
description
forall a. Semigroup a => a -> a -> a
<> Html
maybe_sections,
Html
first_paragraph
)
)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
[ ([Char]
"index.html", [ImportName] -> [(ImportName, Html)] -> Html
contentsPage [ImportName]
important_imports forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd) [(ImportName, (Html, Html))]
import_pages),
([Char]
"doc-index.html", [ImportName] -> Imports -> Documented -> FileMap -> Html
indexPage [ImportName]
important_imports Imports
imports Documented
documented FileMap
file_map)
]
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (ImportName -> [Char]
importHtml forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a b. (a, b) -> a
fst) [(ImportName, (Html, Html))]
import_pages
where
file_map :: FileMap
file_map = Imports -> FileMap
vnameToFileMap Imports
imports
importHtml :: ImportName -> [Char]
importHtml ImportName
import_name =
[Char]
"doc" [Char] -> [Char] -> [Char]
</> [Char] -> [Char] -> [Char]
makeRelative [Char]
"/" (forall a. IsString a => [Char] -> a
fromString (ImportName -> [Char]
includeToString ImportName
import_name)) [Char] -> [Char] -> [Char]
-<.> [Char]
"html"
headerDoc :: Prog -> DocM (Html, Html, Html)
Prog
prog =
case forall (f :: * -> *) vn. ProgBase f vn -> Maybe DocComment
progDoc Prog
prog of
Just (DocComment Text
doc SrcLoc
loc) -> do
let ([Char]
abstract, [Char]
more_sections) = [Char] -> ([Char], [Char])
splitHeaderDoc forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
doc
Html
first_paragraph <- Maybe DocComment
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
docHtml forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> SrcLoc -> DocComment
DocComment ([Char] -> Text
firstParagraph [Char]
abstract) SrcLoc
loc
Html
abstract' <- Maybe DocComment
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
docHtml forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> SrcLoc -> DocComment
DocComment ([Char] -> Text
T.pack [Char]
abstract) SrcLoc
loc
Html
more_sections' <- Maybe DocComment
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
docHtml forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> SrcLoc -> DocComment
DocComment ([Char] -> Text
T.pack [Char]
more_sections) SrcLoc
loc
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( Html
first_paragraph,
AttributeValue -> Html -> Html
selfLink AttributeValue
"abstract" (Html -> Html
H.h2 Html
"Abstract") forall a. Semigroup a => a -> a -> a
<> Html
abstract',
Html
more_sections'
)
Maybe DocComment
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
where
splitHeaderDoc :: [Char] -> ([Char], [Char])
splitHeaderDoc [Char]
s =
forall a. a -> Maybe a -> a
fromMaybe ([Char]
s, forall a. Monoid a => a
mempty) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (([Char]
"\n##" `isPrefixOf`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. [a] -> [[a]]
inits [Char]
s) (forall a. [a] -> [[a]]
tails [Char]
s)
firstParagraph :: [Char] -> Text
firstParagraph = [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
paragraphSeparator) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines
paragraphSeparator :: [Char] -> Bool
paragraphSeparator = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace
contentsPage :: [ImportName] -> [(ImportName, Html)] -> Html
contentsPage :: [ImportName] -> [(ImportName, Html)] -> Html
contentsPage [ImportName]
important_imports [(ImportName, Html)]
pages =
Html -> Html
H.docTypeHtml forall a b. (a -> b) -> a -> b
$
[Char] -> [Char] -> Html -> Html
addBoilerplate [Char]
"index.html" [Char]
"Futhark Library Documentation" forall a b. (a -> b) -> a -> b
$
Html -> Html
H.main forall a b. (a -> b) -> a -> b
$
( if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ImportName, Html)]
important_pages
then forall a. Monoid a => a
mempty
else Html -> Html
H.h2 Html
"Main libraries" forall a. Semigroup a => a -> a -> a
<> [(ImportName, Html)] -> Html
fileList [(ImportName, Html)]
important_pages
)
forall a. Semigroup a => a -> a -> a
<> ( if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ImportName, Html)]
unimportant_pages
then forall a. Monoid a => a
mempty
else Html -> Html
H.h2 Html
"Supporting libraries" forall a. Semigroup a => a -> a -> a
<> [(ImportName, Html)] -> Html
fileList [(ImportName, Html)]
unimportant_pages
)
where
([(ImportName, Html)]
important_pages, [(ImportName, Html)]
unimportant_pages) =
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ImportName]
important_imports) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(ImportName, Html)]
pages
fileList :: [(ImportName, Html)] -> Html
fileList [(ImportName, Html)]
pages' =
Html -> Html
H.dl forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"file_list" forall a b. (a -> b) -> a -> b
$
forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (ImportName, Html) -> Html
linkTo forall a b. (a -> b) -> a -> b
$
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst [(ImportName, Html)]
pages'
linkTo :: (ImportName, Html) -> Html
linkTo (ImportName
name, Html
maybe_abstract) =
Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"file_desc" forall a b. (a -> b) -> a -> b
$
(Html -> Html
H.dt forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"desc_header") ([Char] -> ImportName -> Html
importLink [Char]
"index.html" ImportName
name)
forall a. Semigroup a => a -> a -> a
<> (Html -> Html
H.dd forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"desc_doc") Html
maybe_abstract
importLink :: FilePath -> ImportName -> Html
importLink :: [Char] -> ImportName -> Html
importLink [Char]
current ImportName
name =
let file :: [Char]
file =
[Char] -> [Char] -> [Char]
relativise
([Char]
"doc" [Char] -> [Char] -> [Char]
</> [Char] -> [Char] -> [Char]
makeRelative [Char]
"/" (ImportName -> [Char]
includeToFilePath ImportName
name) [Char] -> [Char] -> [Char]
-<.> [Char]
"html")
[Char]
current
in (Html -> Html
H.a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (forall a. IsString a => [Char] -> a
fromString [Char]
file) forall a b. (a -> b) -> a -> b
$ forall a. IsString a => [Char] -> a
fromString (ImportName -> [Char]
includeToString ImportName
name))
indexPage :: [ImportName] -> Imports -> Documented -> FileMap -> Html
indexPage :: [ImportName] -> Imports -> Documented -> FileMap -> Html
indexPage [ImportName]
important_imports Imports
imports Documented
documented FileMap
fm =
Html -> Html
H.docTypeHtml forall a b. (a -> b) -> a -> b
$
[ImportName] -> Imports -> [Char] -> [Char] -> Html -> Html
addBoilerplateWithNav [ImportName]
important_imports Imports
imports [Char]
"doc-index.html" [Char]
"Index" forall a b. (a -> b) -> a -> b
$
Html -> Html
H.main forall a b. (a -> b) -> a -> b
$
( Html -> Html
H.ul forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"doc_index_list" forall a b. (a -> b) -> a -> b
$
forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Html
initialListEntry forall a b. (a -> b) -> a -> b
$
[[Char]]
letter_group_links forall a. [a] -> [a] -> [a]
++ [[Char]
symbol_group_link]
)
forall a. Semigroup a => a -> a -> a
<> ( Html -> Html
H.table forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"doc_index" forall a b. (a -> b) -> a -> b
$
Html -> Html
H.thead (Html -> Html
H.tr forall a b. (a -> b) -> a -> b
$ Html -> Html
H.td Html
"Who" forall a. Semigroup a => a -> a -> a
<> Html -> Html
H.td Html
"What" forall a. Semigroup a => a -> a -> a
<> Html -> Html
H.td Html
"Where")
forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat ([Html]
letter_groups forall a. [a] -> [a] -> [a]
++ [Html
symbol_group])
)
where
([(VName, ([Char], IndexWhat))]
letter_names, [(VName, ([Char], IndexWhat))]
sym_names) =
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ([Char] -> Bool
isLetterName forall b c a. (b -> c) -> (a -> b) -> a -> c
. VName -> [Char]
baseString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper forall b c a. (b -> c) -> (a -> b) -> a -> c
. VName -> [Char]
baseString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a} {b}. (VName, (a, b)) -> Maybe (VName, (a, IndexWhat))
isDocumented forall a b. (a -> b) -> a -> b
$
forall k a. Map k a -> [(k, a)]
M.toList FileMap
fm
isDocumented :: (VName, (a, b)) -> Maybe (VName, (a, IndexWhat))
isDocumented (VName
k, (a
file, b
_)) = do
IndexWhat
what <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VName
k Documented
documented
forall a. a -> Maybe a
Just (VName
k, (a
file, IndexWhat
what))
([Html]
letter_groups, [[Char]]
letter_group_links) =
forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [(VName, ([Char], IndexWhat))] -> (Html, [Char])
tbodyForNames forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy forall {b} {b}. (VName, b) -> (VName, b) -> Bool
sameInitial [(VName, ([Char], IndexWhat))]
letter_names
(Html
symbol_group, [Char]
symbol_group_link) =
[Char] -> [(VName, ([Char], IndexWhat))] -> (Html, [Char])
tbodyForInitial [Char]
"Symbols" [(VName, ([Char], IndexWhat))]
sym_names
isLetterName :: [Char] -> Bool
isLetterName [] = Bool
False
isLetterName (Char
c : [Char]
_) = Char -> Bool
isAlpha Char
c
sameInitial :: (VName, b) -> (VName, b) -> Bool
sameInitial (VName
x, b
_) (VName
y, b
_) =
case (VName -> [Char]
baseString VName
x, VName -> [Char]
baseString VName
y) of
(Char
x' : [Char]
_, Char
y' : [Char]
_) -> Char -> Char
toUpper Char
x' forall a. Eq a => a -> a -> Bool
== Char -> Char
toUpper Char
y'
([Char], [Char])
_ -> Bool
False
tbodyForNames :: [(VName, ([Char], IndexWhat))] -> (Html, [Char])
tbodyForNames names :: [(VName, ([Char], IndexWhat))]
names@((VName
s, ([Char], IndexWhat)
_) : [(VName, ([Char], IndexWhat))]
_) =
[Char] -> [(VName, ([Char], IndexWhat))] -> (Html, [Char])
tbodyForInitial (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
1 forall a b. (a -> b) -> a -> b
$ VName -> [Char]
baseString VName
s) [(VName, ([Char], IndexWhat))]
names
tbodyForNames [(VName, ([Char], IndexWhat))]
_ = forall a. Monoid a => a
mempty
tbodyForInitial :: [Char] -> [(VName, ([Char], IndexWhat))] -> (Html, [Char])
tbodyForInitial [Char]
initial [(VName, ([Char], IndexWhat))]
names =
( Html -> Html
H.tbody forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ Html
initial' forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (VName, ([Char], IndexWhat)) -> Html
linkTo [(VName, ([Char], IndexWhat))]
names,
[Char]
initial
)
where
initial' :: Html
initial' =
Html -> Html
H.tr
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.td forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.colspan AttributeValue
"2" forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"doc_index_initial"
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.a
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (forall a. IsString a => [Char] -> a
fromString [Char]
initial)
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ Char
'#' forall a. a -> [a] -> [a]
: [Char]
initial)
forall a b. (a -> b) -> a -> b
$ forall a. IsString a => [Char] -> a
fromString [Char]
initial
initialListEntry :: [Char] -> Html
initialListEntry [Char]
initial =
Html -> Html
H.li forall a b. (a -> b) -> a -> b
$ Html -> Html
H.a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ Char
'#' forall a. a -> [a] -> [a]
: [Char]
initial) forall a b. (a -> b) -> a -> b
$ forall a. IsString a => [Char] -> a
fromString [Char]
initial
linkTo :: (VName, ([Char], IndexWhat)) -> Html
linkTo (VName
name, ([Char]
file, IndexWhat
what)) =
let file' :: [Char]
file' = [Char] -> [Char] -> [Char]
makeRelative [Char]
"/" [Char]
file
link :: Html
link =
(Html -> Html
H.a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (forall a. IsString a => [Char] -> a
fromString ([Char] -> [Char] -> [Char]
makeRelative [Char]
"/" forall a b. (a -> b) -> a -> b
$ [Char]
"doc" [Char] -> [Char] -> [Char]
</> VName -> [Char] -> [Char] -> [Char]
vnameLink' VName
name [Char]
"" [Char]
file'))) forall a b. (a -> b) -> a -> b
$
forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$
VName -> [Char]
baseString VName
name
what' :: Html
what' = case IndexWhat
what of
IndexWhat
IndexValue -> Html
"value"
IndexWhat
IndexFunction -> Html
"function"
IndexWhat
IndexType -> Html
"type"
IndexWhat
IndexModuleType -> Html
"module type"
IndexWhat
IndexModule -> Html
"module"
html_file :: [Char]
html_file = [Char]
"doc" [Char] -> [Char] -> [Char]
</> [Char]
file' [Char] -> [Char] -> [Char]
-<.> [Char]
"html"
in Html -> Html
H.tr forall a b. (a -> b) -> a -> b
$
(Html -> Html
H.td forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"doc_index_name" forall a b. (a -> b) -> a -> b
$ Html
link)
forall a. Semigroup a => a -> a -> a
<> (Html -> Html
H.td forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"doc_index_namespace" forall a b. (a -> b) -> a -> b
$ Html
what')
forall a. Semigroup a => a -> a -> a
<> ( Html -> Html
H.td forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"doc_index_file" forall a b. (a -> b) -> a -> b
$
(Html -> Html
H.a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (forall a. IsString a => [Char] -> a
fromString [Char]
html_file) forall a b. (a -> b) -> a -> b
$ forall a. IsString a => [Char] -> a
fromString [Char]
file)
)
addBoilerplate :: String -> String -> Html -> Html
addBoilerplate :: [Char] -> [Char] -> Html -> Html
addBoilerplate [Char]
current [Char]
titleText Html
content =
let headHtml :: Html
headHtml =
Html -> Html
H.head forall a b. (a -> b) -> a -> b
$
Html
H.meta
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.charset AttributeValue
"utf-8"
forall a. Semigroup a => a -> a -> a
<> Html -> Html
H.title (forall a. IsString a => [Char] -> a
fromString [Char]
titleText)
forall a. Semigroup a => a -> a -> a
<> Html
H.link
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
relativise [Char]
"style.css" [Char]
current)
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.rel AttributeValue
"stylesheet"
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.type_ AttributeValue
"text/css"
navigation :: Html
navigation =
Html -> Html
H.ul forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"navigation" forall a b. (a -> b) -> a -> b
$
Html -> Html
H.li (Html -> Html
H.a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
relativise [Char]
"index.html" [Char]
current) forall a b. (a -> b) -> a -> b
$ Html
"Contents")
forall a. Semigroup a => a -> a -> a
<> Html -> Html
H.li (Html -> Html
H.a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
relativise [Char]
"doc-index.html" [Char]
current) forall a b. (a -> b) -> a -> b
$ Html
"Index")
madeByHtml :: Html
madeByHtml =
Html
"Generated by "
forall a. Semigroup a => a -> a -> a
<> (Html -> Html
H.a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href AttributeValue
futhark_doc_url) Html
"futhark-doc"
forall a. Semigroup a => a -> a -> a
<> Html
" "
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (Version -> [Char]
showVersion Version
version)
in Html
headHtml
forall a. Semigroup a => a -> a -> a
<> Html -> Html
H.body
( (Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"header") (Html -> Html
H.h1 (forall a. ToMarkup a => a -> Html
toHtml [Char]
titleText) forall a. Semigroup a => a -> a -> a
<> Html
navigation)
forall a. Semigroup a => a -> a -> a
<> (Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"content") Html
content
forall a. Semigroup a => a -> a -> a
<> (Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"footer") Html
madeByHtml
)
where
futhark_doc_url :: AttributeValue
futhark_doc_url =
AttributeValue
"https://futhark.readthedocs.io/en/latest/man/futhark-doc.html"
addBoilerplateWithNav :: [ImportName] -> Imports -> String -> String -> Html -> Html
addBoilerplateWithNav :: [ImportName] -> Imports -> [Char] -> [Char] -> Html -> Html
addBoilerplateWithNav [ImportName]
important_imports Imports
imports [Char]
current [Char]
titleText Html
content =
[Char] -> [Char] -> Html -> Html
addBoilerplate [Char]
current [Char]
titleText forall a b. (a -> b) -> a -> b
$
(Html -> Html
H.nav forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"filenav" forall a b. (a -> b) -> a -> b
$ Html
files) forall a. Semigroup a => a -> a -> a
<> Html
content
where
files :: Html
files = Html -> Html
H.ul forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ImportName -> Html
pp forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ImportName -> Bool
visible [ImportName]
important_imports
pp :: ImportName -> Html
pp ImportName
name = Html -> Html
H.li forall a b. (a -> b) -> a -> b
$ [Char] -> ImportName -> Html
importLink [Char]
current ImportName
name
visible :: ImportName -> Bool
visible = (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst Imports
imports)
synopsisDecs :: [Dec] -> DocM Html
synopsisDecs :: [Dec]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
synopsisDecs [Dec]
decs = do
NoLink
visible <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Context -> NoLink
ctxVisibleMTys
FileModule
fm <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Context -> FileModule
ctxFileMod
(Html -> Html
H.table forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"specs") forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Html
emptyRow <>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (NoLink
-> FileModule
-> Dec
-> Maybe
(ReaderT Context (WriterT Documented (Writer Warnings)) Html)
synopsisDec NoLink
visible FileModule
fm) [Dec]
decs)
synopsisDec :: S.Set VName -> FileModule -> Dec -> Maybe (DocM Html)
synopsisDec :: NoLink
-> FileModule
-> Dec
-> Maybe
(ReaderT Context (WriterT Documented (Writer Warnings)) Html)
synopsisDec NoLink
visible FileModule
fm Dec
dec = case Dec
dec of
SigDec SigBindBase Info VName
s -> Html
-> SigBindBase Info VName
-> Maybe
(ReaderT Context (WriterT Documented (Writer Warnings)) Html)
synopsisModType forall a. Monoid a => a
mempty SigBindBase Info VName
s
ModDec ModBindBase Info VName
m -> FileModule
-> ModBindBase Info VName
-> Maybe
(ReaderT Context (WriterT Documented (Writer Warnings)) Html)
synopsisMod FileModule
fm ModBindBase Info VName
m
ValDec ValBindBase Info VName
v -> ValBindBase Info VName
-> Maybe
(ReaderT Context (WriterT Documented (Writer Warnings)) Html)
synopsisValBind ValBindBase Info VName
v
TypeDec TypeBindBase Info VName
t -> TypeBindBase Info VName
-> Maybe
(ReaderT Context (WriterT Documented (Writer Warnings)) Html)
synopsisType TypeBindBase Info VName
t
OpenDec ModExpBase Info VName
x SrcLoc
_
| Just ReaderT Context (WriterT Documented (Writer Warnings)) Html
opened <- ModExpBase Info VName
-> Maybe
(ReaderT Context (WriterT Documented (Writer Warnings)) Html)
synopsisOpened ModExpBase Info VName
x -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
Html
opened' <- ReaderT Context (WriterT Documented (Writer Warnings)) Html
opened
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Html -> Html
fullRow forall a b. (a -> b) -> a -> b
$ [Char] -> Html
keyword [Char]
"open " forall a. Semigroup a => a -> a -> a
<> Html
opened'
| Bool
otherwise ->
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
Html -> Html
fullRow forall a b. (a -> b) -> a -> b
$
[Char] -> Html
keyword [Char]
"open" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString ([Char]
" <" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> [Char]
prettyString ModExpBase Info VName
x forall a. Semigroup a => a -> a -> a
<> [Char]
">")
LocalDec (SigDec SigBindBase Info VName
s) SrcLoc
_
| forall (f :: * -> *) vn. SigBindBase f vn -> vn
sigName SigBindBase Info VName
s forall a. Ord a => a -> Set a -> Bool
`S.member` NoLink
visible ->
Html
-> SigBindBase Info VName
-> Maybe
(ReaderT Context (WriterT Documented (Writer Warnings)) Html)
synopsisModType ([Char] -> Html
keyword [Char]
"local" forall a. Semigroup a => a -> a -> a
<> Html
" ") SigBindBase Info VName
s
LocalDec {} -> forall a. Maybe a
Nothing
ImportDec {} -> forall a. Maybe a
Nothing
synopsisOpened :: ModExp -> Maybe (DocM Html)
synopsisOpened :: ModExpBase Info VName
-> Maybe
(ReaderT Context (WriterT Documented (Writer Warnings)) Html)
synopsisOpened (ModVar QualName VName
qn SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ QualName VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
qualNameHtml QualName VName
qn
synopsisOpened (ModParens ModExpBase Info VName
me SrcLoc
_) = do
ReaderT Context (WriterT Documented (Writer Warnings)) Html
me' <- ModExpBase Info VName
-> Maybe
(ReaderT Context (WriterT Documented (Writer Warnings)) Html)
synopsisOpened ModExpBase Info VName
me
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Html -> Html
parens forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT Context (WriterT Documented (Writer Warnings)) Html
me'
synopsisOpened (ModImport [Char]
_ (Info ImportName
file) SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
[Char]
current <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Context -> [Char]
ctxCurrent
let dest :: AttributeValue
dest = forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
relativise (ImportName -> [Char]
includeToFilePath ImportName
file) [Char]
current [Char] -> [Char] -> [Char]
-<.> [Char]
"html"
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
[Char] -> Html
keyword [Char]
"import "
forall a. Semigroup a => a -> a -> a
<> (Html -> Html
H.a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href AttributeValue
dest) (forall a. IsString a => [Char] -> a
fromString (forall a. Show a => a -> [Char]
show (ImportName -> [Char]
includeToString ImportName
file)))
synopsisOpened (ModAscript ModExpBase Info VName
_ SigExpBase Info VName
se Info (Map VName VName)
_ SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
Html
se' <- SigExpBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
synopsisSigExp SigExpBase Info VName
se
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Html
"... : " forall a. Semigroup a => a -> a -> a
<> Html
se'
synopsisOpened ModExpBase Info VName
_ = forall a. Maybe a
Nothing
synopsisValBind :: ValBind -> Maybe (DocM Html)
synopsisValBind :: ValBindBase Info VName
-> Maybe
(ReaderT Context (WriterT Documented (Writer Warnings)) Html)
synopsisValBind ValBindBase Info VName
vb = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
let name' :: Html
name' = VName -> Html
vnameSynopsisDef forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) vn. ValBindBase f vn -> vn
valBindName ValBindBase Info VName
vb
(Html
lhs, Html
mhs, Html
rhs) <- Html -> ValBindBase Info VName -> DocM (Html, Html, Html)
valBindHtml Html
name' ValBindBase Info VName
vb
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Html -> Html -> Html -> Html
specRow Html
lhs (Html
mhs forall a. Semigroup a => a -> a -> a
<> Html
" : ") Html
rhs
valBindHtml :: Html -> ValBind -> DocM (Html, Html, Html)
valBindHtml :: Html -> ValBindBase Info VName -> DocM (Html, Html, Html)
valBindHtml Html
name (ValBind Maybe (Info EntryPoint)
_ VName
_ Maybe (TypeExp Info VName)
retdecl (Info ResRetType
rettype) [TypeParamBase VName]
tparams [PatBase Info VName ParamType]
params Size
_ Maybe DocComment
_ [AttrInfo VName]
_ SrcLoc
_) = do
let tparams' :: Html
tparams' = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((Html
" " <>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeParamBase VName -> Html
typeParamHtml) [TypeParamBase VName]
tparams
noLink' :: DocM a -> DocM a
noLink' =
forall a. [VName] -> DocM a -> DocM a
noLink forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall vn. TypeParamBase vn -> vn
typeParamName [TypeParamBase VName]
tparams forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall t. Pat t -> [VName]
patNames [PatBase Info VName ParamType]
params
Html
rettype' <- forall {a}. DocM a -> DocM a
noLink' forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ResRetType
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
retTypeHtml ResRetType
rettype) TypeExp Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml Maybe (TypeExp Info VName)
retdecl
[Html]
params' <- forall {a}. DocM a -> DocM a
noLink' forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM PatBase Info VName ParamType
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
paramHtml [PatBase Info VName ParamType]
params
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( [Char] -> Html
keyword [Char]
"val " forall a. Semigroup a => a -> a -> a
<> (Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"decl_name") Html
name,
Html
tparams',
forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse Html
" -> " forall a b. (a -> b) -> a -> b
$ [Html]
params' forall a. [a] -> [a] -> [a]
++ [Html
rettype'])
)
synopsisModType :: Html -> SigBind -> Maybe (DocM Html)
synopsisModType :: Html
-> SigBindBase Info VName
-> Maybe
(ReaderT Context (WriterT Documented (Writer Warnings)) Html)
synopsisModType Html
prefix SigBindBase Info VName
sb = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
let name' :: Html
name' = VName -> Html
vnameSynopsisDef forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) vn. SigBindBase f vn -> vn
sigName SigBindBase Info VName
sb
Html -> Html
fullRow forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
Html
se' <- SigExpBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
synopsisSigExp forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) vn. SigBindBase f vn -> SigExpBase f vn
sigExp SigBindBase Info VName
sb
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Html
prefix forall a. Semigroup a => a -> a -> a
<> [Char] -> Html
keyword [Char]
"module type " forall a. Semigroup a => a -> a -> a
<> Html
name' forall a. Semigroup a => a -> a -> a
<> Html
" = " forall a. Semigroup a => a -> a -> a
<> Html
se'
synopsisMod :: FileModule -> ModBind -> Maybe (DocM Html)
synopsisMod :: FileModule
-> ModBindBase Info VName
-> Maybe
(ReaderT Context (WriterT Documented (Writer Warnings)) Html)
synopsisMod FileModule
fm (ModBind VName
name [ModParamBase Info VName]
ps Maybe (SigExpBase Info VName, Info (Map VName VName))
sig ModExpBase Info VName
_ Maybe DocComment
_ SrcLoc
_) =
case Maybe (SigExpBase Info VName, Info (Map VName VName))
sig of
Maybe (SigExpBase Info VName, Info (Map VName VName))
Nothing -> (Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
proceed forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Mod -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
envSig) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VName
name Map VName Mod
modtable
Just (SigExpBase Info VName
s, Info (Map VName VName)
_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
proceed forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SigExpBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
synopsisSigExp SigExpBase Info VName
s
where
proceed :: Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
proceed Html
sig' = do
let name' :: Html
name' = VName -> Html
vnameSynopsisDef VName
name
Html
ps' <- [ModParamBase Info VName]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
modParamHtml [ModParamBase Info VName]
ps
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Html -> Html -> Html -> Html
specRow ([Char] -> Html
keyword [Char]
"module " forall a. Semigroup a => a -> a -> a
<> Html
name') Html
": " (Html
ps' forall a. Semigroup a => a -> a -> a
<> Html
sig')
FileModule TySet
_abs Env {envModTable :: Env -> Map VName Mod
envModTable = Map VName Mod
modtable} Prog
_ Env
_ = FileModule
fm
envSig :: Mod -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
envSig (ModEnv Env
e) = Env -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
renderEnv Env
e
envSig (ModFun (FunSig TySet
_ Mod
_ (MTy TySet
_ Mod
m))) = Mod -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
envSig Mod
m
synopsisType :: TypeBind -> Maybe (DocM Html)
synopsisType :: TypeBindBase Info VName
-> Maybe
(ReaderT Context (WriterT Documented (Writer Warnings)) Html)
synopsisType TypeBindBase Info VName
tb = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
let name' :: Html
name' = VName -> Html
vnameSynopsisDef forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) vn. TypeBindBase f vn -> vn
typeAlias TypeBindBase Info VName
tb
Html -> Html
fullRow forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Html
-> TypeBindBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeBindHtml Html
name' TypeBindBase Info VName
tb
typeBindHtml :: Html -> TypeBind -> DocM Html
typeBindHtml :: Html
-> TypeBindBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeBindHtml Html
name' (TypeBind VName
_ Liftedness
l [TypeParamBase VName]
tparams TypeExp Info VName
t Info StructRetType
_ Maybe DocComment
_ SrcLoc
_) = do
Html
t' <- forall a. [VName] -> DocM a -> DocM a
noLink (forall a b. (a -> b) -> [a] -> [b]
map forall vn. TypeParamBase vn -> vn
typeParamName [TypeParamBase VName]
tparams) forall a b. (a -> b) -> a -> b
$ TypeExp Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp Info VName
t
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Liftedness -> Html -> [TypeParamBase VName] -> Html
typeAbbrevHtml Liftedness
l Html
name' [TypeParamBase VName]
tparams forall a. Semigroup a => a -> a -> a
<> Html
" = " forall a. Semigroup a => a -> a -> a
<> Html
t'
renderEnv :: Env -> DocM Html
renderEnv :: Env -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
renderEnv (Env Map VName BoundV
vtable Map VName TypeBinding
ttable Map VName MTy
sigtable Map VName Mod
modtable NameMap
_) = do
[Html]
typeBinds <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (VName, TypeBinding)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
renderTypeBind (forall k a. Map k a -> [(k, a)]
M.toList Map VName TypeBinding
ttable)
[Html]
valBinds <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (VName, BoundV)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
renderValBind (forall k a. Map k a -> [(k, a)]
M.toList Map VName BoundV
vtable)
[Html]
sigBinds <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (VName, MTy)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
renderModType (forall k a. Map k a -> [(k, a)]
M.toList Map VName MTy
sigtable)
[Html]
modBinds <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (VName, Mod)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
renderMod (forall k a. Map k a -> [(k, a)]
M.toList Map VName Mod
modtable)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Html -> Html
braces forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ [Html]
typeBinds forall a. [a] -> [a] -> [a]
++ [Html]
valBinds forall a. [a] -> [a] -> [a]
++ [Html]
sigBinds forall a. [a] -> [a] -> [a]
++ [Html]
modBinds
renderModType :: (VName, MTy) -> DocM Html
renderModType :: (VName, MTy)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
renderModType (VName
name, MTy
_sig) =
([Char] -> Html
keyword [Char]
"module type " <>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualName VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
qualNameHtml (forall v. v -> QualName v
qualName VName
name)
renderMod :: (VName, Mod) -> DocM Html
renderMod :: (VName, Mod)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
renderMod (VName
name, Mod
_mod) =
([Char] -> Html
keyword [Char]
"module " <>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualName VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
qualNameHtml (forall v. v -> QualName v
qualName VName
name)
renderValBind :: (VName, BoundV) -> DocM Html
renderValBind :: (VName, BoundV)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
renderValBind = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Html -> Html
H.div forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VName, BoundV)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
synopsisValBindBind
renderTypeBind :: (VName, TypeBinding) -> DocM Html
renderTypeBind :: (VName, TypeBinding)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
renderTypeBind (VName
name, TypeAbbr Liftedness
l [TypeParamBase VName]
tps StructRetType
tp) = do
Html
tp' <- ResRetType
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
retTypeHtml forall a b. (a -> b) -> a -> b
$ forall u. Uniqueness -> RetTypeBase Size u -> ResRetType
toResRet Uniqueness
Nonunique StructRetType
tp
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Html -> Html
H.div forall a b. (a -> b) -> a -> b
$ Liftedness -> Html -> [TypeParamBase VName] -> Html
typeAbbrevHtml Liftedness
l (VName -> Html
vnameHtml VName
name) [TypeParamBase VName]
tps forall a. Semigroup a => a -> a -> a
<> Html
" = " forall a. Semigroup a => a -> a -> a
<> Html
tp'
synopsisValBindBind :: (VName, BoundV) -> DocM Html
synopsisValBindBind :: (VName, BoundV)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
synopsisValBindBind (VName
name, BoundV [TypeParamBase VName]
tps StructType
t) = do
let tps' :: [Html]
tps' = forall a b. (a -> b) -> [a] -> [b]
map TypeParamBase VName -> Html
typeParamHtml [TypeParamBase VName]
tps
Html
t' <- TypeBase Size Uniqueness
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeHtml forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a b. a -> b -> a
const Uniqueness
Nonunique) StructType
t
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
[Char] -> Html
keyword [Char]
"val "
forall a. Semigroup a => a -> a -> a
<> VName -> Html
vnameHtml VName
name
forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (Html
" " <>) [Html]
tps')
forall a. Semigroup a => a -> a -> a
<> Html
": "
forall a. Semigroup a => a -> a -> a
<> Html
t'
dietHtml :: Diet -> Html
dietHtml :: Diet -> Html
dietHtml Diet
Consume = Html
"*"
dietHtml Diet
Observe = Html
""
typeHtml :: TypeBase Size Uniqueness -> DocM Html
typeHtml :: TypeBase Size Uniqueness
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeHtml TypeBase Size Uniqueness
t = case TypeBase Size Uniqueness
t of
Array Uniqueness
u Shape Size
shape ScalarTypeBase Size NoUniqueness
et -> do
Html
shape' <- Shape Size
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
prettyShape Shape Size
shape
Html
et' <- TypeBase Size Uniqueness
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeHtml forall a b. (a -> b) -> a -> b
$ forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a b. a -> b -> a
const Uniqueness
Nonunique) ScalarTypeBase Size NoUniqueness
et
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Uniqueness -> Html
prettyU Uniqueness
u forall a. Semigroup a => a -> a -> a
<> Html
shape' forall a. Semigroup a => a -> a -> a
<> Html
et'
Scalar (Prim PrimType
et) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PrimType -> Html
primTypeHtml PrimType
et
Scalar (Record Map Name (TypeBase Size Uniqueness)
fs)
| Just [TypeBase Size Uniqueness]
ts <- forall a. Map Name a -> Maybe [a]
areTupleFields Map Name (TypeBase Size Uniqueness)
fs ->
Html -> Html
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> Html
commas forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TypeBase Size Uniqueness
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeHtml [TypeBase Size Uniqueness]
ts
| Bool
otherwise ->
Html -> Html
braces forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> Html
commas forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Name, TypeBase Size Uniqueness)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
ppField (forall k a. Map k a -> [(k, a)]
M.toList Map Name (TypeBase Size Uniqueness)
fs)
where
ppField :: (Name, TypeBase Size Uniqueness)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
ppField (Name
name, TypeBase Size Uniqueness
tp) = do
Html
tp' <- TypeBase Size Uniqueness
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeHtml TypeBase Size Uniqueness
tp
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml (Name -> [Char]
nameToString Name
name) forall a. Semigroup a => a -> a -> a
<> Html
": " forall a. Semigroup a => a -> a -> a
<> Html
tp'
Scalar (TypeVar Uniqueness
u QualName VName
et [TypeArg Size]
targs) -> do
[Html]
targs' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TypeArg Size
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeArgHtml [TypeArg Size]
targs
Html
et' <- QualName VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
qualNameHtml QualName VName
et
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Uniqueness -> Html
prettyU Uniqueness
u forall a. Semigroup a => a -> a -> a
<> Html
et' forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (Html
" " <>) [Html]
targs')
Scalar (Arrow Uniqueness
_ PName
pname Diet
d StructType
t1 ResRetType
t2) -> do
Html
t1' <- TypeBase Size Uniqueness
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeHtml forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a b. a -> b -> a
const Uniqueness
Nonunique) StructType
t1
Html
t2' <- ResRetType
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
retTypeHtml ResRetType
t2
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case PName
pname of
Named VName
v ->
Html -> Html
parens (VName -> Html
vnameHtml VName
v forall a. Semigroup a => a -> a -> a
<> Html
": " forall a. Semigroup a => a -> a -> a
<> Diet -> Html
dietHtml Diet
d forall a. Semigroup a => a -> a -> a
<> Html
t1') forall a. Semigroup a => a -> a -> a
<> Html
" -> " forall a. Semigroup a => a -> a -> a
<> Html
t2'
PName
Unnamed ->
Diet -> Html
dietHtml Diet
d forall a. Semigroup a => a -> a -> a
<> Html
t1' forall a. Semigroup a => a -> a -> a
<> Html
" -> " forall a. Semigroup a => a -> a -> a
<> Html
t2'
Scalar (Sum Map Name [TypeBase Size Uniqueness]
cs) -> [Html] -> Html
pipes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Name, [TypeBase Size Uniqueness])
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
ppClause (forall a. Map Name a -> [(Name, a)]
sortConstrs Map Name [TypeBase Size Uniqueness]
cs)
where
ppClause :: (Name, [TypeBase Size Uniqueness])
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
ppClause (Name
n, [TypeBase Size Uniqueness]
ts) = Html -> [Html] -> Html
joinBy Html
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Html
ppConstr Name
n :) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TypeBase Size Uniqueness
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeHtml [TypeBase Size Uniqueness]
ts
ppConstr :: Name -> Html
ppConstr Name
name = Html
"#" forall a. Semigroup a => a -> a -> a
<> forall a. ToMarkup a => a -> Html
toHtml (Name -> [Char]
nameToString Name
name)
retTypeHtml :: ResRetType -> DocM Html
retTypeHtml :: ResRetType
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
retTypeHtml (RetType [] TypeBase Size Uniqueness
t) = TypeBase Size Uniqueness
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeHtml TypeBase Size Uniqueness
t
retTypeHtml (RetType [VName]
dims TypeBase Size Uniqueness
t) = do
Html
t' <- TypeBase Size Uniqueness
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeHtml TypeBase Size Uniqueness
t
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Html
"?" forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (Html -> Html
brackets forall b c a. (b -> c) -> (a -> b) -> a -> c
. VName -> Html
vnameHtml) [VName]
dims) forall a. Semigroup a => a -> a -> a
<> Html
"." forall a. Semigroup a => a -> a -> a
<> Html
t'
prettyShape :: Shape Size -> DocM Html
prettyShape :: Shape Size
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
prettyShape (Shape [Size]
ds) =
forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Size -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
dimDeclHtml [Size]
ds
typeArgHtml :: TypeArg Size -> DocM Html
typeArgHtml :: TypeArg Size
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeArgHtml (TypeArgDim Size
d) = Size -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
dimDeclHtml Size
d
typeArgHtml (TypeArgType StructType
t) = TypeBase Size Uniqueness
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeHtml forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a b. a -> b -> a
const Uniqueness
Nonunique) StructType
t
modParamHtml :: [ModParamBase Info VName] -> DocM Html
modParamHtml :: [ModParamBase Info VName]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
modParamHtml [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
modParamHtml (ModParam VName
pname SigExpBase Info VName
psig Info [VName]
_ SrcLoc
_ : [ModParamBase Info VName]
mps) =
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Html -> Html -> Html
f (SigExpBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
synopsisSigExp SigExpBase Info VName
psig) ([ModParamBase Info VName]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
modParamHtml [ModParamBase Info VName]
mps)
where
f :: Html -> Html -> Html
f Html
se Html
params =
Html
"("
forall a. Semigroup a => a -> a -> a
<> VName -> Html
vnameHtml VName
pname
forall a. Semigroup a => a -> a -> a
<> Html
": "
forall a. Semigroup a => a -> a -> a
<> Html
se
forall a. Semigroup a => a -> a -> a
<> Html
") -> "
forall a. Semigroup a => a -> a -> a
<> Html
params
synopsisSigExp :: SigExpBase Info VName -> DocM Html
synopsisSigExp :: SigExpBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
synopsisSigExp SigExpBase Info VName
e = case SigExpBase Info VName
e of
SigVar QualName VName
v Info (Map VName VName)
_ SrcLoc
_ -> QualName VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
qualNameHtml QualName VName
v
SigParens SigExpBase Info VName
e' SrcLoc
_ -> Html -> Html
parens forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SigExpBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
synopsisSigExp SigExpBase Info VName
e'
SigSpecs [SpecBase Info VName]
ss SrcLoc
_ -> Html -> Html
braces forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Html -> Html
H.table forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"specs") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SpecBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
synopsisSpec [SpecBase Info VName]
ss
SigWith SigExpBase Info VName
s (TypeRef QualName VName
v [TypeParamBase VName]
ps TypeExp Info VName
t SrcLoc
_) SrcLoc
_ -> do
Html
s' <- SigExpBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
synopsisSigExp SigExpBase Info VName
s
Html
t' <- TypeExp Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp Info VName
t
Html
v' <- QualName VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
qualNameHtml QualName VName
v
let ps' :: Html
ps' = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((Html
" " <>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeParamBase VName -> Html
typeParamHtml) [TypeParamBase VName]
ps
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Html
s' forall a. Semigroup a => a -> a -> a
<> [Char] -> Html
keyword [Char]
" with " forall a. Semigroup a => a -> a -> a
<> Html
v' forall a. Semigroup a => a -> a -> a
<> Html
ps' forall a. Semigroup a => a -> a -> a
<> Html
" = " forall a. Semigroup a => a -> a -> a
<> Html
t'
SigArrow Maybe VName
Nothing SigExpBase Info VName
e1 SigExpBase Info VName
e2 SrcLoc
_ ->
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall {a}. (Semigroup a, IsString a) => a -> a -> a
f (SigExpBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
synopsisSigExp SigExpBase Info VName
e1) (SigExpBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
synopsisSigExp SigExpBase Info VName
e2)
where
f :: a -> a -> a
f a
e1' a
e2' = a
e1' forall a. Semigroup a => a -> a -> a
<> a
" -> " forall a. Semigroup a => a -> a -> a
<> a
e2'
SigArrow (Just VName
v) SigExpBase Info VName
e1 SigExpBase Info VName
e2 SrcLoc
_ ->
do
let name :: Html
name = VName -> Html
vnameHtml VName
v
Html
e1' <- SigExpBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
synopsisSigExp SigExpBase Info VName
e1
Html
e2' <- forall a. [VName] -> DocM a -> DocM a
noLink [VName
v] forall a b. (a -> b) -> a -> b
$ SigExpBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
synopsisSigExp SigExpBase Info VName
e2
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Html
"(" forall a. Semigroup a => a -> a -> a
<> Html
name forall a. Semigroup a => a -> a -> a
<> Html
": " forall a. Semigroup a => a -> a -> a
<> Html
e1' forall a. Semigroup a => a -> a -> a
<> Html
") -> " forall a. Semigroup a => a -> a -> a
<> Html
e2'
keyword :: String -> Html
keyword :: [Char] -> Html
keyword = (Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"keyword") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => [Char] -> a
fromString
vnameHtml :: VName -> Html
vnameHtml :: VName -> Html
vnameHtml (VName Name
name Int
tag) =
Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (forall a. IsString a => [Char] -> a
fromString (forall a. Show a => a -> [Char]
show Int
tag)) forall a b. (a -> b) -> a -> b
$ Name -> Html
renderName Name
name
vnameDescDef :: VName -> IndexWhat -> DocM Html
vnameDescDef :: VName
-> IndexWhat
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
vnameDescDef VName
v IndexWhat
what = do
VName -> IndexWhat -> DocM ()
document VName
v IndexWhat
what
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Html -> Html
H.a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (forall a. IsString a => [Char] -> a
fromString (forall a. Show a => a -> [Char]
show (VName -> Int
baseTag VName
v))) forall a b. (a -> b) -> a -> b
$ Name -> Html
renderName (VName -> Name
baseName VName
v)
vnameSynopsisDef :: VName -> Html
vnameSynopsisDef :: VName -> Html
vnameSynopsisDef (VName Name
name Int
tag) =
Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (forall a. IsString a => [Char] -> a
fromString (forall a. Show a => a -> [Char]
show Int
tag forall a. [a] -> [a] -> [a]
++ [Char]
"s")) forall a b. (a -> b) -> a -> b
$
Html -> Html
H.a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (forall a. IsString a => [Char] -> a
fromString ([Char]
"#" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
tag)) forall a b. (a -> b) -> a -> b
$
Name -> Html
renderName Name
name
vnameSynopsisRef :: VName -> Html
vnameSynopsisRef :: VName -> Html
vnameSynopsisRef VName
v =
Html -> Html
H.a
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"synopsis_link"
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (forall a. IsString a => [Char] -> a
fromString ([Char]
"#" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (VName -> Int
baseTag VName
v) forall a. [a] -> [a] -> [a]
++ [Char]
"s"))
forall a b. (a -> b) -> a -> b
$ Html
"↑"
synopsisSpec :: SpecBase Info VName -> DocM Html
synopsisSpec :: SpecBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
synopsisSpec SpecBase Info VName
spec = case SpecBase Info VName
spec of
TypeAbbrSpec TypeBindBase Info VName
tpsig ->
Html -> Html
fullRow forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Html
-> TypeBindBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeBindHtml (VName -> Html
vnameSynopsisDef forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) vn. TypeBindBase f vn -> vn
typeAlias TypeBindBase Info VName
tpsig) TypeBindBase Info VName
tpsig
TypeSpec Liftedness
l VName
name [TypeParamBase VName]
ps Maybe DocComment
_ SrcLoc
_ ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Html -> Html
fullRow forall a b. (a -> b) -> a -> b
$ [Char] -> Html
keyword [Char]
l' forall a. Semigroup a => a -> a -> a
<> VName -> Html
vnameSynopsisDef VName
name forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map ((Html
" " <>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeParamBase VName -> Html
typeParamHtml) [TypeParamBase VName]
ps)
where
l' :: [Char]
l' = case Liftedness
l of
Liftedness
Unlifted -> [Char]
"type "
Liftedness
SizeLifted -> [Char]
"type~ "
Liftedness
Lifted -> [Char]
"type^ "
ValSpec VName
name [TypeParamBase VName]
tparams TypeExp Info VName
rettype Info StructType
_ Maybe DocComment
_ SrcLoc
_ -> do
let tparams' :: [Html]
tparams' = forall a b. (a -> b) -> [a] -> [b]
map TypeParamBase VName -> Html
typeParamHtml [TypeParamBase VName]
tparams
Html
rettype' <- forall a. [VName] -> DocM a -> DocM a
noLink (forall a b. (a -> b) -> [a] -> [b]
map forall vn. TypeParamBase vn -> vn
typeParamName [TypeParamBase VName]
tparams) forall a b. (a -> b) -> a -> b
$ TypeExp Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp Info VName
rettype
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
Html -> Html -> Html -> Html
specRow
([Char] -> Html
keyword [Char]
"val " forall a. Semigroup a => a -> a -> a
<> VName -> Html
vnameSynopsisDef VName
name)
(forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (Html
" " <>) [Html]
tparams') forall a. Semigroup a => a -> a -> a
<> Html
": ")
Html
rettype'
ModSpec VName
name SigExpBase Info VName
sig Maybe DocComment
_ SrcLoc
_ ->
Html -> Html -> Html -> Html
specRow ([Char] -> Html
keyword [Char]
"module " forall a. Semigroup a => a -> a -> a
<> VName -> Html
vnameSynopsisDef VName
name) Html
": " forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SigExpBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
synopsisSigExp SigExpBase Info VName
sig
IncludeSpec SigExpBase Info VName
e SrcLoc
_ -> Html -> Html
fullRow forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Html
keyword [Char]
"include " <>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SigExpBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
synopsisSigExp SigExpBase Info VName
e
typeExpHtml :: TypeExp Info VName -> DocM Html
typeExpHtml :: TypeExp Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp Info VName
e = case TypeExp Info VName
e of
TEUnique TypeExp Info VName
t SrcLoc
_ -> (Html
"*" <>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExp Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp Info VName
t
TEArray SizeExp Info VName
d TypeExp Info VName
at SrcLoc
_ -> do
Html
at' <- TypeExp Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp Info VName
at
Html
d' <- SizeExp Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
dimExpHtml SizeExp Info VName
d
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Html
d' forall a. Semigroup a => a -> a -> a
<> Html
at'
TETuple [TypeExp Info VName]
ts SrcLoc
_ -> Html -> Html
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> Html
commas forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TypeExp Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml [TypeExp Info VName]
ts
TERecord [(Name, TypeExp Info VName)]
fs SrcLoc
_ -> Html -> Html
braces forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> Html
commas forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Name, TypeExp Info VName)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
ppField [(Name, TypeExp Info VName)]
fs
where
ppField :: (Name, TypeExp Info VName)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
ppField (Name
name, TypeExp Info VName
t) = do
Html
t' <- TypeExp Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp Info VName
t
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml (Name -> [Char]
nameToString Name
name) forall a. Semigroup a => a -> a -> a
<> Html
": " forall a. Semigroup a => a -> a -> a
<> Html
t'
TEVar QualName VName
name SrcLoc
_ -> QualName VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
qualNameHtml QualName VName
name
TEParens TypeExp Info VName
te SrcLoc
_ -> Html -> Html
parens forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExp Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp Info VName
te
TEApply TypeExp Info VName
t TypeArgExp Info VName
arg SrcLoc
_ -> do
Html
t' <- TypeExp Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp Info VName
t
Html
arg' <- TypeArgExp Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeArgExpHtml TypeArgExp Info VName
arg
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Html
t' forall a. Semigroup a => a -> a -> a
<> Html
" " forall a. Semigroup a => a -> a -> a
<> Html
arg'
TEArrow Maybe VName
pname TypeExp Info VName
t1 TypeExp Info VName
t2 SrcLoc
_ -> do
Html
t1' <- case TypeExp Info VName
t1 of
TEArrow {} -> Html -> Html
parens forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExp Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp Info VName
t1
TypeExp Info VName
_ -> TypeExp Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp Info VName
t1
Html
t2' <- TypeExp Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp Info VName
t2
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Maybe VName
pname of
Just VName
v ->
Html -> Html
parens (VName -> Html
vnameHtml VName
v forall a. Semigroup a => a -> a -> a
<> Html
": " forall a. Semigroup a => a -> a -> a
<> Html
t1') forall a. Semigroup a => a -> a -> a
<> Html
" -> " forall a. Semigroup a => a -> a -> a
<> Html
t2'
Maybe VName
Nothing ->
Html
t1' forall a. Semigroup a => a -> a -> a
<> Html
" -> " forall a. Semigroup a => a -> a -> a
<> Html
t2'
TESum [(Name, [TypeExp Info VName])]
cs SrcLoc
_ -> [Html] -> Html
pipes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Name, [TypeExp Info VName])
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
ppClause [(Name, [TypeExp Info VName])]
cs
where
ppClause :: (Name, [TypeExp Info VName])
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
ppClause (Name
n, [TypeExp Info VName]
ts) = Html -> [Html] -> Html
joinBy Html
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Html
ppConstr Name
n :) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TypeExp Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml [TypeExp Info VName]
ts
ppConstr :: Name -> Html
ppConstr Name
name = Html
"#" forall a. Semigroup a => a -> a -> a
<> forall a. ToMarkup a => a -> Html
toHtml (Name -> [Char]
nameToString Name
name)
TEDim [VName]
dims TypeExp Info VName
t SrcLoc
_ -> do
Html
t' <- TypeExp Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp Info VName
t
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Html
"?" forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (Html -> Html
brackets forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Html
renderName forall b c a. (b -> c) -> (a -> b) -> a -> c
. VName -> Name
baseName) [VName]
dims) forall a. Semigroup a => a -> a -> a
<> Html
"." forall a. Semigroup a => a -> a -> a
<> Html
t'
qualNameHtml :: QualName VName -> DocM Html
qualNameHtml :: QualName VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
qualNameHtml (QualName [VName]
names vname :: VName
vname@(VName Name
name Int
tag)) =
if Int
tag forall a. Ord a => a -> a -> Bool
<= Int
maxIntrinsicTag
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Name -> Html
renderName Name
name
else Maybe [Char] -> Html
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
Context (WriterT Documented (Writer Warnings)) (Maybe [Char])
ref
where
prefix :: Html
prefix :: Html
prefix = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((forall a. Semigroup a => a -> a -> a
<> Html
".") forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Html
renderName forall b c a. (b -> c) -> (a -> b) -> a -> c
. VName -> Name
baseName) [VName]
names
f :: Maybe [Char] -> Html
f (Just [Char]
s) = Html -> Html
H.a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (forall a. IsString a => [Char] -> a
fromString [Char]
s) forall a b. (a -> b) -> a -> b
$ Html
prefix forall a. Semigroup a => a -> a -> a
<> Name -> Html
renderName Name
name
f Maybe [Char]
Nothing = Html
prefix forall a. Semigroup a => a -> a -> a
<> Name -> Html
renderName Name
name
ref :: ReaderT
Context (WriterT Documented (Writer Warnings)) (Maybe [Char])
ref = do
Bool
boring <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> Set a -> Bool
S.member VName
vname forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> NoLink
ctxNoLink
if Bool
boring
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VName -> DocM [Char]
vnameLink VName
vname
vnameLink :: VName -> DocM String
vnameLink :: VName -> DocM [Char]
vnameLink VName
vname = do
[Char]
current <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Context -> [Char]
ctxCurrent
[Char]
file <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
current forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VName
vname forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> FileMap
ctxFileMap
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ VName -> [Char] -> [Char] -> [Char]
vnameLink' VName
vname [Char]
current [Char]
file
vnameLink' :: VName -> String -> String -> String
vnameLink' :: VName -> [Char] -> [Char] -> [Char]
vnameLink' (VName Name
_ Int
tag) [Char]
current [Char]
file =
if [Char]
file forall a. Eq a => a -> a -> Bool
== [Char]
current
then [Char]
"#" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
tag
else [Char] -> [Char] -> [Char]
relativise [Char]
file [Char]
current [Char] -> [Char] -> [Char]
-<.> [Char]
".html#" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
tag
paramHtml :: Pat ParamType -> DocM Html
paramHtml :: PatBase Info VName ParamType
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
paramHtml PatBase Info VName ParamType
pat = do
let (PName
pat_param, Diet
d, StructType
t) = PatBase Info VName ParamType -> (PName, Diet, StructType)
patternParam PatBase Info VName ParamType
pat
Html
t' <- TypeBase Size Uniqueness
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeHtml forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a b. a -> b -> a
const Uniqueness
Nonunique) StructType
t
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case PName
pat_param of
Named VName
v -> Html -> Html
parens (VName -> Html
vnameHtml VName
v forall a. Semigroup a => a -> a -> a
<> Html
": " forall a. Semigroup a => a -> a -> a
<> Diet -> Html
dietHtml Diet
d forall a. Semigroup a => a -> a -> a
<> Html
t')
PName
Unnamed -> Html
t'
relativise :: FilePath -> FilePath -> FilePath
relativise :: [Char] -> [Char] -> [Char]
relativise [Char]
dest [Char]
src =
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> [[Char]]
splitPath [Char]
src) forall a. Num a => a -> a -> a
- Int
1) [Char]
"../") forall a. [a] -> [a] -> [a]
++ [Char] -> [Char] -> [Char]
makeRelative [Char]
"/" [Char]
dest
dimDeclHtml :: Size -> DocM Html
dimDeclHtml :: Size -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
dimDeclHtml = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Html
brackets forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToMarkup a => a -> Html
toHtml forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> [Char]
prettyString
dimExpHtml :: SizeExp Info VName -> DocM Html
dimExpHtml :: SizeExp Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
dimExpHtml (SizeExpAny SrcLoc
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Html -> Html
brackets forall a. Monoid a => a
mempty
dimExpHtml (SizeExp Size
e SrcLoc
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Html -> Html
brackets forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> [Char]
prettyString Size
e
typeArgExpHtml :: TypeArgExp Info VName -> DocM Html
typeArgExpHtml :: TypeArgExp Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeArgExpHtml (TypeArgExpSize SizeExp Info VName
d) = SizeExp Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
dimExpHtml SizeExp Info VName
d
typeArgExpHtml (TypeArgExpType TypeExp Info VName
d) = TypeExp Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp Info VName
d
typeParamHtml :: TypeParam -> Html
typeParamHtml :: TypeParamBase VName -> Html
typeParamHtml (TypeParamDim VName
name SrcLoc
_) =
Html -> Html
brackets forall a b. (a -> b) -> a -> b
$ VName -> Html
vnameHtml VName
name
typeParamHtml (TypeParamType Liftedness
l VName
name SrcLoc
_) =
Html
"'" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (forall a. Pretty a => a -> [Char]
prettyString Liftedness
l) forall a. Semigroup a => a -> a -> a
<> VName -> Html
vnameHtml VName
name
typeAbbrevHtml :: Liftedness -> Html -> [TypeParam] -> Html
typeAbbrevHtml :: Liftedness -> Html -> [TypeParamBase VName] -> Html
typeAbbrevHtml Liftedness
l Html
name [TypeParamBase VName]
params =
Html
what forall a. Semigroup a => a -> a -> a
<> Html
name forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map ((Html
" " <>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeParamBase VName -> Html
typeParamHtml) [TypeParamBase VName]
params)
where
what :: Html
what = [Char] -> Html
keyword forall a b. (a -> b) -> a -> b
$ [Char]
"type" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
prettyString Liftedness
l forall a. [a] -> [a] -> [a]
++ [Char]
" "
docHtml :: Maybe DocComment -> DocM Html
docHtml :: Maybe DocComment
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
docHtml (Just (DocComment Text
doc SrcLoc
loc)) =
Text -> Html
H.preEscapedText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CMarkOption] -> [CMarkExtension] -> Text -> Text
GFM.commonmarkToHtml [] [CMarkExtension
GFM.extAutolink]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SrcLoc -> [Char] -> DocM [Char]
identifierLinks SrcLoc
loc (Text -> [Char]
T.unpack Text
doc)
docHtml Maybe DocComment
Nothing = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
identifierLinks :: SrcLoc -> String -> DocM String
identifierLinks :: SrcLoc -> [Char] -> DocM [Char]
identifierLinks SrcLoc
_ [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
identifierLinks SrcLoc
loc [Char]
s
| Just (([Char]
name, [Char]
namespace, Maybe [Char]
file), [Char]
s') <- [Char] -> Maybe (([Char], [Char], Maybe [Char]), [Char])
identifierReference [Char]
s = do
let proceed :: [Char] -> DocM [Char]
proceed [Char]
x = ([Char]
x <>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SrcLoc -> [Char] -> DocM [Char]
identifierLinks SrcLoc
loc [Char]
s'
unknown :: DocM [Char]
unknown = [Char] -> DocM [Char]
proceed forall a b. (a -> b) -> a -> b
$ [Char]
"`" forall a. Semigroup a => a -> a -> a
<> [Char]
name forall a. Semigroup a => a -> a -> a
<> [Char]
"`"
case forall {a}. (Eq a, IsString a) => a -> Maybe Namespace
knownNamespace [Char]
namespace of
Just Namespace
namespace' -> do
Maybe VName
maybe_v <- (Namespace, [Char], Maybe [Char]) -> DocM (Maybe VName)
lookupName (Namespace
namespace', [Char]
name, Maybe [Char]
file)
case Maybe VName
maybe_v of
Maybe VName
Nothing -> do
SrcLoc -> Doc () -> DocM ()
warn SrcLoc
loc forall a b. (a -> b) -> a -> b
$
Doc ()
"Identifier '"
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString [Char]
name
forall a. Semigroup a => a -> a -> a
<> Doc ()
"' not found in namespace '"
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString [Char]
namespace
forall a. Semigroup a => a -> a -> a
<> Doc ()
"'"
forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" ([Char]
" in file " <>) Maybe [Char]
file)
forall a. Semigroup a => a -> a -> a
<> Doc ()
"."
DocM [Char]
unknown
Just VName
v' -> do
[Char]
link <- VName -> DocM [Char]
vnameLink VName
v'
[Char] -> DocM [Char]
proceed forall a b. (a -> b) -> a -> b
$ [Char]
"[`" forall a. Semigroup a => a -> a -> a
<> [Char]
name forall a. Semigroup a => a -> a -> a
<> [Char]
"`](" forall a. Semigroup a => a -> a -> a
<> [Char]
link forall a. Semigroup a => a -> a -> a
<> [Char]
")"
Maybe Namespace
_ -> do
SrcLoc -> Doc () -> DocM ()
warn SrcLoc
loc forall a b. (a -> b) -> a -> b
$ Doc ()
"Unknown namespace '" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString [Char]
namespace forall a. Semigroup a => a -> a -> a
<> Doc ()
"'."
DocM [Char]
unknown
where
knownNamespace :: a -> Maybe Namespace
knownNamespace a
"term" = forall a. a -> Maybe a
Just Namespace
Term
knownNamespace a
"mtype" = forall a. a -> Maybe a
Just Namespace
Signature
knownNamespace a
"type" = forall a. a -> Maybe a
Just Namespace
Type
knownNamespace a
_ = forall a. Maybe a
Nothing
identifierLinks SrcLoc
loc (Char
c : [Char]
s') = (Char
c :) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SrcLoc -> [Char] -> DocM [Char]
identifierLinks SrcLoc
loc [Char]
s'
lookupName :: (Namespace, String, Maybe FilePath) -> DocM (Maybe VName)
lookupName :: (Namespace, [Char], Maybe [Char]) -> DocM (Maybe VName)
lookupName (Namespace
namespace, [Char]
name, Maybe [Char]
file) = do
[Char]
current <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Context -> [Char]
ctxCurrent
let file' :: Maybe ImportName
file' = ImportName -> [Char] -> ImportName
mkImportFrom ([Char] -> ImportName
mkInitialImport [Char]
current) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Char]
file
Maybe Env
env <- Maybe ImportName -> DocM (Maybe Env)
lookupEnvForFile Maybe ImportName
file'
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Namespace
namespace, [Char] -> Name
nameFromString [Char]
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> NameMap
envNameMap forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Env
env of
Maybe (QualName VName)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Just QualName VName
qn -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall vn. QualName vn -> vn
qualLeaf QualName VName
qn
lookupEnvForFile :: Maybe ImportName -> DocM (Maybe Env)
lookupEnvForFile :: Maybe ImportName -> DocM (Maybe Env)
lookupEnvForFile Maybe ImportName
Nothing = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileModule -> Env
fileEnv forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> FileModule
ctxFileMod
lookupEnvForFile (Just ImportName
file) = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FileModule -> Env
fileEnv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ImportName
file forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> Imports
ctxImports
describeGeneric ::
VName ->
IndexWhat ->
Maybe DocComment ->
(Html -> DocM Html) ->
DocM Html
describeGeneric :: VName
-> IndexWhat
-> Maybe DocComment
-> (Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
describeGeneric VName
name IndexWhat
what Maybe DocComment
doc Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
f = do
Html
name' <- Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"decl_name" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VName
-> IndexWhat
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
vnameDescDef VName
name IndexWhat
what
Html
decl_type <- Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
f Html
name'
Html
doc' <- Maybe DocComment
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
docHtml Maybe DocComment
doc
let decl_doc :: Html
decl_doc = Html -> Html
H.dd forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"desc_doc" forall a b. (a -> b) -> a -> b
$ Html
doc'
decl_header :: Html
decl_header =
(Html -> Html
H.dt forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"desc_header") forall a b. (a -> b) -> a -> b
$
VName -> Html
vnameSynopsisRef VName
name forall a. Semigroup a => a -> a -> a
<> Html
decl_type
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Html
decl_header forall a. Semigroup a => a -> a -> a
<> Html
decl_doc
describeGenericMod ::
VName ->
IndexWhat ->
SigExp ->
Maybe DocComment ->
(Html -> DocM Html) ->
DocM Html
describeGenericMod :: VName
-> IndexWhat
-> SigExpBase Info VName
-> Maybe DocComment
-> (Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
describeGenericMod VName
name IndexWhat
what SigExpBase Info VName
se Maybe DocComment
doc Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
f = do
Html
name' <- Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"decl_name" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VName
-> IndexWhat
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
vnameDescDef VName
name IndexWhat
what
Html
decl_type <- Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
f Html
name'
Html
doc' <- case SigExpBase Info VName
se of
SigSpecs [SpecBase Info VName]
specs SrcLoc
_ -> forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DocComment
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
docHtml Maybe DocComment
doc forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [SpecBase Info VName]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
describeSpecs [SpecBase Info VName]
specs
SigExpBase Info VName
_ -> Maybe DocComment
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
docHtml Maybe DocComment
doc
let decl_doc :: Html
decl_doc = Html -> Html
H.dd forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"desc_doc" forall a b. (a -> b) -> a -> b
$ Html
doc'
decl_header :: Html
decl_header =
(Html -> Html
H.dt forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"desc_header") forall a b. (a -> b) -> a -> b
$
VName -> Html
vnameSynopsisRef VName
name forall a. Semigroup a => a -> a -> a
<> Html
decl_type
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Html
decl_header forall a. Semigroup a => a -> a -> a
<> Html
decl_doc
describeDecs :: [Dec] -> DocM Html
describeDecs :: [Dec]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
describeDecs [Dec]
decs = do
NoLink
visible <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Context -> NoLink
ctxVisibleMTys
Html -> Html
H.dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"decl_description")
(forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (NoLink
-> Dec
-> Maybe
(ReaderT Context (WriterT Documented (Writer Warnings)) Html)
describeDec NoLink
visible) [Dec]
decs)
describeDec :: S.Set VName -> Dec -> Maybe (DocM Html)
describeDec :: NoLink
-> Dec
-> Maybe
(ReaderT Context (WriterT Documented (Writer Warnings)) Html)
describeDec NoLink
_ (ValDec ValBindBase Info VName
vb) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
VName
-> IndexWhat
-> Maybe DocComment
-> (Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
describeGeneric (forall (f :: * -> *) vn. ValBindBase f vn -> vn
valBindName ValBindBase Info VName
vb) (ValBindBase Info VName -> IndexWhat
valBindWhat ValBindBase Info VName
vb) (forall (f :: * -> *) vn. ValBindBase f vn -> Maybe DocComment
valBindDoc ValBindBase Info VName
vb) forall a b. (a -> b) -> a -> b
$ \Html
name -> do
(Html
lhs, Html
mhs, Html
rhs) <- Html -> ValBindBase Info VName -> DocM (Html, Html, Html)
valBindHtml Html
name ValBindBase Info VName
vb
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Html
lhs forall a. Semigroup a => a -> a -> a
<> Html
mhs forall a. Semigroup a => a -> a -> a
<> Html
": " forall a. Semigroup a => a -> a -> a
<> Html
rhs
describeDec NoLink
_ (TypeDec TypeBindBase Info VName
vb) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
VName
-> IndexWhat
-> Maybe DocComment
-> (Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
describeGeneric (forall (f :: * -> *) vn. TypeBindBase f vn -> vn
typeAlias TypeBindBase Info VName
vb) IndexWhat
IndexType (forall (f :: * -> *) vn. TypeBindBase f vn -> Maybe DocComment
typeDoc TypeBindBase Info VName
vb) (Html
-> TypeBindBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
`typeBindHtml` TypeBindBase Info VName
vb)
describeDec NoLink
_ (SigDec (SigBind VName
name SigExpBase Info VName
se Maybe DocComment
doc SrcLoc
_)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
VName
-> IndexWhat
-> SigExpBase Info VName
-> Maybe DocComment
-> (Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
describeGenericMod VName
name IndexWhat
IndexModuleType SigExpBase Info VName
se Maybe DocComment
doc forall a b. (a -> b) -> a -> b
$ \Html
name' ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Char] -> Html
keyword [Char]
"module type " forall a. Semigroup a => a -> a -> a
<> Html
name'
describeDec NoLink
_ (ModDec ModBindBase Info VName
mb) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
VName
-> IndexWhat
-> Maybe DocComment
-> (Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
describeGeneric (forall (f :: * -> *) vn. ModBindBase f vn -> vn
modName ModBindBase Info VName
mb) IndexWhat
IndexModule (forall (f :: * -> *) vn. ModBindBase f vn -> Maybe DocComment
modDoc ModBindBase Info VName
mb) forall a b. (a -> b) -> a -> b
$ \Html
name' ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Char] -> Html
keyword [Char]
"module " forall a. Semigroup a => a -> a -> a
<> Html
name'
describeDec NoLink
_ OpenDec {} = forall a. Maybe a
Nothing
describeDec NoLink
visible (LocalDec (SigDec (SigBind VName
name SigExpBase Info VName
se Maybe DocComment
doc SrcLoc
_)) SrcLoc
_)
| VName
name forall a. Ord a => a -> Set a -> Bool
`S.member` NoLink
visible = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
VName
-> IndexWhat
-> SigExpBase Info VName
-> Maybe DocComment
-> (Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
describeGenericMod VName
name IndexWhat
IndexModuleType SigExpBase Info VName
se Maybe DocComment
doc forall a b. (a -> b) -> a -> b
$ \Html
name' ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Char] -> Html
keyword [Char]
"local module type " forall a. Semigroup a => a -> a -> a
<> Html
name'
describeDec NoLink
_ LocalDec {} = forall a. Maybe a
Nothing
describeDec NoLink
_ ImportDec {} = forall a. Maybe a
Nothing
valBindWhat :: ValBind -> IndexWhat
valBindWhat :: ValBindBase Info VName -> IndexWhat
valBindWhat ValBindBase Info VName
vb
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall (f :: * -> *) vn.
ValBindBase f vn -> [PatBase f vn ParamType]
valBindParams ValBindBase Info VName
vb),
RetType [VName]
_ TypeBase Size Uniqueness
t <- forall a. Info a -> a
unInfo forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) vn. ValBindBase f vn -> f ResRetType
valBindRetType ValBindBase Info VName
vb,
forall dim as. TypeBase dim as -> Bool
orderZero TypeBase Size Uniqueness
t =
IndexWhat
IndexValue
| Bool
otherwise =
IndexWhat
IndexFunction
describeSpecs :: [Spec] -> DocM Html
describeSpecs :: [SpecBase Info VName]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
describeSpecs [SpecBase Info VName]
specs =
Html -> Html
H.dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SpecBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
describeSpec [SpecBase Info VName]
specs
describeSpec :: Spec -> DocM Html
describeSpec :: SpecBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
describeSpec (ValSpec VName
name [TypeParamBase VName]
tparams TypeExp Info VName
t Info StructType
_ Maybe DocComment
doc SrcLoc
_) =
VName
-> IndexWhat
-> Maybe DocComment
-> (Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
describeGeneric VName
name IndexWhat
what Maybe DocComment
doc forall a b. (a -> b) -> a -> b
$ \Html
name' -> do
let tparams' :: Html
tparams' = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((Html
" " <>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeParamBase VName -> Html
typeParamHtml) [TypeParamBase VName]
tparams
Html
t' <- forall a. [VName] -> DocM a -> DocM a
noLink (forall a b. (a -> b) -> [a] -> [b]
map forall vn. TypeParamBase vn -> vn
typeParamName [TypeParamBase VName]
tparams) forall a b. (a -> b) -> a -> b
$ TypeExp Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp Info VName
t
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Char] -> Html
keyword [Char]
"val " forall a. Semigroup a => a -> a -> a
<> Html
name' forall a. Semigroup a => a -> a -> a
<> Html
tparams' forall a. Semigroup a => a -> a -> a
<> Html
": " forall a. Semigroup a => a -> a -> a
<> Html
t'
where
what :: IndexWhat
what =
case TypeExp Info VName
t of
TEArrow {} -> IndexWhat
IndexFunction
TypeExp Info VName
_ -> IndexWhat
IndexValue
describeSpec (TypeAbbrSpec TypeBindBase Info VName
vb) =
VName
-> IndexWhat
-> Maybe DocComment
-> (Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
describeGeneric (forall (f :: * -> *) vn. TypeBindBase f vn -> vn
typeAlias TypeBindBase Info VName
vb) IndexWhat
IndexType (forall (f :: * -> *) vn. TypeBindBase f vn -> Maybe DocComment
typeDoc TypeBindBase Info VName
vb) (Html
-> TypeBindBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
`typeBindHtml` TypeBindBase Info VName
vb)
describeSpec (TypeSpec Liftedness
l VName
name [TypeParamBase VName]
tparams Maybe DocComment
doc SrcLoc
_) =
VName
-> IndexWhat
-> Maybe DocComment
-> (Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
describeGeneric VName
name IndexWhat
IndexType Maybe DocComment
doc forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Html
name' -> Liftedness -> Html -> [TypeParamBase VName] -> Html
typeAbbrevHtml Liftedness
l Html
name' [TypeParamBase VName]
tparams)
describeSpec (ModSpec VName
name SigExpBase Info VName
se Maybe DocComment
doc SrcLoc
_) =
VName
-> IndexWhat
-> SigExpBase Info VName
-> Maybe DocComment
-> (Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
describeGenericMod VName
name IndexWhat
IndexModule SigExpBase Info VName
se Maybe DocComment
doc forall a b. (a -> b) -> a -> b
$ \Html
name' ->
case SigExpBase Info VName
se of
SigSpecs {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Char] -> Html
keyword [Char]
"module " forall a. Semigroup a => a -> a -> a
<> Html
name'
SigExpBase Info VName
_ -> do
Html
se' <- SigExpBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
synopsisSigExp SigExpBase Info VName
se
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Char] -> Html
keyword [Char]
"module " forall a. Semigroup a => a -> a -> a
<> Html
name' forall a. Semigroup a => a -> a -> a
<> Html
": " forall a. Semigroup a => a -> a -> a
<> Html
se'
describeSpec (IncludeSpec SigExpBase Info VName
sig SrcLoc
_) = do
Html
sig' <- SigExpBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
synopsisSigExp SigExpBase Info VName
sig
Html
doc' <- Maybe DocComment
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
docHtml forall a. Maybe a
Nothing
let decl_header :: Html
decl_header =
(Html -> Html
H.dt forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"desc_header") forall a b. (a -> b) -> a -> b
$
(Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"synopsis_link") forall a. Monoid a => a
mempty
forall a. Semigroup a => a -> a -> a
<> [Char] -> Html
keyword [Char]
"include "
forall a. Semigroup a => a -> a -> a
<> Html
sig'
decl_doc :: Html
decl_doc = Html -> Html
H.dd forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"desc_doc" forall a b. (a -> b) -> a -> b
$ Html
doc'
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Html
decl_header forall a. Semigroup a => a -> a -> a
<> Html
decl_doc