-- | The core logic of @futhark doc@.
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
" | "

-- | A set of names that we should not generate links to, because they
-- are uninteresting.  These are for example type parameters.
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,
    -- | Local module types that show up in the
    -- interface.  These should be documented,
    -- but clearly marked local.
    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

-- | We keep a mapping of the names we have actually documented, so we
-- can generate an index.
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 important_imports imports@ produces HTML files
-- documenting the type-checked program @imports@, with the files in
-- @important_imports@ considered most important.  The HTML files must
-- be written to the specific locations indicated in the return value,
-- or the relative links will be wrong.
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"

-- | The header documentation (which need not be present) can contain
-- an abstract and further sections.
headerDoc :: Prog -> DocM (Html, Html, Html)
headerDoc :: Prog -> DocM (Html, Html, Html)
headerDoc 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
  -- We add an empty row to avoid generating invalid HTML in cases
  -- where all rows are otherwise colspan=2.
  (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