{-# LANGUAGE OverloadedStrings #-}

-- | The core logic of @futhark doc@.
module Futhark.Doc.Generator (renderFiles) where

import qualified CMarkGFM 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 qualified Data.Map as M
import Data.Maybe
import Data.Ord
import qualified Data.Set as S
import Data.String (fromString)
import qualified Data.Text as T
import Data.Version
import Futhark.Util.Pretty (Doc, ppr)
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 qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import Prelude hiding (abs)

docToHtml :: Doc -> Html
docToHtml :: Doc -> Html
docToHtml = String -> Html
forall a. ToMarkup a => a -> Html
toHtml (String -> Html) -> (Doc -> String) -> Doc -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
forall a. Pretty a => a -> String
pretty

primTypeHtml :: PrimType -> Html
primTypeHtml :: PrimType -> Html
primTypeHtml = Doc -> Html
docToHtml (Doc -> Html) -> (PrimType -> Doc) -> PrimType -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimType -> Doc
forall a. Pretty a => a -> Doc
ppr

prettyU :: Uniqueness -> Html
prettyU :: Uniqueness -> Html
prettyU = Doc -> Html
docToHtml (Doc -> Html) -> (Uniqueness -> Doc) -> Uniqueness -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Uniqueness -> Doc
forall a. Pretty a => a -> Doc
ppr

renderName :: Name -> Html
renderName :: Name -> Html
renderName Name
name = Doc -> Html
docToHtml (Name -> Doc
forall a. Pretty a => a -> Doc
ppr Name
name)

joinBy :: Html -> [Html] -> Html
joinBy :: Html -> [Html] -> Html
joinBy Html
_ [] = Html
forall a. Monoid a => a
mempty
joinBy Html
_ [Html
x] = Html
x
joinBy Html
sep (Html
x : [Html]
xs) = Html
x Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> (Html -> Html) -> [Html] -> Html
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Html
sep Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<>) [Html]
xs

commas :: [Html] -> Html
commas :: [Html] -> Html
commas = Html -> [Html] -> Html
joinBy Html
", "

parens :: Html -> Html
parens :: Html -> Html
parens Html
x = Html
"(" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
x Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
")"

braces :: Html -> Html
braces :: Html -> Html
braces Html
x = Html
"{" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
x Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
"}"

brackets :: Html -> Html
brackets :: Html -> Html
brackets Html
x = Html
"[" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
x Html -> Html -> Html
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 -> String
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 (String, Namespace)

type DocM = ReaderT Context (WriterT Documented (Writer Warnings))

data IndexWhat = IndexValue | IxFun | 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 = WriterT Documented (Writer Warnings) () -> DocM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT Documented (Writer Warnings) () -> DocM ())
-> WriterT Documented (Writer Warnings) () -> DocM ()
forall a b. (a -> b) -> a -> b
$ Writer Warnings () -> WriterT Documented (Writer Warnings) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Writer Warnings () -> WriterT Documented (Writer Warnings) ())
-> Writer Warnings () -> WriterT Documented (Writer Warnings) ()
forall a b. (a -> b) -> a -> b
$ Warnings -> Writer Warnings ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Warnings -> Writer Warnings ()) -> Warnings -> Writer Warnings ()
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 = Documented -> DocM ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Documented -> DocM ()) -> Documented -> DocM ()
forall a b. (a -> b) -> a -> b
$ VName -> IndexWhat -> Documented
forall k a. k -> a -> Map k a
M.singleton VName
v IndexWhat
what

noLink :: [VName] -> DocM a -> DocM a
noLink :: [VName] -> DocM a -> DocM a
noLink [VName]
names = (Context -> Context) -> DocM a -> DocM a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((Context -> Context) -> DocM a -> DocM a)
-> (Context -> Context) -> DocM a -> DocM a
forall a b. (a -> b) -> a -> b
$ \Context
ctx ->
  Context
ctx {ctxNoLink :: NoLink
ctxNoLink = [VName] -> NoLink
forall a. Ord a => [a] -> Set a
S.fromList [VName]
names NoLink -> NoLink -> NoLink
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 (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
s (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (AttributeValue
"#" AttributeValue -> AttributeValue -> AttributeValue
forall a. Semigroup a => a -> a -> a
<> AttributeValue
s) (Html -> Html) -> Attribute -> Html -> Html
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 (Html -> Html) -> (Html -> Html) -> Html -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Html -> Html
H.td (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.colspan AttributeValue
"3")

emptyRow :: Html
emptyRow :: Html
emptyRow = Html -> Html
H.tr (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.td Html
forall a. Monoid a => a
mempty Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html -> Html
H.td Html
forall a. Monoid a => a
mempty Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html -> Html
H.td Html
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 (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
    (Html -> Html
H.td (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"spec_lhs") Html
a
      Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> (Html -> Html
H.td (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"spec_eql") Html
b
      Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> (Html -> Html
H.td (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"spec_rhs") Html
c

vnameToFileMap :: Imports -> FileMap
vnameToFileMap :: Imports -> FileMap
vnameToFileMap = [FileMap] -> FileMap
forall a. Monoid a => [a] -> a
mconcat ([FileMap] -> FileMap)
-> (Imports -> [FileMap]) -> Imports -> FileMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, FileModule) -> FileMap) -> Imports -> [FileMap]
forall a b. (a -> b) -> [a] -> [b]
map (String, FileModule) -> FileMap
forall a. (a, FileModule) -> Map VName (a, Namespace)
forFile
  where
    forFile :: (a, FileModule) -> Map VName (a, Namespace)
forFile (a
file, FileModule TySet
abs Env
file_env Prog
_prog) =
      [Map VName (a, Namespace)] -> Map VName (a, Namespace)
forall a. Monoid a => [a] -> a
mconcat ((QualName VName -> Map VName (a, Namespace))
-> [QualName VName] -> [Map VName (a, Namespace)]
forall a b. (a -> b) -> [a] -> [b]
map (Namespace -> QualName VName -> Map VName (a, Namespace)
forall b k. b -> QualName k -> Map k (a, b)
vname Namespace
Type) (TySet -> [QualName VName]
forall k a. Map k a -> [k]
M.keys TySet
abs))
        Map VName (a, Namespace)
-> Map VName (a, Namespace) -> Map VName (a, Namespace)
forall a. Semigroup a => a -> a -> a
<> Env -> Map VName (a, Namespace)
forEnv Env
file_env
      where
        vname :: b -> QualName k -> Map k (a, b)
vname b
ns QualName k
v = k -> (a, b) -> Map k (a, b)
forall k a. k -> a -> Map k a
M.singleton (QualName k -> k
forall vn. QualName vn -> vn
qualLeaf QualName k
v) (a
file, b
ns)
        vname' :: ((b, b), QualName k) -> Map k (a, b)
vname' ((b
ns, b
_), QualName k
v) = b -> QualName k -> Map k (a, b)
forall b k. b -> QualName k -> Map k (a, b)
vname b
ns QualName k
v

        forEnv :: Env -> Map VName (a, Namespace)
forEnv Env
env =
          [Map VName (a, Namespace)] -> Map VName (a, Namespace)
forall a. Monoid a => [a] -> a
mconcat ((((Namespace, Name), QualName VName) -> Map VName (a, Namespace))
-> [((Namespace, Name), QualName VName)]
-> [Map VName (a, Namespace)]
forall a b. (a -> b) -> [a] -> [b]
map ((Namespace, Name), QualName VName) -> Map VName (a, Namespace)
forall b b k. ((b, b), QualName k) -> Map k (a, b)
vname' ([((Namespace, Name), QualName VName)]
 -> [Map VName (a, Namespace)])
-> [((Namespace, Name), QualName VName)]
-> [Map VName (a, Namespace)]
forall a b. (a -> b) -> a -> b
$ Map (Namespace, Name) (QualName VName)
-> [((Namespace, Name), QualName VName)]
forall k a. Map k a -> [(k, a)]
M.toList (Map (Namespace, Name) (QualName VName)
 -> [((Namespace, Name), QualName VName)])
-> Map (Namespace, Name) (QualName VName)
-> [((Namespace, Name), QualName VName)]
forall a b. (a -> b) -> a -> b
$ Env -> Map (Namespace, Name) (QualName VName)
envNameMap Env
env)
            Map VName (a, Namespace)
-> Map VName (a, Namespace) -> Map VName (a, Namespace)
forall a. Semigroup a => a -> a -> a
<> [Map VName (a, Namespace)] -> Map VName (a, Namespace)
forall a. Monoid a => [a] -> a
mconcat ((MTy -> Map VName (a, Namespace))
-> [MTy] -> [Map VName (a, Namespace)]
forall a b. (a -> b) -> [a] -> [b]
map MTy -> Map VName (a, Namespace)
forMty ([MTy] -> [Map VName (a, Namespace)])
-> [MTy] -> [Map VName (a, Namespace)]
forall a b. (a -> b) -> a -> b
$ Map VName MTy -> [MTy]
forall k a. Map k a -> [a]
M.elems (Map VName MTy -> [MTy]) -> Map VName MTy -> [MTy]
forall a b. (a -> b) -> a -> b
$ Env -> Map VName MTy
envSigTable Env
env)
        forMod :: Mod -> Map VName (a, Namespace)
forMod (ModEnv Env
env) = Env -> Map VName (a, Namespace)
forEnv Env
env
        forMod ModFun {} = Map VName (a, Namespace)
forall a. Monoid a => a
mempty
        forMty :: MTy -> Map VName (a, Namespace)
forMty = Mod -> Map VName (a, Namespace)
forMod (Mod -> Map VName (a, Namespace))
-> (MTy -> Mod) -> MTy -> Map VName (a, Namespace)
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 :: [String] -> Imports -> ([(String, Html)], Warnings)
renderFiles [String]
important_imports Imports
imports = Writer Warnings [(String, Html)] -> ([(String, Html)], Warnings)
forall w a. Writer w a -> (a, w)
runWriter (Writer Warnings [(String, Html)] -> ([(String, Html)], Warnings))
-> Writer Warnings [(String, Html)] -> ([(String, Html)], Warnings)
forall a b. (a -> b) -> a -> b
$ do
  ([(String, (Html, Html))]
import_pages, Documented
documented) <- WriterT Documented (Writer Warnings) [(String, (Html, Html))]
-> Writer Warnings ([(String, (Html, Html))], Documented)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT Documented (Writer Warnings) [(String, (Html, Html))]
 -> Writer Warnings ([(String, (Html, Html))], Documented))
-> WriterT Documented (Writer Warnings) [(String, (Html, Html))]
-> Writer Warnings ([(String, (Html, Html))], Documented)
forall a b. (a -> b) -> a -> b
$
    Imports
-> ((String, FileModule)
    -> WriterT Documented (Writer Warnings) (String, (Html, Html)))
-> WriterT Documented (Writer Warnings) [(String, (Html, Html))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Imports
imports (((String, FileModule)
  -> WriterT Documented (Writer Warnings) (String, (Html, Html)))
 -> WriterT Documented (Writer Warnings) [(String, (Html, Html))])
-> ((String, FileModule)
    -> WriterT Documented (Writer Warnings) (String, (Html, Html)))
-> WriterT Documented (Writer Warnings) [(String, (Html, Html))]
forall a b. (a -> b) -> a -> b
$ \(String
current, FileModule
fm) ->
      let ctx :: Context
ctx =
            String
-> FileModule -> Imports -> NoLink -> FileMap -> NoLink -> Context
Context
              String
current
              FileModule
fm
              Imports
imports
              NoLink
forall a. Monoid a => a
mempty
              FileMap
file_map
              (Prog -> NoLink
forall vn (f :: * -> *). Ord vn => ProgBase f vn -> Set vn
progModuleTypes (Prog -> NoLink) -> Prog -> NoLink
forall a b. (a -> b) -> a -> b
$ FileModule -> Prog
fileProg FileModule
fm)
       in (ReaderT
   Context
   (WriterT Documented (Writer Warnings))
   (String, (Html, Html))
 -> Context
 -> WriterT Documented (Writer Warnings) (String, (Html, Html)))
-> Context
-> ReaderT
     Context
     (WriterT Documented (Writer Warnings))
     (String, (Html, Html))
-> WriterT Documented (Writer Warnings) (String, (Html, Html))
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
  Context
  (WriterT Documented (Writer Warnings))
  (String, (Html, Html))
-> Context
-> WriterT Documented (Writer Warnings) (String, (Html, Html))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Context
ctx (ReaderT
   Context
   (WriterT Documented (Writer Warnings))
   (String, (Html, Html))
 -> WriterT Documented (Writer Warnings) (String, (Html, Html)))
-> ReaderT
     Context
     (WriterT Documented (Writer Warnings))
     (String, (Html, Html))
-> WriterT Documented (Writer Warnings) (String, (Html, Html))
forall a b. (a -> b) -> a -> b
$ do
            (Html
first_paragraph, Html
maybe_abstract, Html
maybe_sections) <- Prog -> DocM (Html, Html, Html)
headerDoc (Prog -> DocM (Html, Html, Html))
-> Prog -> DocM (Html, Html, Html)
forall a b. (a -> b) -> a -> b
$ FileModule -> Prog
fileProg FileModule
fm

            Html
synopsis <- (Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"module") (Html -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Dec]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
synopsisDecs (Prog -> [Dec]
forall (f :: * -> *) vn. ProgBase f vn -> [DecBase f vn]
progDecs (Prog -> [Dec]) -> Prog -> [Dec]
forall a b. (a -> b) -> a -> b
$ FileModule -> Prog
fileProg FileModule
fm)

            Html
description <- [Dec]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
describeDecs ([Dec]
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> [Dec]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ Prog -> [Dec]
forall (f :: * -> *) vn. ProgBase f vn -> [DecBase f vn]
progDecs (Prog -> [Dec]) -> Prog -> [Dec]
forall a b. (a -> b) -> a -> b
$ FileModule -> Prog
fileProg FileModule
fm

            (String, (Html, Html))
-> ReaderT
     Context
     (WriterT Documented (Writer Warnings))
     (String, (Html, Html))
forall (m :: * -> *) a. Monad m => a -> m a
return
              ( String
current,
                ( Html -> Html
H.docTypeHtml (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.lang AttributeValue
"en" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
                    [String] -> Imports -> String -> String -> Html -> Html
addBoilerplateWithNav [String]
important_imports Imports
imports (String
"doc" String -> String -> String
</> String
current) String
current (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
                      Html -> Html
H.main (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
                        Html
maybe_abstract
                          Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> AttributeValue -> Html -> Html
selfLink AttributeValue
"synopsis" (Html -> Html
H.h2 Html
"Synopsis")
                          Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> (Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"overview") Html
synopsis
                          Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> AttributeValue -> Html -> Html
selfLink AttributeValue
"description" (Html -> Html
H.h2 Html
"Description")
                          Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
description
                          Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
maybe_sections,
                  Html
first_paragraph
                )
              )

  [(String, Html)] -> Writer Warnings [(String, Html)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, Html)] -> Writer Warnings [(String, Html)])
-> [(String, Html)] -> Writer Warnings [(String, Html)]
forall a b. (a -> b) -> a -> b
$
    [ (String
"index.html", [String] -> [(String, Html)] -> Html
contentsPage [String]
important_imports ([(String, Html)] -> Html) -> [(String, Html)] -> Html
forall a b. (a -> b) -> a -> b
$ ((String, (Html, Html)) -> (String, Html))
-> [(String, (Html, Html))] -> [(String, Html)]
forall a b. (a -> b) -> [a] -> [b]
map (((Html, Html) -> Html) -> (String, (Html, Html)) -> (String, Html)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Html, Html) -> Html
forall a b. (a, b) -> b
snd) [(String, (Html, Html))]
import_pages),
      (String
"doc-index.html", [String] -> Imports -> Documented -> FileMap -> Html
indexPage [String]
important_imports Imports
imports Documented
documented FileMap
file_map)
    ]
      [(String, Html)] -> [(String, Html)] -> [(String, Html)]
forall a. [a] -> [a] -> [a]
++ ((String, (Html, Html)) -> (String, Html))
-> [(String, (Html, Html))] -> [(String, Html)]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
importHtml (String -> String)
-> ((Html, Html) -> Html)
-> (String, (Html, Html))
-> (String, Html)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (Html, Html) -> Html
forall a b. (a, b) -> a
fst) [(String, (Html, Html))]
import_pages
  where
    file_map :: FileMap
file_map = Imports -> FileMap
vnameToFileMap Imports
imports
    importHtml :: String -> String
importHtml String
import_name = String
"doc" String -> String -> String
</> String
import_name String -> String -> String
<.> String
"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 Prog -> Maybe DocComment
forall (f :: * -> *) vn. ProgBase f vn -> Maybe DocComment
progDoc Prog
prog of
    Just (DocComment String
doc SrcLoc
loc) -> do
      let (String
abstract, String
more_sections) = String -> (String, String)
splitHeaderDoc String
doc
      Html
first_paragraph <- Maybe DocComment
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
docHtml (Maybe DocComment
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Maybe DocComment
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ DocComment -> Maybe DocComment
forall a. a -> Maybe a
Just (DocComment -> Maybe DocComment) -> DocComment -> Maybe DocComment
forall a b. (a -> b) -> a -> b
$ String -> SrcLoc -> DocComment
DocComment (String -> String
firstParagraph String
abstract) SrcLoc
loc
      Html
abstract' <- Maybe DocComment
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
docHtml (Maybe DocComment
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Maybe DocComment
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ DocComment -> Maybe DocComment
forall a. a -> Maybe a
Just (DocComment -> Maybe DocComment) -> DocComment -> Maybe DocComment
forall a b. (a -> b) -> a -> b
$ String -> SrcLoc -> DocComment
DocComment String
abstract SrcLoc
loc
      Html
more_sections' <- Maybe DocComment
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
docHtml (Maybe DocComment
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Maybe DocComment
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ DocComment -> Maybe DocComment
forall a. a -> Maybe a
Just (DocComment -> Maybe DocComment) -> DocComment -> Maybe DocComment
forall a b. (a -> b) -> a -> b
$ String -> SrcLoc -> DocComment
DocComment String
more_sections SrcLoc
loc
      (Html, Html, Html) -> DocM (Html, Html, Html)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( Html
first_paragraph,
          AttributeValue -> Html -> Html
selfLink AttributeValue
"abstract" (Html -> Html
H.h2 Html
"Abstract") Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
abstract',
          Html
more_sections'
        )
    Maybe DocComment
_ -> (Html, Html, Html) -> DocM (Html, Html, Html)
forall (m :: * -> *) a. Monad m => a -> m a
return (Html, Html, Html)
forall a. Monoid a => a
mempty
  where
    splitHeaderDoc :: String -> (String, String)
splitHeaderDoc String
s =
      (String, String) -> Maybe (String, String) -> (String, String)
forall a. a -> Maybe a -> a
fromMaybe (String
s, String
forall a. Monoid a => a
mempty) (Maybe (String, String) -> (String, String))
-> Maybe (String, String) -> (String, String)
forall a b. (a -> b) -> a -> b
$
        ((String, String) -> Bool)
-> [(String, String)] -> Maybe (String, String)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((String
"\n##" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) (String -> Bool)
-> ((String, String) -> String) -> (String, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> b
snd) ([(String, String)] -> Maybe (String, String))
-> [(String, String)] -> Maybe (String, String)
forall a b. (a -> b) -> a -> b
$
          [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (String -> [String]
forall a. [a] -> [[a]]
inits String
s) (String -> [String]
forall a. [a] -> [[a]]
tails String
s)
    firstParagraph :: String -> String
firstParagraph = [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
paragraphSeparator) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
    paragraphSeparator :: String -> Bool
paragraphSeparator = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace

contentsPage :: [FilePath] -> [(String, Html)] -> Html
contentsPage :: [String] -> [(String, Html)] -> Html
contentsPage [String]
important_imports [(String, Html)]
pages =
  Html -> Html
H.docTypeHtml (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
    String -> String -> Html -> Html
addBoilerplate String
"index.html" String
"Futhark Library Documentation" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
      Html -> Html
H.main (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
        Html -> Html
H.h2 Html
"Main libraries"
          Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> [(String, Html)] -> Html
fileList [(String, Html)]
important_pages
          Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> if [(String, Html)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, Html)]
unimportant_pages
            then Html
forall a. Monoid a => a
mempty
            else
              Html -> Html
H.h2 Html
"Supporting libraries"
                Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> [(String, Html)] -> Html
fileList [(String, Html)]
unimportant_pages
  where
    ([(String, Html)]
important_pages, [(String, Html)]
unimportant_pages) =
      ((String, Html) -> Bool)
-> [(String, Html)] -> ([(String, Html)], [(String, Html)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
important_imports) (String -> Bool)
-> ((String, Html) -> String) -> (String, Html) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Html) -> String
forall a b. (a, b) -> a
fst) [(String, Html)]
pages

    fileList :: [(String, Html)] -> Html
fileList [(String, Html)]
pages' =
      Html -> Html
H.dl (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"file_list" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
        [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ ((String, Html) -> Html) -> [(String, Html)] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (String, Html) -> Html
linkTo ([(String, Html)] -> [Html]) -> [(String, Html)] -> [Html]
forall a b. (a -> b) -> a -> b
$ ((String, Html) -> String) -> [(String, Html)] -> [(String, Html)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (String, Html) -> String
forall a b. (a, b) -> a
fst [(String, Html)]
pages'

    linkTo :: (String, Html) -> Html
linkTo (String
name, Html
maybe_abstract) =
      Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"file_desc" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
        (Html -> Html
H.dt (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"desc_header") (String -> String -> Html
importLink String
"index.html" String
name)
          Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> (Html -> Html
H.dd (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"desc_doc") Html
maybe_abstract

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

indexPage :: [FilePath] -> Imports -> Documented -> FileMap -> Html
indexPage :: [String] -> Imports -> Documented -> FileMap -> Html
indexPage [String]
important_imports Imports
imports Documented
documented FileMap
fm =
  Html -> Html
H.docTypeHtml (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
    [String] -> Imports -> String -> String -> Html -> Html
addBoilerplateWithNav [String]
important_imports Imports
imports String
"doc-index.html" String
"Index" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
      Html -> Html
H.main (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
        ( Html -> Html
H.ul (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"doc_index_list" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
            [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$
              (String -> Html) -> [String] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map String -> Html
initialListEntry ([String] -> [Html]) -> [String] -> [Html]
forall a b. (a -> b) -> a -> b
$
                [String]
letter_group_links [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
symbol_group_link]
        )
          Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> ( Html -> Html
H.table (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"doc_index" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
                 Html -> Html
H.thead (Html -> Html
H.tr (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.td Html
"Who" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html -> Html
H.td Html
"What" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html -> Html
H.td Html
"Where")
                   Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html]
letter_groups [Html] -> [Html] -> [Html]
forall a. [a] -> [a] -> [a]
++ [Html
symbol_group])
             )
  where
    ([(VName, (String, IndexWhat))]
letter_names, [(VName, (String, IndexWhat))]
sym_names) =
      ((VName, (String, IndexWhat)) -> Bool)
-> [(VName, (String, IndexWhat))]
-> ([(VName, (String, IndexWhat))], [(VName, (String, IndexWhat))])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (String -> Bool
isLetterName (String -> Bool)
-> ((VName, (String, IndexWhat)) -> String)
-> (VName, (String, IndexWhat))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VName -> String
baseString (VName -> String)
-> ((VName, (String, IndexWhat)) -> VName)
-> (VName, (String, IndexWhat))
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VName, (String, IndexWhat)) -> VName
forall a b. (a, b) -> a
fst) ([(VName, (String, IndexWhat))]
 -> ([(VName, (String, IndexWhat))],
     [(VName, (String, IndexWhat))]))
-> [(VName, (String, IndexWhat))]
-> ([(VName, (String, IndexWhat))], [(VName, (String, IndexWhat))])
forall a b. (a -> b) -> a -> b
$
        ((VName, (String, IndexWhat)) -> String)
-> [(VName, (String, IndexWhat))] -> [(VName, (String, IndexWhat))]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (String -> String)
-> ((VName, (String, IndexWhat)) -> String)
-> (VName, (String, IndexWhat))
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VName -> String
baseString (VName -> String)
-> ((VName, (String, IndexWhat)) -> VName)
-> (VName, (String, IndexWhat))
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VName, (String, IndexWhat)) -> VName
forall a b. (a, b) -> a
fst) ([(VName, (String, IndexWhat))] -> [(VName, (String, IndexWhat))])
-> [(VName, (String, IndexWhat))] -> [(VName, (String, IndexWhat))]
forall a b. (a -> b) -> a -> b
$
          ((VName, (String, Namespace))
 -> Maybe (VName, (String, IndexWhat)))
-> [(VName, (String, Namespace))] -> [(VName, (String, IndexWhat))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (VName, (String, Namespace)) -> Maybe (VName, (String, IndexWhat))
forall a b. (VName, (a, b)) -> Maybe (VName, (a, IndexWhat))
isDocumented ([(VName, (String, Namespace))] -> [(VName, (String, IndexWhat))])
-> [(VName, (String, Namespace))] -> [(VName, (String, IndexWhat))]
forall a b. (a -> b) -> a -> b
$ FileMap -> [(VName, (String, Namespace))]
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 <- VName -> Documented -> Maybe IndexWhat
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VName
k Documented
documented
      (VName, (a, IndexWhat)) -> Maybe (VName, (a, IndexWhat))
forall a. a -> Maybe a
Just (VName
k, (a
file, IndexWhat
what))

    ([Html]
letter_groups, [String]
letter_group_links) =
      [(Html, String)] -> ([Html], [String])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Html, String)] -> ([Html], [String]))
-> [(Html, String)] -> ([Html], [String])
forall a b. (a -> b) -> a -> b
$ ([(VName, (String, IndexWhat))] -> (Html, String))
-> [[(VName, (String, IndexWhat))]] -> [(Html, String)]
forall a b. (a -> b) -> [a] -> [b]
map [(VName, (String, IndexWhat))] -> (Html, String)
tbodyForNames ([[(VName, (String, IndexWhat))]] -> [(Html, String)])
-> [[(VName, (String, IndexWhat))]] -> [(Html, String)]
forall a b. (a -> b) -> a -> b
$ ((VName, (String, IndexWhat))
 -> (VName, (String, IndexWhat)) -> Bool)
-> [(VName, (String, IndexWhat))]
-> [[(VName, (String, IndexWhat))]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (VName, (String, IndexWhat))
-> (VName, (String, IndexWhat)) -> Bool
forall b b. (VName, b) -> (VName, b) -> Bool
sameInitial [(VName, (String, IndexWhat))]
letter_names
    (Html
symbol_group, String
symbol_group_link) =
      String -> [(VName, (String, IndexWhat))] -> (Html, String)
tbodyForInitial String
"Symbols" [(VName, (String, IndexWhat))]
sym_names

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

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

    tbodyForNames :: [(VName, (String, IndexWhat))] -> (Html, String)
tbodyForNames names :: [(VName, (String, IndexWhat))]
names@((VName
s, (String, IndexWhat)
_) : [(VName, (String, IndexWhat))]
_) =
      String -> [(VName, (String, IndexWhat))] -> (Html, String)
tbodyForInitial ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ VName -> String
baseString VName
s) [(VName, (String, IndexWhat))]
names
    tbodyForNames [(VName, (String, IndexWhat))]
_ = (Html, String)
forall a. Monoid a => a
mempty

    tbodyForInitial :: String -> [(VName, (String, IndexWhat))] -> (Html, String)
tbodyForInitial String
initial [(VName, (String, IndexWhat))]
names =
      ( Html -> Html
H.tbody (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ Html
initial' Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: ((VName, (String, IndexWhat)) -> Html)
-> [(VName, (String, IndexWhat))] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (VName, (String, IndexWhat)) -> Html
linkTo [(VName, (String, IndexWhat))]
names,
        String
initial
      )
      where
        initial' :: Html
initial' =
          Html -> Html
H.tr (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
            Html -> Html
H.td (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.colspan AttributeValue
"2" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"doc_index_initial" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
              Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (String -> AttributeValue
forall a. IsString a => String -> a
fromString String
initial)
                (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue) -> String -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Char
'#' Char -> String -> String
forall a. a -> [a] -> [a]
: String
initial)
                (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. IsString a => String -> a
fromString String
initial

    initialListEntry :: String -> Html
initialListEntry String
initial =
      Html -> Html
H.li (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue) -> String -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Char
'#' Char -> String -> String
forall a. a -> [a] -> [a]
: String
initial) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. IsString a => String -> a
fromString String
initial

    linkTo :: (VName, (String, IndexWhat)) -> Html
linkTo (VName
name, (String
file, IndexWhat
what)) =
      let link :: Html
link =
            (Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> String -> String
makeRelative String
"/" (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"doc" String -> String -> String
</> VName -> String -> String -> String
vnameLink' VName
name String
"" String
file))) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
              String -> Html
forall a. IsString a => String -> a
fromString (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$ VName -> String
baseString VName
name
          what' :: Html
what' = case IndexWhat
what of
            IndexWhat
IndexValue -> Html
"value"
            IndexWhat
IxFun -> Html
"function"
            IndexWhat
IndexType -> Html
"type"
            IndexWhat
IndexModuleType -> Html
"module type"
            IndexWhat
IndexModule -> Html
"module"
          html_file :: String
html_file = String -> String -> String
makeRelative String
"/" (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"doc" String -> String -> String
</> String
file String -> String -> String
-<.> String
"html"
       in Html -> Html
H.tr (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
            (Html -> Html
H.td (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"doc_index_name" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
link)
              Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> (Html -> Html
H.td (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"doc_index_namespace" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
what')
              Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> ( Html -> Html
H.td (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"doc_index_file" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
                     (Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (String -> AttributeValue
forall a. IsString a => String -> a
fromString String
html_file) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. IsString a => String -> a
fromString String
file)
                 )

addBoilerplate :: String -> String -> Html -> Html
addBoilerplate :: String -> String -> Html -> Html
addBoilerplate String
current String
titleText Html
content =
  let headHtml :: Html
headHtml =
        Html -> Html
H.head (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
          Html
H.meta
            Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.charset AttributeValue
"utf-8"
              Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html -> Html
H.title (String -> Html
forall a. IsString a => String -> a
fromString String
titleText)
              Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
H.link
            Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue) -> String -> AttributeValue
forall a b. (a -> b) -> a -> b
$ String -> String -> String
relativise String
"style.css" String
current)
            Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.rel AttributeValue
"stylesheet"
            Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.type_ AttributeValue
"text/css"

      navigation :: Html
navigation =
        Html -> Html
H.ul (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"navigation" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
          Html -> Html
H.li (Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue) -> String -> AttributeValue
forall a b. (a -> b) -> a -> b
$ String -> String -> String
relativise String
"index.html" String
current) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
"Contents")
            Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html -> Html
H.li (Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue) -> String -> AttributeValue
forall a b. (a -> b) -> a -> b
$ String -> String -> String
relativise String
"doc-index.html" String
current) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
"Index")

      madeByHtml :: Html
madeByHtml =
        Html
"Generated by " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> (Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href AttributeValue
futhark_doc_url) Html
"futhark-doc"
          Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
" "
          Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> String -> Html
forall a. IsString a => String -> a
fromString (Version -> String
showVersion Version
version)
   in Html
headHtml
        Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html -> Html
H.body
          ( (Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"header") (Html -> Html
H.h1 (String -> Html
forall a. ToMarkup a => a -> Html
toHtml String
titleText) Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
navigation)
              Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> (Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"content") Html
content
              Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> (Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
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 :: [String] -> Imports -> String -> String -> Html -> Html
addBoilerplateWithNav [String]
important_imports Imports
imports String
current String
titleText Html
content =
  String -> String -> Html -> Html
addBoilerplate String
current String
titleText (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
    (Html -> Html
H.nav (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"filenav" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
files) Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
content
  where
    files :: Html
files = Html -> Html
H.ul (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ (String -> Html) -> [String] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map String -> Html
pp ([String] -> [Html]) -> [String] -> [Html]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
visible [String]
important_imports
    pp :: String -> Html
pp String
name = Html -> Html
H.li (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> String -> Html
importLink String
current String
name
    visible :: String -> Bool
visible = (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((String, FileModule) -> String) -> Imports -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, FileModule) -> String
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 <- (Context -> NoLink)
-> ReaderT Context (WriterT Documented (Writer Warnings)) NoLink
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Context -> NoLink
ctxVisibleMTys
  FileModule
fm <- (Context -> FileModule)
-> ReaderT
     Context (WriterT Documented (Writer Warnings)) FileModule
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 (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"specs") (Html -> Html) -> ([Html] -> Html) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Html
emptyRow Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<>) (Html -> Html) -> ([Html] -> Html) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat
    ([Html] -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ReaderT Context (WriterT Documented (Writer Warnings)) Html]
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ((Dec
 -> Maybe
      (ReaderT Context (WriterT Documented (Writer Warnings)) Html))
-> [Dec]
-> [ReaderT Context (WriterT Documented (Writer Warnings)) Html]
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 Html
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 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a. a -> Maybe a
Just (ReaderT Context (WriterT Documented (Writer Warnings)) Html
 -> Maybe
      (ReaderT Context (WriterT Documented (Writer Warnings)) Html))
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a b. (a -> b) -> a -> b
$ do
      Html
opened' <- ReaderT Context (WriterT Documented (Writer Warnings)) Html
opened
      Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
fullRow (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
keyword String
"open " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
opened'
    | Bool
otherwise ->
      ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a. a -> Maybe a
Just (ReaderT Context (WriterT Documented (Writer Warnings)) Html
 -> Maybe
      (ReaderT Context (WriterT Documented (Writer Warnings)) Html))
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a b. (a -> b) -> a -> b
$
        Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$
          Html -> Html
fullRow (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
            String -> Html
keyword String
"open" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> String -> Html
forall a. IsString a => String -> a
fromString (String
" <" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ModExpBase Info VName -> String
forall a. Pretty a => a -> String
pretty ModExpBase Info VName
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
">")
  LocalDec (SigDec SigBindBase Info VName
s) SrcLoc
_
    | SigBindBase Info VName -> VName
forall (f :: * -> *) vn. SigBindBase f vn -> vn
sigName SigBindBase Info VName
s VName -> NoLink -> Bool
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 (String -> Html
keyword String
"local" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
" ") SigBindBase Info VName
s
  LocalDec {} -> Maybe (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a. Maybe a
Nothing
  ImportDec {} -> Maybe (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
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
_) = ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a. a -> Maybe a
Just (ReaderT Context (WriterT Documented (Writer Warnings)) Html
 -> Maybe
      (ReaderT Context (WriterT Documented (Writer Warnings)) Html))
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
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
  ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a. a -> Maybe a
Just (ReaderT Context (WriterT Documented (Writer Warnings)) Html
 -> Maybe
      (ReaderT Context (WriterT Documented (Writer Warnings)) Html))
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a b. (a -> b) -> a -> b
$ Html -> Html
parens (Html -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT Context (WriterT Documented (Writer Warnings)) Html
me'
synopsisOpened (ModImport String
_ (Info String
file) SrcLoc
_) = ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a. a -> Maybe a
Just (ReaderT Context (WriterT Documented (Writer Warnings)) Html
 -> Maybe
      (ReaderT Context (WriterT Documented (Writer Warnings)) Html))
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a b. (a -> b) -> a -> b
$ do
  String
current <- (Context -> String)
-> ReaderT Context (WriterT Documented (Writer Warnings)) String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Context -> String
ctxCurrent
  let dest :: AttributeValue
dest = String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue) -> String -> AttributeValue
forall a b. (a -> b) -> a -> b
$ String -> String -> String
relativise String
file String
current String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".html"
  Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ String -> Html
keyword String
"import " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> (Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href AttributeValue
dest) (String -> Html
forall a. IsString a => String -> a
fromString (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
file)
synopsisOpened (ModAscript ModExpBase Info VName
_ SigExpBase Info VName
se Info (Map VName VName)
_ SrcLoc
_) = ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a. a -> Maybe a
Just (ReaderT Context (WriterT Documented (Writer Warnings)) Html
 -> Maybe
      (ReaderT Context (WriterT Documented (Writer Warnings)) Html))
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
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
  Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ Html
"... : " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
se'
synopsisOpened ModExpBase Info VName
_ = Maybe (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
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 = ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a. a -> Maybe a
Just (ReaderT Context (WriterT Documented (Writer Warnings)) Html
 -> Maybe
      (ReaderT Context (WriterT Documented (Writer Warnings)) Html))
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a b. (a -> b) -> a -> b
$ do
  let name' :: Html
name' = VName -> Html
vnameSynopsisDef (VName -> Html) -> VName -> Html
forall a b. (a -> b) -> a -> b
$ ValBindBase Info VName -> VName
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
  Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ Html -> Html -> Html -> Html
specRow Html
lhs (Html
mhs Html -> Html -> Html
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' = [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ (TypeParamBase VName -> Html) -> [TypeParamBase VName] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map ((Html
" " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<>) (Html -> Html)
-> (TypeParamBase VName -> Html) -> TypeParamBase VName -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeParamBase VName -> Html
typeParamHtml) [TypeParamBase VName]
tparams
      noLink' :: DocM a -> DocM a
noLink' =
        [VName] -> DocM a -> DocM a
forall a. [VName] -> DocM a -> DocM a
noLink ([VName] -> DocM a -> DocM a) -> [VName] -> DocM a -> DocM a
forall a b. (a -> b) -> a -> b
$
          (TypeParamBase VName -> VName) -> [TypeParamBase VName] -> [VName]
forall a b. (a -> b) -> [a] -> [b]
map TypeParamBase VName -> VName
forall vn. TypeParamBase vn -> vn
typeParamName [TypeParamBase VName]
tparams
            [VName] -> [VName] -> [VName]
forall a. [a] -> [a] -> [a]
++ (IdentBase Info VName -> VName)
-> [IdentBase Info VName] -> [VName]
forall a b. (a -> b) -> [a] -> [b]
map IdentBase Info VName -> VName
forall (f :: * -> *) vn. IdentBase f vn -> vn
identName (Set (IdentBase Info VName) -> [IdentBase Info VName]
forall a. Set a -> [a]
S.toList (Set (IdentBase Info VName) -> [IdentBase Info VName])
-> Set (IdentBase Info VName) -> [IdentBase Info VName]
forall a b. (a -> b) -> a -> b
$ [Set (IdentBase Info VName)] -> Set (IdentBase Info VName)
forall a. Monoid a => [a] -> a
mconcat ([Set (IdentBase Info VName)] -> Set (IdentBase Info VName))
-> [Set (IdentBase Info VName)] -> Set (IdentBase Info VName)
forall a b. (a -> b) -> a -> b
$ (PatBase Info VName -> Set (IdentBase Info VName))
-> [PatBase Info VName] -> [Set (IdentBase Info VName)]
forall a b. (a -> b) -> [a] -> [b]
map PatBase Info VName -> Set (IdentBase Info VName)
forall (f :: * -> *) vn.
(Functor f, Ord vn) =>
PatBase f vn -> Set (IdentBase f vn)
patIdents [PatBase Info VName]
params)
  Html
rettype' <- ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a. DocM a -> DocM a
noLink' (ReaderT Context (WriterT Documented (Writer Warnings)) Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> (TypeExp VName
    -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Maybe (TypeExp VName)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
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' <- ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
forall a. DocM a -> DocM a
noLink' (ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
 -> ReaderT Context (WriterT Documented (Writer Warnings)) [Html])
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
forall a b. (a -> b) -> a -> b
$ (PatBase Info VName
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> [PatBase Info VName]
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
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
  (Html, Html, Html) -> DocM (Html, Html, Html)
forall (m :: * -> *) a. Monad m => a -> m a
return
    ( String -> Html
keyword String
"val " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> (Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"decl_name") Html
name,
      Html
tparams',
      [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat (Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
intersperse Html
" -> " ([Html] -> [Html]) -> [Html] -> [Html]
forall a b. (a -> b) -> a -> b
$ [Html]
params' [Html] -> [Html] -> [Html]
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 = ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a. a -> Maybe a
Just (ReaderT Context (WriterT Documented (Writer Warnings)) Html
 -> Maybe
      (ReaderT Context (WriterT Documented (Writer Warnings)) Html))
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a b. (a -> b) -> a -> b
$ do
  let name' :: Html
name' = VName -> Html
vnameSynopsisDef (VName -> Html) -> VName -> Html
forall a b. (a -> b) -> a -> b
$ SigBindBase Info VName -> VName
forall (f :: * -> *) vn. SigBindBase f vn -> vn
sigName SigBindBase Info VName
sb
  Html -> Html
fullRow (Html -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
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 (SigExpBase Info VName
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> SigExpBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ SigBindBase Info VName -> SigExpBase Info VName
forall (f :: * -> *) vn. SigBindBase f vn -> SigExpBase f vn
sigExp SigBindBase Info VName
sb
    Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ Html
prefix Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> String -> Html
keyword String
"module type " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
name' Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
" = " Html -> Html -> 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 (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> (Mod
    -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Mod
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
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) (Mod
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Maybe Mod
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VName -> Map VName Mod -> Maybe Mod
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)
_) -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a. a -> Maybe a
Just (ReaderT Context (WriterT Documented (Writer Warnings)) Html
 -> Maybe
      (ReaderT Context (WriterT Documented (Writer Warnings)) Html))
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a b. (a -> b) -> a -> b
$ Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
proceed (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
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
      Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ Html -> Html -> Html -> Html
specRow (String -> Html
keyword String
"module " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
name') Html
": " (Html
ps' Html -> Html -> Html
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 = ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a. a -> Maybe a
Just (ReaderT Context (WriterT Documented (Writer Warnings)) Html
 -> Maybe
      (ReaderT Context (WriterT Documented (Writer Warnings)) Html))
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a b. (a -> b) -> a -> b
$ do
  let name' :: Html
name' = VName -> Html
vnameSynopsisDef (VName -> Html) -> VName -> Html
forall a b. (a -> b) -> a -> b
$ TypeBindBase Info VName -> VName
forall (f :: * -> *) vn. TypeBindBase f vn -> vn
typeAlias TypeBindBase Info VName
tb
  Html -> Html
fullRow (Html -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
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' <- [VName]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a. [VName] -> DocM a -> DocM a
noLink ((TypeParamBase VName -> VName) -> [TypeParamBase VName] -> [VName]
forall a b. (a -> b) -> [a] -> [b]
map TypeParamBase VName -> VName
forall vn. TypeParamBase vn -> vn
typeParamName [TypeParamBase VName]
tparams) (ReaderT Context (WriterT Documented (Writer Warnings)) Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ TypeExp VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp VName
t
  Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ Liftedness -> Html -> [TypeParamBase VName] -> Html
typeAbbrevHtml Liftedness
l Html
name' [TypeParamBase VName]
tparams Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
" = " Html -> Html -> 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 Map (Namespace, Name) (QualName VName)
_) = do
  [Html]
typeBinds <- ((VName, TypeBinding)
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> [(VName, TypeBinding)]
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
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 (Map VName TypeBinding -> [(VName, TypeBinding)]
forall k a. Map k a -> [(k, a)]
M.toList Map VName TypeBinding
ttable)
  [Html]
valBinds <- ((VName, BoundV)
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> [(VName, BoundV)]
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
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 (Map VName BoundV -> [(VName, BoundV)]
forall k a. Map k a -> [(k, a)]
M.toList Map VName BoundV
vtable)
  [Html]
sigBinds <- ((VName, MTy)
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> [(VName, MTy)]
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
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 (Map VName MTy -> [(VName, MTy)]
forall k a. Map k a -> [(k, a)]
M.toList Map VName MTy
sigtable)
  [Html]
modBinds <- ((VName, Mod)
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> [(VName, Mod)]
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
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 (Map VName Mod -> [(VName, Mod)]
forall k a. Map k a -> [(k, a)]
M.toList Map VName Mod
modtable)
  Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
braces (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ [Html]
typeBinds [Html] -> [Html] -> [Html]
forall a. [a] -> [a] -> [a]
++ [Html]
valBinds [Html] -> [Html] -> [Html]
forall a. [a] -> [a] -> [a]
++ [Html]
sigBinds [Html] -> [Html] -> [Html]
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) =
  (String -> Html
keyword String
"module type " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<>) (Html -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualName VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
qualNameHtml (VName -> QualName VName
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) =
  (String -> Html
keyword String
"module " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<>) (Html -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualName VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
qualNameHtml (VName -> QualName VName
forall v. v -> QualName v
qualName VName
name)

renderValBind :: (VName, BoundV) -> DocM Html
renderValBind :: (VName, BoundV)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
renderValBind = (Html -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Html -> Html
H.div (ReaderT Context (WriterT Documented (Writer Warnings)) Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> ((VName, BoundV)
    -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> (VName, BoundV)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
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
  Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.div (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Liftedness -> Html -> [TypeParamBase VName] -> Html
typeAbbrevHtml Liftedness
l (VName -> Html
vnameHtml VName
name) [TypeParamBase VName]
tps Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
" = " Html -> Html -> 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' = (TypeParamBase VName -> Html) -> [TypeParamBase VName] -> [Html]
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
  Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$
    String -> Html
keyword String
"val " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> VName -> Html
vnameHtml VName
name
      Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ((Html -> Html) -> [Html] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Html
" " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<>) [Html]
tps')
      Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
": "
      Html -> Html -> 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 ScalarTypeBase (DimDecl VName) ()
et ShapeDecl (DimDecl VName)
shape -> do
    Html
shape' <- ShapeDecl (DimDecl VName)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
prettyShapeDecl ShapeDecl (DimDecl VName)
shape
    Html
et' <- StructType
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeHtml (StructType
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> StructType
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ ScalarTypeBase (DimDecl VName) () -> StructType
forall dim as. ScalarTypeBase dim as -> TypeBase dim as
Scalar ScalarTypeBase (DimDecl VName) ()
et
    Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ Uniqueness -> Html
prettyU Uniqueness
u Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
shape' Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
et'
  Scalar (Prim PrimType
et) -> Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ PrimType -> Html
primTypeHtml PrimType
et
  Scalar (Record Map Name StructType
fs)
    | Just [StructType]
ts <- Map Name StructType -> Maybe [StructType]
forall a. Map Name a -> Maybe [a]
areTupleFields Map Name StructType
fs ->
      Html -> Html
parens (Html -> Html) -> ([Html] -> Html) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> Html
commas ([Html] -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StructType
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> [StructType]
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
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 (Html -> Html) -> ([Html] -> Html) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> Html
commas ([Html] -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Name, StructType)
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> [(Name, StructType)]
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
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 (Map Name StructType -> [(Name, StructType)]
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
        Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. ToMarkup a => a -> Html
toHtml (Name -> String
nameToString Name
name) Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
": " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
tp'
  Scalar (TypeVar ()
_ Uniqueness
u TypeName
et [TypeArg (DimDecl VName)]
targs) -> do
    [Html]
targs' <- (TypeArg (DimDecl VName)
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> [TypeArg (DimDecl VName)]
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TypeArg (DimDecl VName)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeArgHtml [TypeArg (DimDecl VName)]
targs
    Html
et' <- TypeName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeNameHtml TypeName
et
    Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ Uniqueness -> Html
prettyU Uniqueness
u Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
et' Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ((Html -> Html) -> [Html] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Html
" " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<>) [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
    Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ case PName
pname of
      Named VName
v ->
        Html -> Html
parens (VName -> Html
vnameHtml VName
v Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
": " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
t1') Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
" -> " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
t2'
      PName
Unnamed ->
        Html
t1' Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
" -> " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
t2'
  Scalar (Sum Map Name [StructType]
cs) -> [Html] -> Html
pipes ([Html] -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Name, [StructType])
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> [(Name, [StructType])]
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
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 (Map Name [StructType] -> [(Name, [StructType])]
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
" " ([Html] -> Html) -> ([Html] -> [Html]) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Html
ppConstr Name
n Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
:) ([Html] -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StructType
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> [StructType]
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
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
"#" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> String -> Html
forall a. ToMarkup a => a -> Html
toHtml (Name -> String
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
  Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ Html
"?" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ((VName -> Html) -> [VName] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Html -> Html
brackets (Html -> Html) -> (VName -> Html) -> VName -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VName -> Html
vnameHtml) [VName]
dims) Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
"." Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
t'

prettyShapeDecl :: ShapeDecl (DimDecl VName) -> DocM Html
prettyShapeDecl :: ShapeDecl (DimDecl VName)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
prettyShapeDecl (ShapeDecl [DimDecl VName]
ds) =
  [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DimDecl VName
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> [DimDecl VName]
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Html -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Html -> Html
brackets (ReaderT Context (WriterT Documented (Writer Warnings)) Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> (DimDecl VName
    -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> DimDecl VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DimDecl VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
dimDeclHtml) [DimDecl VName]
ds

typeArgHtml :: TypeArg (DimDecl VName) -> DocM Html
typeArgHtml :: TypeArg (DimDecl VName)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeArgHtml (TypeArgDim DimDecl VName
d SrcLoc
_) = Html -> Html
brackets (Html -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DimDecl VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
dimDeclHtml DimDecl VName
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 [] = Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return Html
forall a. Monoid a => a
mempty
modParamHtml (ModParam VName
pname SigExpBase Info VName
psig Info [VName]
_ SrcLoc
_ : [ModParamBase Info VName]
mps) =
  (Html -> Html -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
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
"(" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> VName -> Html
vnameHtml VName
pname
        Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
": "
        Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
se
        Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
") -> "
        Html -> Html -> 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 (Html -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) 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
e'
  SigSpecs [SpecBase Info VName]
ss SrcLoc
_ -> Html -> Html
braces (Html -> Html) -> ([Html] -> Html) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Html -> Html
H.table (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"specs") (Html -> Html) -> ([Html] -> Html) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SpecBase Info VName
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> [SpecBase Info VName]
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
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 TypeDeclBase Info VName
t SrcLoc
_) SrcLoc
_ -> do
    Html
s' <- SigExpBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
synopsisSigExp SigExpBase Info VName
s
    Html
t' <- TypeDeclBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *).
TypeDeclBase f VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeDeclHtml TypeDeclBase Info VName
t
    Html
v' <- QualName VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
qualNameHtml QualName VName
v
    let ps' :: Html
ps' = [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ (TypeParamBase VName -> Html) -> [TypeParamBase VName] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map ((Html
" " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<>) (Html -> Html)
-> (TypeParamBase VName -> Html) -> TypeParamBase VName -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeParamBase VName -> Html
typeParamHtml) [TypeParamBase VName]
ps
    Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ Html
s' Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> String -> Html
keyword String
" with " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
v' Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
ps' Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
" = " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
t'
  SigArrow Maybe VName
Nothing SigExpBase Info VName
e1 SigExpBase Info VName
e2 SrcLoc
_ ->
    (Html -> Html -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Html -> Html -> Html
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' a -> a -> a
forall a. Semigroup a => a -> a -> 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' <- [VName]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a. [VName] -> DocM a -> DocM a
noLink [VName
v] (ReaderT Context (WriterT Documented (Writer Warnings)) Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ SigExpBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
synopsisSigExp SigExpBase Info VName
e2
      Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ Html
"(" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
name Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
": " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
e1' Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
") -> " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
e2'

keyword :: String -> Html
keyword :: String -> Html
keyword = (Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"keyword") (Html -> Html) -> (String -> Html) -> String -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Html
forall a. IsString a => String -> a
fromString

vnameHtml :: VName -> Html
vnameHtml :: VName -> Html
vnameHtml (VName Name
name Int
tag) =
  Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (String -> AttributeValue
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
tag)) (Html -> Html) -> Html -> Html
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
  Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (String -> AttributeValue
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show (VName -> Int
baseTag VName
v))) (Html -> Html) -> Html -> Html
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 (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (String -> AttributeValue
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
tag String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s")) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
    Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String
"#" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
tag)) (Html -> Html) -> Html -> Html
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 (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"synopsis_link"
    (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String
"#" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (VName -> Int
baseTag VName
v) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s"))
    (Html -> Html) -> Html -> Html
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 (Html -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
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 (VName -> Html) -> VName -> Html
forall a b. (a -> b) -> a -> b
$ TypeBindBase Info VName -> VName
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
_ ->
    Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
fullRow (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
keyword String
l' Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> VName -> Html
vnameSynopsisDef VName
name Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ((TypeParamBase VName -> Html) -> [TypeParamBase VName] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map ((Html
" " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<>) (Html -> Html)
-> (TypeParamBase VName -> Html) -> TypeParamBase VName -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeParamBase VName -> Html
typeParamHtml) [TypeParamBase VName]
ps)
    where
      l' :: String
l' = case Liftedness
l of
        Liftedness
Unlifted -> String
"type "
        Liftedness
SizeLifted -> String
"type~ "
        Liftedness
Lifted -> String
"type^ "
  ValSpec VName
name [TypeParamBase VName]
tparams TypeDeclBase Info VName
rettype Maybe DocComment
_ SrcLoc
_ -> do
    let tparams' :: [Html]
tparams' = (TypeParamBase VName -> Html) -> [TypeParamBase VName] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map TypeParamBase VName -> Html
typeParamHtml [TypeParamBase VName]
tparams
    Html
rettype' <-
      [VName]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a. [VName] -> DocM a -> DocM a
noLink ((TypeParamBase VName -> VName) -> [TypeParamBase VName] -> [VName]
forall a b. (a -> b) -> [a] -> [b]
map TypeParamBase VName -> VName
forall vn. TypeParamBase vn -> vn
typeParamName [TypeParamBase VName]
tparams) (ReaderT Context (WriterT Documented (Writer Warnings)) Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$
        TypeDeclBase Info VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *).
TypeDeclBase f VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeDeclHtml TypeDeclBase Info VName
rettype
    Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$
      Html -> Html -> Html -> Html
specRow
        (String -> Html
keyword String
"val " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> VName -> Html
vnameSynopsisDef VName
name)
        ([Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ((Html -> Html) -> [Html] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Html
" " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<>) [Html]
tparams') Html -> Html -> Html
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 (String -> Html
keyword String
"module " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> VName -> Html
vnameSynopsisDef VName
name) Html
": " (Html -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) 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 (Html -> Html) -> (Html -> Html) -> Html -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Html
keyword String
"include " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<>) (Html -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) 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
e

typeDeclHtml :: TypeDeclBase f VName -> DocM Html
typeDeclHtml :: TypeDeclBase f VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeDeclHtml = TypeExp VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml (TypeExp VName
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> (TypeDeclBase f VName -> TypeExp VName)
-> TypeDeclBase f VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDeclBase f VName -> TypeExp VName
forall (f :: * -> *) vn. TypeDeclBase f vn -> TypeExp vn
declaredType

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
"*" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<>) (Html -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) 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 TypeExp VName
at DimExp VName
d SrcLoc
_ -> do
    Html
at' <- TypeExp VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml TypeExp VName
at
    Html
d' <- DimExp VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
dimExpHtml DimExp VName
d
    Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
brackets Html
d' Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
at'
  TETuple [TypeExp VName]
ts SrcLoc
_ -> Html -> Html
parens (Html -> Html) -> ([Html] -> Html) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> Html
commas ([Html] -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TypeExp VName
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> [TypeExp VName]
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
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 (Html -> Html) -> ([Html] -> Html) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> Html
commas ([Html] -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Name, TypeExp VName)
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> [(Name, TypeExp VName)]
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
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
        Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. ToMarkup a => a -> Html
toHtml (Name -> String
nameToString Name
name) Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
": " Html -> Html -> 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
    Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ Html
t' Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
" " Html -> Html -> 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 (Html -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) 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
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
    Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ case Maybe VName
pname of
      Just VName
v ->
        Html -> Html
parens (VName -> Html
vnameHtml VName
v Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
": " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
t1') Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
" -> " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
t2'
      Maybe VName
Nothing ->
        Html
t1' Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
" -> " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
t2'
  TESum [(Name, [TypeExp VName])]
cs SrcLoc
_ -> [Html] -> Html
pipes ([Html] -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Name, [TypeExp VName])
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> [(Name, [TypeExp VName])]
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
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
" " ([Html] -> Html) -> ([Html] -> [Html]) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Html
ppConstr Name
n Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
:) ([Html] -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TypeExp VName
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> [TypeExp VName]
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
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
"#" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> String -> Html
forall a. ToMarkup a => a -> Html
toHtml (Name -> String
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
    Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ Html
"?" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ((VName -> Html) -> [VName] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Html -> Html
brackets (Html -> Html) -> (VName -> Html) -> VName -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Html
renderName (Name -> Html) -> (VName -> Name) -> VName -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VName -> Name
baseName) [VName]
dims) Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
"." Html -> Html -> 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxIntrinsicTag
    then Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ Name -> Html
renderName Name
name
    else Maybe String -> Html
f (Maybe String -> Html)
-> ReaderT
     Context (WriterT Documented (Writer Warnings)) (Maybe String)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  Context (WriterT Documented (Writer Warnings)) (Maybe String)
ref
  where
    prefix :: Html
    prefix :: Html
prefix = (VName -> Html) -> [VName] -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
".") (Html -> Html) -> (VName -> Html) -> VName -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Html
renderName (Name -> Html) -> (VName -> Name) -> VName -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VName -> Name
baseName) [VName]
names
    f :: Maybe String -> Html
f (Just String
s) = Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (String -> AttributeValue
forall a. IsString a => String -> a
fromString String
s) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
prefix Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Name -> Html
renderName Name
name
    f Maybe String
Nothing = Html
prefix Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Name -> Html
renderName Name
name

    ref :: ReaderT
  Context (WriterT Documented (Writer Warnings)) (Maybe String)
ref = do
      Bool
boring <- (Context -> Bool)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((Context -> Bool)
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Bool)
-> (Context -> Bool)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Bool
forall a b. (a -> b) -> a -> b
$ VName -> NoLink -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member VName
vname (NoLink -> Bool) -> (Context -> NoLink) -> Context -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> NoLink
ctxNoLink
      if Bool
boring
        then Maybe String
-> ReaderT
     Context (WriterT Documented (Writer Warnings)) (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
        else String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> ReaderT Context (WriterT Documented (Writer Warnings)) String
-> ReaderT
     Context (WriterT Documented (Writer Warnings)) (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) String
vnameLink VName
vname

vnameLink' :: VName -> String -> String -> String
vnameLink :: VName -> DocM String
vnameLink :: VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) String
vnameLink VName
vname = do
  String
current <- (Context -> String)
-> ReaderT Context (WriterT Documented (Writer Warnings)) String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Context -> String
ctxCurrent
  String
file <- (Context -> String)
-> ReaderT Context (WriterT Documented (Writer Warnings)) String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((Context -> String)
 -> ReaderT Context (WriterT Documented (Writer Warnings)) String)
-> (Context -> String)
-> ReaderT Context (WriterT Documented (Writer Warnings)) String
forall a b. (a -> b) -> a -> b
$ String
-> ((String, Namespace) -> String)
-> Maybe (String, Namespace)
-> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
current (String, Namespace) -> String
forall a b. (a, b) -> a
fst (Maybe (String, Namespace) -> String)
-> (Context -> Maybe (String, Namespace)) -> Context -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VName -> FileMap -> Maybe (String, Namespace)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VName
vname (FileMap -> Maybe (String, Namespace))
-> (Context -> FileMap) -> Context -> Maybe (String, Namespace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> FileMap
ctxFileMap
  String
-> ReaderT Context (WriterT Documented (Writer Warnings)) String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
 -> ReaderT Context (WriterT Documented (Writer Warnings)) String)
-> String
-> ReaderT Context (WriterT Documented (Writer Warnings)) String
forall a b. (a -> b) -> a -> b
$ VName -> String -> String -> String
vnameLink' VName
vname String
current String
file
vnameLink' :: VName -> String -> String -> String
vnameLink' (VName Name
_ Int
tag) String
current String
file =
  if String
file String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
current
    then String
"#" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
tag
    else String -> String -> String
relativise String
file String
current String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".html#" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
tag

typeNameHtml :: TypeName -> DocM Html
typeNameHtml :: TypeName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeNameHtml = QualName VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
qualNameHtml (QualName VName
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> (TypeName -> QualName VName)
-> TypeName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> QualName VName
qualNameFromTypeName

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
  Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ case PName
pat_param of
    Named VName
v -> Html -> Html
parens (VName -> Html
vnameHtml VName
v Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
": " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
t')
    PName
Unnamed -> Html
t'

relativise :: FilePath -> FilePath -> FilePath
relativise :: String -> String -> String
relativise String
dest String
src =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> [String]
splitPath String
src) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
"../") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dest

dimDeclHtml :: DimDecl VName -> DocM Html
dimDeclHtml :: DimDecl VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
dimDeclHtml (NamedDim QualName VName
v) = QualName VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
qualNameHtml QualName VName
v
dimDeclHtml (ConstDim Int
n) = Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. ToMarkup a => a -> Html
toHtml (Int -> String
forall a. Show a => a -> String
show Int
n)
dimDeclHtml AnyDim {} = Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *) a. Applicative f => a -> f a
pure Html
forall a. Monoid a => a
mempty

dimExpHtml :: DimExp VName -> DocM Html
dimExpHtml :: DimExp VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
dimExpHtml DimExp VName
DimExpAny = Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return Html
forall a. Monoid a => a
mempty
dimExpHtml (DimExpNamed QualName VName
v SrcLoc
_) = QualName VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
qualNameHtml QualName VName
v
dimExpHtml (DimExpConst Int
n SrcLoc
_) = Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. ToMarkup a => a -> Html
toHtml (Int -> String
forall a. Show a => a -> String
show Int
n)

typeArgExpHtml :: TypeArgExp VName -> DocM Html
typeArgExpHtml :: TypeArgExp VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeArgExpHtml (TypeArgExpDim DimExp VName
d SrcLoc
_) = DimExp VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
dimExpHtml DimExp 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 (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ VName -> Html
vnameHtml VName
name
typeParamHtml (TypeParamType Liftedness
l VName
name SrcLoc
_) =
  Html
"'" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> String -> Html
forall a. IsString a => String -> a
fromString (Liftedness -> String
forall a. Pretty a => a -> String
pretty Liftedness
l) Html -> Html -> Html
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 Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
name Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ((TypeParamBase VName -> Html) -> [TypeParamBase VName] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map ((Html
" " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<>) (Html -> Html)
-> (TypeParamBase VName -> Html) -> TypeParamBase VName -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeParamBase VName -> Html
typeParamHtml) [TypeParamBase VName]
params)
  where
    what :: Html
what = String -> Html
keyword (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$ String
"type" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Liftedness -> String
forall a. Pretty a => a -> String
pretty Liftedness
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "

docHtml :: Maybe DocComment -> DocM Html
docHtml :: Maybe DocComment
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
docHtml (Just (DocComment String
doc SrcLoc
loc)) =
  Text -> Html
H.preEscapedText
    (Text -> Html) -> (String -> Text) -> String -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CMarkOption] -> [CMarkExtension] -> Text -> Text
GFM.commonmarkToHtml [] [CMarkExtension
GFM.extAutolink]
    (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
    (String -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) String
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SrcLoc
-> String
-> ReaderT Context (WriterT Documented (Writer Warnings)) String
identifierLinks SrcLoc
loc String
doc
docHtml Maybe DocComment
Nothing = Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return Html
forall a. Monoid a => a
mempty

identifierLinks :: SrcLoc -> String -> DocM String
identifierLinks :: SrcLoc
-> String
-> ReaderT Context (WriterT Documented (Writer Warnings)) String
identifierLinks SrcLoc
_ [] = String
-> ReaderT Context (WriterT Documented (Writer Warnings)) String
forall (m :: * -> *) a. Monad m => a -> m a
return []
identifierLinks SrcLoc
loc String
s
  | Just ((String
name, String
namespace, Maybe String
file), String
s') <- String -> Maybe ((String, String, Maybe String), String)
identifierReference String
s = do
    let proceed :: String
-> ReaderT Context (WriterT Documented (Writer Warnings)) String
proceed String
x = (String
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (String -> String)
-> ReaderT Context (WriterT Documented (Writer Warnings)) String
-> ReaderT Context (WriterT Documented (Writer Warnings)) String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SrcLoc
-> String
-> ReaderT Context (WriterT Documented (Writer Warnings)) String
identifierLinks SrcLoc
loc String
s'
        unknown :: ReaderT Context (WriterT Documented (Writer Warnings)) String
unknown = String
-> ReaderT Context (WriterT Documented (Writer Warnings)) String
proceed (String
 -> ReaderT Context (WriterT Documented (Writer Warnings)) String)
-> String
-> ReaderT Context (WriterT Documented (Writer Warnings)) String
forall a b. (a -> b) -> a -> b
$ String
"`" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`"
    case String -> Maybe Namespace
forall a. (Eq a, IsString a) => a -> Maybe Namespace
knownNamespace String
namespace of
      Just Namespace
namespace' -> do
        Maybe VName
maybe_v <- (Namespace, String, Maybe String) -> DocM (Maybe VName)
lookupName (Namespace
namespace', String
name, Maybe String
file)
        case Maybe VName
maybe_v of
          Maybe VName
Nothing -> do
            SrcLoc -> Doc -> DocM ()
warn SrcLoc
loc (Doc -> DocM ()) -> Doc -> DocM ()
forall a b. (a -> b) -> a -> b
$
              Doc
"Identifier '" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
forall a. IsString a => String -> a
fromString String
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"' not found in namespace '"
                Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
forall a. IsString a => String -> a
fromString String
namespace
                Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"'"
                Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
forall a. IsString a => String -> a
fromString (String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String
" in file " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) Maybe String
file)
                Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"."
            ReaderT Context (WriterT Documented (Writer Warnings)) String
unknown
          Just VName
v' -> do
            String
link <- VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) String
vnameLink VName
v'
            String
-> ReaderT Context (WriterT Documented (Writer Warnings)) String
proceed (String
 -> ReaderT Context (WriterT Documented (Writer Warnings)) String)
-> String
-> ReaderT Context (WriterT Documented (Writer Warnings)) String
forall a b. (a -> b) -> a -> b
$ String
"[`" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`](" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
link String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
      Maybe Namespace
_ -> do
        SrcLoc -> Doc -> DocM ()
warn SrcLoc
loc (Doc -> DocM ()) -> Doc -> DocM ()
forall a b. (a -> b) -> a -> b
$ Doc
"Unknown namespace '" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
forall a. IsString a => String -> a
fromString String
namespace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"'."
        ReaderT Context (WriterT Documented (Writer Warnings)) String
unknown
  where
    knownNamespace :: a -> Maybe Namespace
knownNamespace a
"term" = Namespace -> Maybe Namespace
forall a. a -> Maybe a
Just Namespace
Term
    knownNamespace a
"mtype" = Namespace -> Maybe Namespace
forall a. a -> Maybe a
Just Namespace
Signature
    knownNamespace a
"type" = Namespace -> Maybe Namespace
forall a. a -> Maybe a
Just Namespace
Type
    knownNamespace a
_ = Maybe Namespace
forall a. Maybe a
Nothing
identifierLinks SrcLoc
loc (Char
c : String
s') = (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String)
-> ReaderT Context (WriterT Documented (Writer Warnings)) String
-> ReaderT Context (WriterT Documented (Writer Warnings)) String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SrcLoc
-> String
-> ReaderT Context (WriterT Documented (Writer Warnings)) String
identifierLinks SrcLoc
loc String
s'

lookupName :: (Namespace, String, Maybe FilePath) -> DocM (Maybe VName)
lookupName :: (Namespace, String, Maybe String) -> DocM (Maybe VName)
lookupName (Namespace
namespace, String
name, Maybe String
file) = do
  String
current <- (Context -> String)
-> ReaderT Context (WriterT Documented (Writer Warnings)) String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Context -> String
ctxCurrent
  let file' :: Maybe String
file' = ImportName -> String
includeToString (ImportName -> String)
-> (String -> ImportName) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> SrcLoc -> ImportName) -> SrcLoc -> String -> ImportName
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ImportName -> String -> SrcLoc -> ImportName
mkImportFrom (String -> ImportName
mkInitialImport String
current)) SrcLoc
forall a. Monoid a => a
mempty (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
file
  Maybe Env
env <- Maybe String -> DocM (Maybe Env)
lookupEnvForFile Maybe String
file'
  case (Namespace, Name)
-> Map (Namespace, Name) (QualName VName) -> Maybe (QualName VName)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Namespace
namespace, String -> Name
nameFromString String
name) (Map (Namespace, Name) (QualName VName) -> Maybe (QualName VName))
-> (Env -> Map (Namespace, Name) (QualName VName))
-> Env
-> Maybe (QualName VName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> Map (Namespace, Name) (QualName VName)
envNameMap (Env -> Maybe (QualName VName))
-> Maybe Env -> Maybe (QualName VName)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Env
env of
    Maybe (QualName VName)
Nothing -> Maybe VName -> DocM (Maybe VName)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe VName
forall a. Maybe a
Nothing
    Just QualName VName
qn -> Maybe VName -> DocM (Maybe VName)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe VName -> DocM (Maybe VName))
-> Maybe VName -> DocM (Maybe VName)
forall a b. (a -> b) -> a -> b
$ VName -> Maybe VName
forall a. a -> Maybe a
Just (VName -> Maybe VName) -> VName -> Maybe VName
forall a b. (a -> b) -> a -> b
$ QualName VName -> VName
forall vn. QualName vn -> vn
qualLeaf QualName VName
qn

lookupEnvForFile :: Maybe FilePath -> DocM (Maybe Env)
lookupEnvForFile :: Maybe String -> DocM (Maybe Env)
lookupEnvForFile Maybe String
Nothing = (Context -> Maybe Env) -> DocM (Maybe Env)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((Context -> Maybe Env) -> DocM (Maybe Env))
-> (Context -> Maybe Env) -> DocM (Maybe Env)
forall a b. (a -> b) -> a -> b
$ Env -> Maybe Env
forall a. a -> Maybe a
Just (Env -> Maybe Env) -> (Context -> Env) -> Context -> Maybe Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileModule -> Env
fileEnv (FileModule -> Env) -> (Context -> FileModule) -> Context -> Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> FileModule
ctxFileMod
lookupEnvForFile (Just String
file) = (Context -> Maybe Env) -> DocM (Maybe Env)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((Context -> Maybe Env) -> DocM (Maybe Env))
-> (Context -> Maybe Env) -> DocM (Maybe Env)
forall a b. (a -> b) -> a -> b
$ (FileModule -> Env) -> Maybe FileModule -> Maybe Env
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FileModule -> Env
fileEnv (Maybe FileModule -> Maybe Env)
-> (Context -> Maybe FileModule) -> Context -> Maybe Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Imports -> Maybe FileModule
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
file (Imports -> Maybe FileModule)
-> (Context -> Imports) -> Context -> Maybe FileModule
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 (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"decl_name" (Html -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
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 (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"desc_doc" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
doc'
      decl_header :: Html
decl_header =
        (Html -> Html
H.dt (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"desc_header") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
          VName -> Html
vnameSynopsisRef VName
name Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
decl_type
  Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ Html
decl_header Html -> Html -> Html
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 (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"decl_name" (Html -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
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
_ -> Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
(<>) (Html -> Html -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT
     Context (WriterT Documented (Writer Warnings)) (Html -> Html)
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 ReaderT
  Context (WriterT Documented (Writer Warnings)) (Html -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
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 (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"desc_doc" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
doc'
      decl_header :: Html
decl_header =
        (Html -> Html
H.dt (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"desc_header") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
          VName -> Html
vnameSynopsisRef VName
name Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
decl_type
  Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ Html
decl_header Html -> Html -> Html
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 <- (Context -> NoLink)
-> ReaderT Context (WriterT Documented (Writer Warnings)) NoLink
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Context -> NoLink
ctxVisibleMTys
  Html -> Html
H.dl (Html -> Html) -> ([Html] -> Html) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat
    ([Html] -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReaderT Context (WriterT Documented (Writer Warnings)) Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> [ReaderT Context (WriterT Documented (Writer Warnings)) Html]
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
      ((Html -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Html -> Html)
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> (Html -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"decl_description")
      ((Dec
 -> Maybe
      (ReaderT Context (WriterT Documented (Writer Warnings)) Html))
-> [Dec]
-> [ReaderT Context (WriterT Documented (Writer Warnings)) Html]
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) = ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a. a -> Maybe a
Just (ReaderT Context (WriterT Documented (Writer Warnings)) Html
 -> Maybe
      (ReaderT Context (WriterT Documented (Writer Warnings)) Html))
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
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 (ValBindBase Info VName -> VName
forall (f :: * -> *) vn. ValBindBase f vn -> vn
valBindName ValBindBase Info VName
vb) (ValBindBase Info VName -> IndexWhat
valBindWhat ValBindBase Info VName
vb) (ValBindBase Info VName -> Maybe DocComment
forall (f :: * -> *) vn. ValBindBase f vn -> Maybe DocComment
valBindDoc ValBindBase Info VName
vb) ((Html
  -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> (Html
    -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
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
    Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ Html
lhs Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
mhs Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
": " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
rhs
describeDec NoLink
_ (TypeDec TypeBindBase Info VName
vb) =
  ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a. a -> Maybe a
Just (ReaderT Context (WriterT Documented (Writer Warnings)) Html
 -> Maybe
      (ReaderT Context (WriterT Documented (Writer Warnings)) Html))
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
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 (TypeBindBase Info VName -> VName
forall (f :: * -> *) vn. TypeBindBase f vn -> vn
typeAlias TypeBindBase Info VName
vb) IndexWhat
IndexType (TypeBindBase Info VName -> Maybe DocComment
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
_)) = ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a. a -> Maybe a
Just (ReaderT Context (WriterT Documented (Writer Warnings)) Html
 -> Maybe
      (ReaderT Context (WriterT Documented (Writer Warnings)) Html))
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
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 ((Html
  -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> (Html
    -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ \Html
name' ->
    Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ String -> Html
keyword String
"module type " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
name'
describeDec NoLink
_ (ModDec ModBindBase Info VName
mb) = ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a. a -> Maybe a
Just (ReaderT Context (WriterT Documented (Writer Warnings)) Html
 -> Maybe
      (ReaderT Context (WriterT Documented (Writer Warnings)) Html))
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
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 (ModBindBase Info VName -> VName
forall (f :: * -> *) vn. ModBindBase f vn -> vn
modName ModBindBase Info VName
mb) IndexWhat
IndexModule (ModBindBase Info VName -> Maybe DocComment
forall (f :: * -> *) vn. ModBindBase f vn -> Maybe DocComment
modDoc ModBindBase Info VName
mb) ((Html
  -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> (Html
    -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ \Html
name' ->
    Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ String -> Html
keyword String
"module " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
name'
describeDec NoLink
_ OpenDec {} = Maybe (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a. Maybe a
Nothing
describeDec NoLink
visible (LocalDec (SigDec (SigBind VName
name SigExpBase Info VName
se Maybe DocComment
doc SrcLoc
_)) SrcLoc
_)
  | VName
name VName -> NoLink -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` NoLink
visible = ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a. a -> Maybe a
Just (ReaderT Context (WriterT Documented (Writer Warnings)) Html
 -> Maybe
      (ReaderT Context (WriterT Documented (Writer Warnings)) Html))
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> Maybe
     (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
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 ((Html
  -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> (Html
    -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ \Html
name' ->
      Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ String -> Html
keyword String
"local module type " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
name'
describeDec NoLink
_ LocalDec {} = Maybe (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a. Maybe a
Nothing
describeDec NoLink
_ ImportDec {} = Maybe (ReaderT Context (WriterT Documented (Writer Warnings)) Html)
forall a. Maybe a
Nothing

valBindWhat :: ValBind -> IndexWhat
valBindWhat :: ValBindBase Info VName -> IndexWhat
valBindWhat ValBindBase Info VName
vb
  | [PatBase Info VName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ValBindBase Info VName -> [PatBase Info VName]
forall (f :: * -> *) vn. ValBindBase f vn -> [PatBase f vn]
valBindParams ValBindBase Info VName
vb),
    RetType [VName]
_ StructType
t <- Info StructRetType -> StructRetType
forall a. Info a -> a
unInfo (Info StructRetType -> StructRetType)
-> Info StructRetType -> StructRetType
forall a b. (a -> b) -> a -> b
$ ValBindBase Info VName -> Info StructRetType
forall (f :: * -> *) vn. ValBindBase f vn -> f StructRetType
valBindRetType ValBindBase Info VName
vb,
    StructType -> Bool
forall dim as. TypeBase dim as -> Bool
orderZero StructType
t =
    IndexWhat
IndexValue
  | Bool
otherwise =
    IndexWhat
IxFun

describeSpecs :: [Spec] -> DocM Html
describeSpecs :: [SpecBase Info VName]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
describeSpecs [SpecBase Info VName]
specs =
  Html -> Html
H.dl (Html -> Html) -> ([Html] -> Html) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SpecBase Info VName
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> [SpecBase Info VName]
-> ReaderT Context (WriterT Documented (Writer Warnings)) [Html]
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 TypeDeclBase Info VName
t 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 ((Html
  -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> (Html
    -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ \Html
name' -> do
    let tparams' :: Html
tparams' = [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ (TypeParamBase VName -> Html) -> [TypeParamBase VName] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map ((Html
" " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<>) (Html -> Html)
-> (TypeParamBase VName -> Html) -> TypeParamBase VName -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeParamBase VName -> Html
typeParamHtml) [TypeParamBase VName]
tparams
    Html
t' <-
      [VName]
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a. [VName] -> DocM a -> DocM a
noLink ((TypeParamBase VName -> VName) -> [TypeParamBase VName] -> [VName]
forall a b. (a -> b) -> [a] -> [b]
map TypeParamBase VName -> VName
forall vn. TypeParamBase vn -> vn
typeParamName [TypeParamBase VName]
tparams) (ReaderT Context (WriterT Documented (Writer Warnings)) Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$
        TypeExp VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
typeExpHtml (TypeExp VName
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> TypeExp VName
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ TypeDeclBase Info VName -> TypeExp VName
forall (f :: * -> *) vn. TypeDeclBase f vn -> TypeExp vn
declaredType TypeDeclBase Info VName
t
    Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ String -> Html
keyword String
"val " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
name' Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
tparams' Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
": " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
t'
  where
    what :: IndexWhat
what =
      if StructType -> Bool
forall dim as. TypeBase dim as -> Bool
orderZero (Info StructType -> StructType
forall a. Info a -> a
unInfo (Info StructType -> StructType) -> Info StructType -> StructType
forall a b. (a -> b) -> a -> b
$ TypeDeclBase Info VName -> Info StructType
forall (f :: * -> *) vn. TypeDeclBase f vn -> f StructType
expandedType TypeDeclBase Info VName
t)
        then IndexWhat
IndexValue
        else IndexWhat
IxFun
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 (TypeBindBase Info VName -> VName
forall (f :: * -> *) vn. TypeBindBase f vn -> vn
typeAlias TypeBindBase Info VName
vb) IndexWhat
IndexType (TypeBindBase Info VName -> Maybe DocComment
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 ((Html
  -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> (Html
    -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$
    Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> (Html -> Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
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 ((Html
  -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> (Html
    -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ \Html
name' ->
    case SigExpBase Info VName
se of
      SigSpecs {} -> Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ String -> Html
keyword String
"module " Html -> Html -> Html
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
        Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ String -> Html
keyword String
"module " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
name' Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
": " Html -> Html -> 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 Maybe DocComment
forall a. Maybe a
Nothing
  let decl_header :: Html
decl_header =
        (Html -> Html
H.dt (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"desc_header") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
          (Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"synopsis_link") Html
forall a. Monoid a => a
mempty
            Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> String -> Html
keyword String
"include "
            Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
sig'
      decl_doc :: Html
decl_doc = Html -> Html
H.dd (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"desc_doc" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
doc'
  Html -> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
 -> ReaderT Context (WriterT Documented (Writer Warnings)) Html)
-> Html
-> ReaderT Context (WriterT Documented (Writer Warnings)) Html
forall a b. (a -> b) -> a -> b
$ Html
decl_header Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
decl_doc