-- | 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 hiding (Sum)
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 -> FilePath
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 (FilePath, FileModule) -> FileMap
forFile
  where
    forFile :: (FilePath, FileModule) -> FileMap
forFile (FilePath
file, FileModule TySet
abs Env
file_env Prog
_prog) =
      forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (forall {b} {k}. b -> QualName k -> Map k (FilePath, 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' :: FilePath
file' = FilePath -> FilePath -> FilePath
makeRelative FilePath
"/" FilePath
file
        vname :: b -> QualName k -> Map k (FilePath, 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) (FilePath
file', b
ns)
        vname' :: ((b, b), QualName k) -> Map k (FilePath, b)
vname' ((b
ns, b
_), QualName k
v) = forall {b} {k}. b -> QualName k -> Map k (FilePath, 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 (FilePath, 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 :: [FilePath] -> Imports -> ([(FilePath, Html)], Warnings)
renderFiles :: [FilePath] -> Imports -> ([(FilePath, Html)], Warnings)
renderFiles [FilePath]
important_imports Imports
imports = forall w a. Writer w a -> (a, w)
runWriter forall a b. (a -> b) -> a -> b
$ do
  ([(FilePath, (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
$ \(FilePath
current, FileModule
fm) ->
      let ctx :: Context
ctx =
            Context
              { ctxCurrent :: FilePath
ctxCurrent = FilePath -> FilePath -> FilePath
makeRelative FilePath
"/" FilePath
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
              ( FilePath
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
$
                    [FilePath] -> Imports -> FilePath -> FilePath -> Html -> Html
addBoilerplateWithNav [FilePath]
important_imports Imports
imports (FilePath
"doc" FilePath -> FilePath -> FilePath
</> FilePath
current) FilePath
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
$
    [ (FilePath
"index.html", [FilePath] -> [(FilePath, Html)] -> Html
contentsPage [FilePath]
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) [(FilePath, (Html, Html))]
import_pages),
      (FilePath
"doc-index.html", [FilePath] -> Imports -> Documented -> FileMap -> Html
indexPage [FilePath]
important_imports Imports
imports Documented
documented FileMap
file_map)
    ]
      forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath
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) [(FilePath, (Html, Html))]
import_pages
  where
    file_map :: FileMap
file_map = Imports -> FileMap
vnameToFileMap Imports
imports
    importHtml :: FilePath -> FilePath
importHtml FilePath
import_name = FilePath
"doc" FilePath -> FilePath -> FilePath
</> FilePath -> FilePath -> FilePath
makeRelative FilePath
"/" FilePath
import_name FilePath -> FilePath -> FilePath
<.> FilePath
"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 FilePath
doc SrcLoc
loc) -> do
      let (FilePath
abstract, FilePath
more_sections) = FilePath -> (FilePath, FilePath)
splitHeaderDoc FilePath
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
$ FilePath -> SrcLoc -> DocComment
DocComment (FilePath -> FilePath
firstParagraph FilePath
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
$ FilePath -> SrcLoc -> DocComment
DocComment FilePath
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
$ FilePath -> SrcLoc -> DocComment
DocComment FilePath
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 :: FilePath -> (FilePath, FilePath)
splitHeaderDoc FilePath
s =
      forall a. a -> Maybe a -> a
fromMaybe (FilePath
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 ((FilePath
"\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 FilePath
s) (forall a. [a] -> [[a]]
tails FilePath
s)
    firstParagraph :: FilePath -> FilePath
firstParagraph = [FilePath] -> FilePath
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
. FilePath -> Bool
paragraphSeparator) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines
    paragraphSeparator :: FilePath -> Bool
paragraphSeparator = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace

contentsPage :: [FilePath] -> [(String, Html)] -> Html
contentsPage :: [FilePath] -> [(FilePath, Html)] -> Html
contentsPage [FilePath]
important_imports [(FilePath, Html)]
pages =
  Html -> Html
H.docTypeHtml forall a b. (a -> b) -> a -> b
$
    FilePath -> FilePath -> Html -> Html
addBoilerplate FilePath
"index.html" FilePath
"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 [(FilePath, 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
<> [(FilePath, Html)] -> Html
fileList [(FilePath, Html)]
important_pages
        )
          forall a. Semigroup a => a -> a -> a
<> ( if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FilePath, 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
<> [(FilePath, Html)] -> Html
fileList [(FilePath, Html)]
unimportant_pages
             )
  where
    ([(FilePath, Html)]
important_pages, [(FilePath, Html)]
unimportant_pages) =
      forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
important_imports) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(FilePath, Html)]
pages

    fileList :: [(FilePath, Html)] -> Html
fileList [(FilePath, 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 (FilePath, 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 [(FilePath, Html)]
pages'

    linkTo :: (FilePath, Html) -> Html
linkTo (FilePath
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") (FilePath -> FilePath -> Html
importLink FilePath
"index.html" FilePath
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 -> String -> Html
importLink :: FilePath -> FilePath -> Html
importLink FilePath
current FilePath
name =
  let file :: FilePath
file = FilePath -> FilePath -> FilePath
relativise (FilePath
"doc" FilePath -> FilePath -> FilePath
</> FilePath -> FilePath -> FilePath
makeRelative FilePath
"/" FilePath
name FilePath -> FilePath -> FilePath
-<.> FilePath
"html") FilePath
current
   in (Html -> Html
H.a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (forall a. IsString a => FilePath -> a
fromString FilePath
file) forall a b. (a -> b) -> a -> b
$ forall a. IsString a => FilePath -> a
fromString FilePath
name)

indexPage :: [FilePath] -> Imports -> Documented -> FileMap -> Html
indexPage :: [FilePath] -> Imports -> Documented -> FileMap -> Html
indexPage [FilePath]
important_imports Imports
imports Documented
documented FileMap
fm =
  Html -> Html
H.docTypeHtml forall a b. (a -> b) -> a -> b
$
    [FilePath] -> Imports -> FilePath -> FilePath -> Html -> Html
addBoilerplateWithNav [FilePath]
important_imports Imports
imports FilePath
"doc-index.html" FilePath
"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 FilePath -> Html
initialListEntry forall a b. (a -> b) -> a -> b
$
                [FilePath]
letter_group_links forall a. [a] -> [a] -> [a]
++ [FilePath
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, (FilePath, IndexWhat))]
letter_names, [(VName, (FilePath, IndexWhat))]
sym_names) =
      forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (FilePath -> Bool
isLetterName forall b c a. (b -> c) -> (a -> b) -> a -> c
. VName -> FilePath
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 -> FilePath
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, [FilePath]
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, (FilePath, IndexWhat))] -> (Html, FilePath)
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, (FilePath, IndexWhat))]
letter_names
    (Html
symbol_group, FilePath
symbol_group_link) =
      FilePath -> [(VName, (FilePath, IndexWhat))] -> (Html, FilePath)
tbodyForInitial FilePath
"Symbols" [(VName, (FilePath, IndexWhat))]
sym_names

    isLetterName :: FilePath -> Bool
isLetterName [] = Bool
False
    isLetterName (Char
c : FilePath
_) = Char -> Bool
isAlpha Char
c

    sameInitial :: (VName, b) -> (VName, b) -> Bool
sameInitial (VName
x, b
_) (VName
y, b
_) =
      case (VName -> FilePath
baseString VName
x, VName -> FilePath
baseString VName
y) of
        (Char
x' : FilePath
_, Char
y' : FilePath
_) -> Char -> Char
toUpper Char
x' forall a. Eq a => a -> a -> Bool
== Char -> Char
toUpper Char
y'
        (FilePath, FilePath)
_ -> Bool
False

    tbodyForNames :: [(VName, (FilePath, IndexWhat))] -> (Html, FilePath)
tbodyForNames names :: [(VName, (FilePath, IndexWhat))]
names@((VName
s, (FilePath, IndexWhat)
_) : [(VName, (FilePath, IndexWhat))]
_) =
      FilePath -> [(VName, (FilePath, IndexWhat))] -> (Html, FilePath)
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 -> FilePath
baseString VName
s) [(VName, (FilePath, IndexWhat))]
names
    tbodyForNames [(VName, (FilePath, IndexWhat))]
_ = forall a. Monoid a => a
mempty

    tbodyForInitial :: FilePath -> [(VName, (FilePath, IndexWhat))] -> (Html, FilePath)
tbodyForInitial FilePath
initial [(VName, (FilePath, 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, (FilePath, IndexWhat)) -> Html
linkTo [(VName, (FilePath, IndexWhat))]
names,
        FilePath
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 => FilePath -> a
fromString FilePath
initial)
              forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (forall a. IsString a => FilePath -> a
fromString forall a b. (a -> b) -> a -> b
$ Char
'#' forall a. a -> [a] -> [a]
: FilePath
initial)
            forall a b. (a -> b) -> a -> b
$ forall a. IsString a => FilePath -> a
fromString FilePath
initial

    initialListEntry :: FilePath -> Html
initialListEntry FilePath
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 => FilePath -> a
fromString forall a b. (a -> b) -> a -> b
$ Char
'#' forall a. a -> [a] -> [a]
: FilePath
initial) forall a b. (a -> b) -> a -> b
$ forall a. IsString a => FilePath -> a
fromString FilePath
initial

    linkTo :: (VName, (FilePath, IndexWhat)) -> Html
linkTo (VName
name, (FilePath
file, IndexWhat
what)) =
      let file' :: FilePath
file' = FilePath -> FilePath -> FilePath
makeRelative FilePath
"/" FilePath
file
          link :: Html
link =
            (Html -> Html
H.a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (forall a. IsString a => FilePath -> a
fromString (FilePath -> FilePath -> FilePath
makeRelative FilePath
"/" forall a b. (a -> b) -> a -> b
$ FilePath
"doc" FilePath -> FilePath -> FilePath
</> VName -> FilePath -> FilePath -> FilePath
vnameLink' VName
name FilePath
"" FilePath
file'))) forall a b. (a -> b) -> a -> b
$
              forall a. IsString a => FilePath -> a
fromString forall a b. (a -> b) -> a -> b
$
                VName -> FilePath
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 :: FilePath
html_file = FilePath
"doc" FilePath -> FilePath -> FilePath
</> FilePath
file' FilePath -> FilePath -> FilePath
-<.> FilePath
"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 => FilePath -> a
fromString FilePath
html_file) forall a b. (a -> b) -> a -> b
$ forall a. IsString a => FilePath -> a
fromString FilePath
file)
                 )

addBoilerplate :: String -> String -> Html -> Html
addBoilerplate :: FilePath -> FilePath -> Html -> Html
addBoilerplate FilePath
current FilePath
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 => FilePath -> a
fromString FilePath
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 => FilePath -> a
fromString forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
relativise FilePath
"style.css" FilePath
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 => FilePath -> a
fromString forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
relativise FilePath
"index.html" FilePath
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 => FilePath -> a
fromString forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
relativise FilePath
"doc-index.html" FilePath
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 => FilePath -> a
fromString (Version -> FilePath
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 FilePath
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 :: [FilePath] -> Imports -> String -> String -> Html -> Html
addBoilerplateWithNav :: [FilePath] -> Imports -> FilePath -> FilePath -> Html -> Html
addBoilerplateWithNav [FilePath]
important_imports Imports
imports FilePath
current FilePath
titleText Html
content =
  FilePath -> FilePath -> Html -> Html
addBoilerplate FilePath
current FilePath
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 FilePath -> 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 FilePath -> Bool
visible [FilePath]
important_imports
    pp :: FilePath -> Html
pp FilePath
name = Html -> Html
H.li forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Html
importLink FilePath
current FilePath
name
    visible :: FilePath -> 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
$ FilePath -> Html
keyword FilePath
"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
$
              FilePath -> Html
keyword FilePath
"open" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => FilePath -> a
fromString (FilePath
" <" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> FilePath
prettyString ModExpBase Info VName
x forall a. Semigroup a => a -> a -> a
<> FilePath
">")
  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 (FilePath -> Html
keyword FilePath
"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 FilePath
_ (Info FilePath
file) SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
  FilePath
current <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Context -> FilePath
ctxCurrent
  let dest :: AttributeValue
dest = forall a. IsString a => FilePath -> a
fromString forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
relativise FilePath
file FilePath
current forall a. Semigroup a => a -> a -> a
<> FilePath
".html"
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath -> Html
keyword FilePath
"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 => FilePath -> a
fromString forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show FilePath
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 VName)
retdecl (Info StructRetType
rettype) [TypeParamBase VName]
tparams [PatBase Info VName]
params ExpBase Info VName
_ 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. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *) vn. IdentBase f vn -> vn
identName (forall a. Set a -> [a]
S.toList 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 forall (f :: * -> *) vn.
(Functor f, Ord vn) =>
PatBase f vn -> Set (IdentBase f vn)
patIdents [PatBase Info VName]
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 (StructRetType
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
retTypeHtml StructRetType
rettype) TypeExp VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml Maybe (TypeExp 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
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
patternHtml [PatBase Info VName]
params
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( FilePath -> Html
keyword FilePath
"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
<> FilePath -> Html
keyword FilePath
"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 (FilePath -> Html
keyword FilePath
"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
_ = 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 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 VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp 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) =
  (FilePath -> Html
keyword FilePath
"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) =
  (FilePath -> Html
keyword FilePath
"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' <- StructRetType
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
retTypeHtml 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' <- StructType
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeHtml StructType
t
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    FilePath -> Html
keyword FilePath
"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'

typeHtml :: StructType -> DocM Html
typeHtml :: StructType
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeHtml StructType
t = case StructType
t of
  Array ()
_ Uniqueness
u Shape Size
shape ScalarTypeBase Size ()
et -> do
    Html
shape' <- Shape Size
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
prettyShape Shape Size
shape
    Html
et' <- StructType
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeHtml forall a b. (a -> b) -> a -> b
$ forall dim as. ScalarTypeBase dim as -> TypeBase dim as
Scalar ScalarTypeBase Size ()
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 StructType
fs)
    | Just [StructType]
ts <- forall a. Map Name a -> Maybe [a]
areTupleFields Map Name StructType
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 StructType
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeHtml [StructType]
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, StructType)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
ppField (forall k a. Map k a -> [(k, a)]
M.toList Map Name StructType
fs)
    where
      ppField :: (Name, StructType)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
ppField (Name
name, StructType
tp) = do
        Html
tp' <- StructType
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeHtml StructType
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 -> FilePath
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 ()
_ PName
pname StructType
t1 StructRetType
t2) -> do
    Html
t1' <- StructType
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeHtml StructType
t1
    Html
t2' <- StructRetType
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
retTypeHtml StructRetType
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
<> Html
t1') forall a. Semigroup a => a -> a -> a
<> Html
" -> " forall a. Semigroup a => a -> a -> a
<> Html
t2'
      PName
Unnamed ->
        Html
t1' forall a. Semigroup a => a -> a -> a
<> Html
" -> " forall a. Semigroup a => a -> a -> a
<> Html
t2'
  Scalar (Sum Map Name [StructType]
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, [StructType])
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
ppClause (forall a. Map Name a -> [(Name, a)]
sortConstrs Map Name [StructType]
cs)
    where
      ppClause :: (Name, [StructType])
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
ppClause (Name
n, [StructType]
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 StructType
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeHtml [StructType]
ts
      ppConstr :: Name -> Html
ppConstr Name
name = Html
"#" forall a. Semigroup a => a -> a -> a
<> forall a. ToMarkup a => a -> Html
toHtml (Name -> FilePath
nameToString Name
name)

retTypeHtml :: StructRetType -> DocM Html
retTypeHtml :: StructRetType
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
retTypeHtml (RetType [] StructType
t) = StructType
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeHtml StructType
t
retTypeHtml (RetType [VName]
dims StructType
t) = do
  Html
t' <- StructType
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeHtml StructType
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 SrcLoc
_) = Size -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
dimDeclHtml Size
d
typeArgHtml (TypeArgType StructType
t SrcLoc
_) = StructType
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeHtml 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 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 VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp 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
<> FilePath -> Html
keyword FilePath
" 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 :: FilePath -> 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 => FilePath -> 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 => FilePath -> a
fromString (forall a. Show a => a -> FilePath
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 => FilePath -> a
fromString (forall a. Show a => a -> FilePath
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 => FilePath -> a
fromString (forall a. Show a => a -> FilePath
show Int
tag forall a. [a] -> [a] -> [a]
++ FilePath
"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 => FilePath -> a
fromString (FilePath
"#" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
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 => FilePath -> a
fromString (FilePath
"#" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show (VName -> Int
baseTag VName
v) forall a. [a] -> [a] -> [a]
++ FilePath
"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
$ FilePath -> Html
keyword FilePath
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' :: FilePath
l' = case Liftedness
l of
        Liftedness
Unlifted -> FilePath
"type "
        Liftedness
SizeLifted -> FilePath
"type~ "
        Liftedness
Lifted -> FilePath
"type^ "
  ValSpec VName
name [TypeParamBase VName]
tparams TypeExp 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 VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp VName
rettype
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      Html -> Html -> Html -> Html
specRow
        (FilePath -> Html
keyword FilePath
"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 (FilePath -> Html
keyword FilePath
"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
. (FilePath -> Html
keyword FilePath
"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 VName -> DocM Html
typeExpHtml :: TypeExp VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp VName
e = case TypeExp VName
e of
  TEUnique TypeExp VName
t SrcLoc
_ -> (Html
"*" <>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExp VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp VName
t
  TEArray SizeExp VName
d TypeExp VName
at SrcLoc
_ -> do
    Html
at' <- TypeExp VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp VName
at
    Html
d' <- SizeExp VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
dimExpHtml SizeExp 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 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 VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml [TypeExp VName]
ts
  TERecord [(Name, TypeExp 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 VName)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
ppField [(Name, TypeExp VName)]
fs
    where
      ppField :: (Name, TypeExp VName)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
ppField (Name
name, TypeExp VName
t) = do
        Html
t' <- TypeExp VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp 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 -> FilePath
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
  TEApply TypeExp VName
t TypeArgExp VName
arg SrcLoc
_ -> do
    Html
t' <- TypeExp VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp VName
t
    Html
arg' <- TypeArgExp VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeArgExpHtml TypeArgExp 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 VName
t1 TypeExp VName
t2 SrcLoc
_ -> do
    Html
t1' <- case TypeExp VName
t1 of
      TEArrow {} -> Html -> Html
parens forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeExp VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp VName
t1
      TypeExp VName
_ -> TypeExp VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp VName
t1
    Html
t2' <- TypeExp VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp 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 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 VName])
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
ppClause [(Name, [TypeExp VName])]
cs
    where
      ppClause :: (Name, [TypeExp VName])
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
ppClause (Name
n, [TypeExp 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 VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml [TypeExp VName]
ts
      ppConstr :: Name -> Html
ppConstr Name
name = Html
"#" forall a. Semigroup a => a -> a -> a
<> forall a. ToMarkup a => a -> Html
toHtml (Name -> FilePath
nameToString Name
name)
  TEDim [VName]
dims TypeExp VName
t SrcLoc
_ -> do
    Html
t' <- TypeExp VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp 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 FilePath -> Html
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  Context (WriterT Documented (Writer Warnings)) (Maybe FilePath)
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 FilePath -> Html
f (Just FilePath
s) = Html -> Html
H.a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (forall a. IsString a => FilePath -> a
fromString FilePath
s) forall a b. (a -> b) -> a -> b
$ Html
prefix forall a. Semigroup a => a -> a -> a
<> Name -> Html
renderName Name
name
    f Maybe FilePath
Nothing = Html
prefix forall a. Semigroup a => a -> a -> a
<> Name -> Html
renderName Name
name

    ref :: ReaderT
  Context (WriterT Documented (Writer Warnings)) (Maybe FilePath)
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 FilePath
vnameLink VName
vname

vnameLink :: VName -> DocM String
vnameLink :: VName -> DocM FilePath
vnameLink VName
vname = do
  FilePath
current <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Context -> FilePath
ctxCurrent
  FilePath
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 FilePath
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 -> FilePath -> FilePath -> FilePath
vnameLink' VName
vname FilePath
current FilePath
file

vnameLink' :: VName -> String -> String -> String
vnameLink' :: VName -> FilePath -> FilePath -> FilePath
vnameLink' (VName Name
_ Int
tag) FilePath
current FilePath
file =
  if FilePath
file forall a. Eq a => a -> a -> Bool
== FilePath
current
    then FilePath
"#" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Int
tag
    else FilePath -> FilePath -> FilePath
relativise FilePath
file FilePath
current forall a. [a] -> [a] -> [a]
++ FilePath
".html#" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Int
tag

patternHtml :: Pat -> DocM Html
patternHtml :: PatBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
patternHtml PatBase Info VName
pat = do
  let (PName
pat_param, StructType
t) = PatBase Info VName -> (PName, StructType)
patternParam PatBase Info VName
pat
  Html
t' <- StructType
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeHtml 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
<> Html
t')
    PName
Unnamed -> Html
t'

relativise :: FilePath -> FilePath -> FilePath
relativise :: FilePath -> FilePath -> FilePath
relativise FilePath
dest FilePath
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 (FilePath -> [FilePath]
splitPath FilePath
src) forall a. Num a => a -> a -> a
- Int
1) FilePath
"../") forall a. [a] -> [a] -> [a]
++ FilePath
dest

dimDeclHtml :: Size -> DocM Html
dimDeclHtml :: Size -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
dimDeclHtml (NamedSize QualName VName
v) = Html -> Html
brackets forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualName VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
qualNameHtml QualName VName
v
dimDeclHtml (ConstSize Int
n) = 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. Show a => a -> FilePath
show Int
n)
dimDeclHtml AnySize {} = 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 VName -> DocM Html
dimExpHtml :: SizeExp VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
dimExpHtml SizeExp VName
SizeExpAny = 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 (SizeExpNamed QualName VName
v SrcLoc
_) = Html -> Html
brackets forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualName VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
qualNameHtml QualName VName
v
dimExpHtml (SizeExpConst Int
n 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. Show a => a -> FilePath
show Int
n)

typeArgExpHtml :: TypeArgExp VName -> DocM Html
typeArgExpHtml :: TypeArgExp VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeArgExpHtml (TypeArgExpDim SizeExp VName
d SrcLoc
_) = SizeExp VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
dimExpHtml SizeExp VName
d
typeArgExpHtml (TypeArgExpType TypeExp VName
d) = TypeExp VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp 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 => FilePath -> a
fromString (forall a. Pretty a => a -> FilePath
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 = FilePath -> Html
keyword forall a b. (a -> b) -> a -> b
$ FilePath
"type" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyString Liftedness
l forall a. [a] -> [a] -> [a]
++ FilePath
" "

docHtml :: Maybe DocComment -> DocM Html
docHtml :: Maybe DocComment
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
docHtml (Just (DocComment FilePath
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
. FilePath -> Text
T.pack
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SrcLoc -> FilePath -> DocM FilePath
identifierLinks SrcLoc
loc FilePath
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 -> FilePath -> DocM FilePath
identifierLinks SrcLoc
_ [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
identifierLinks SrcLoc
loc FilePath
s
  | Just ((FilePath
name, FilePath
namespace, Maybe FilePath
file), FilePath
s') <- FilePath -> Maybe ((FilePath, FilePath, Maybe FilePath), FilePath)
identifierReference FilePath
s = do
      let proceed :: FilePath -> DocM FilePath
proceed FilePath
x = (FilePath
x <>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SrcLoc -> FilePath -> DocM FilePath
identifierLinks SrcLoc
loc FilePath
s'
          unknown :: DocM FilePath
unknown = FilePath -> DocM FilePath
proceed forall a b. (a -> b) -> a -> b
$ FilePath
"`" forall a. Semigroup a => a -> a -> a
<> FilePath
name forall a. Semigroup a => a -> a -> a
<> FilePath
"`"
      case forall {a}. (Eq a, IsString a) => a -> Maybe Namespace
knownNamespace FilePath
namespace of
        Just Namespace
namespace' -> do
          Maybe VName
maybe_v <- (Namespace, FilePath, Maybe FilePath) -> DocM (Maybe VName)
lookupName (Namespace
namespace', FilePath
name, Maybe FilePath
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 => FilePath -> a
fromString FilePath
name
                  forall a. Semigroup a => a -> a -> a
<> Doc ()
"' not found in namespace '"
                  forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => FilePath -> a
fromString FilePath
namespace
                  forall a. Semigroup a => a -> a -> a
<> Doc ()
"'"
                  forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => FilePath -> a
fromString (forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" (FilePath
" in file " <>) Maybe FilePath
file)
                  forall a. Semigroup a => a -> a -> a
<> Doc ()
"."
              DocM FilePath
unknown
            Just VName
v' -> do
              FilePath
link <- VName -> DocM FilePath
vnameLink VName
v'
              FilePath -> DocM FilePath
proceed forall a b. (a -> b) -> a -> b
$ FilePath
"[`" forall a. Semigroup a => a -> a -> a
<> FilePath
name forall a. Semigroup a => a -> a -> a
<> FilePath
"`](" forall a. Semigroup a => a -> a -> a
<> FilePath
link forall a. Semigroup a => a -> a -> a
<> FilePath
")"
        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 => FilePath -> a
fromString FilePath
namespace forall a. Semigroup a => a -> a -> a
<> Doc ()
"'."
          DocM FilePath
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 : FilePath
s') = (Char
c :) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SrcLoc -> FilePath -> DocM FilePath
identifierLinks SrcLoc
loc FilePath
s'

lookupName :: (Namespace, String, Maybe FilePath) -> DocM (Maybe VName)
lookupName :: (Namespace, FilePath, Maybe FilePath) -> DocM (Maybe VName)
lookupName (Namespace
namespace, FilePath
name, Maybe FilePath
file) = do
  FilePath
current <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Context -> FilePath
ctxCurrent
  let file' :: Maybe FilePath
file' = ImportName -> FilePath
includeToString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip (ImportName -> FilePath -> SrcLoc -> ImportName
mkImportFrom (FilePath -> ImportName
mkInitialImport FilePath
current)) forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath
file
  Maybe Env
env <- Maybe FilePath -> DocM (Maybe Env)
lookupEnvForFile Maybe FilePath
file'
  case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Namespace
namespace, FilePath -> Name
nameFromString FilePath
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 FilePath -> DocM (Maybe Env)
lookupEnvForFile :: Maybe FilePath -> DocM (Maybe Env)
lookupEnvForFile Maybe FilePath
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 FilePath
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 FilePath
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
$ FilePath -> Html
keyword FilePath
"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
$ FilePath -> Html
keyword FilePath
"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
$ FilePath -> Html
keyword FilePath
"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]
valBindParams ValBindBase Info VName
vb),
    RetType [VName]
_ StructType
t <- forall a. Info a -> a
unInfo forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) vn. ValBindBase f vn -> f StructRetType
valBindRetType ValBindBase Info VName
vb,
    forall dim as. TypeBase dim as -> Bool
orderZero StructType
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 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 VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp VName
t
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath -> Html
keyword FilePath
"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 VName
t of
        TEArrow {} -> IndexWhat
IndexFunction
        TypeExp 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
$ FilePath -> Html
keyword FilePath
"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
$ FilePath -> Html
keyword FilePath
"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
<> FilePath -> Html
keyword FilePath
"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