module Language.PureScript.Docs.AsHtml (
HtmlOutput(..),
HtmlOutputModule(..),
HtmlRenderContext(..),
nullRenderContext,
packageAsHtml,
moduleAsHtml,
makeFragment,
renderMarkdown
) where
import Prelude
import Control.Category ((>>>))
import Control.Monad (unless)
import Data.Bifunctor (bimap)
import Data.Char (isUpper)
import Data.Either (isRight)
import Data.List.NonEmpty qualified as NE
import Data.Maybe (fromMaybe)
import Data.Foldable (for_)
import Data.String (fromString)
import Data.Text (Text)
import Data.Text qualified as T
import Text.Blaze.Html5 as H hiding (map)
import Text.Blaze.Html5.Attributes qualified as A
import Cheapskate qualified
import Language.PureScript qualified as P
import Language.PureScript.Docs.Types
import Language.PureScript.Docs.RenderedCode (Link(..), outputWith)
import Language.PureScript.Docs.Render qualified as Render
import Language.PureScript.CST qualified as CST
data HtmlOutput a = HtmlOutput
{ forall a. HtmlOutput a -> [(Maybe Char, a)]
htmlIndex :: [(Maybe Char, a)]
, forall a. HtmlOutput a -> [(ModuleName, HtmlOutputModule a)]
htmlModules :: [(P.ModuleName, HtmlOutputModule a)]
}
deriving (Int -> HtmlOutput a -> ShowS
forall a. Show a => Int -> HtmlOutput a -> ShowS
forall a. Show a => [HtmlOutput a] -> ShowS
forall a. Show a => HtmlOutput a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HtmlOutput a] -> ShowS
$cshowList :: forall a. Show a => [HtmlOutput a] -> ShowS
show :: HtmlOutput a -> String
$cshow :: forall a. Show a => HtmlOutput a -> String
showsPrec :: Int -> HtmlOutput a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> HtmlOutput a -> ShowS
Show, forall a b. a -> HtmlOutput b -> HtmlOutput a
forall a b. (a -> b) -> HtmlOutput a -> HtmlOutput b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> HtmlOutput b -> HtmlOutput a
$c<$ :: forall a b. a -> HtmlOutput b -> HtmlOutput a
fmap :: forall a b. (a -> b) -> HtmlOutput a -> HtmlOutput b
$cfmap :: forall a b. (a -> b) -> HtmlOutput a -> HtmlOutput b
Functor)
data HtmlOutputModule a = HtmlOutputModule
{ forall a. HtmlOutputModule a -> a
htmlOutputModuleLocals :: a
, forall a. HtmlOutputModule a -> [(InPackage ModuleName, a)]
htmlOutputModuleReExports :: [(InPackage P.ModuleName, a)]
}
deriving (Int -> HtmlOutputModule a -> ShowS
forall a. Show a => Int -> HtmlOutputModule a -> ShowS
forall a. Show a => [HtmlOutputModule a] -> ShowS
forall a. Show a => HtmlOutputModule a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HtmlOutputModule a] -> ShowS
$cshowList :: forall a. Show a => [HtmlOutputModule a] -> ShowS
show :: HtmlOutputModule a -> String
$cshow :: forall a. Show a => HtmlOutputModule a -> String
showsPrec :: Int -> HtmlOutputModule a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> HtmlOutputModule a -> ShowS
Show, forall a b. a -> HtmlOutputModule b -> HtmlOutputModule a
forall a b. (a -> b) -> HtmlOutputModule a -> HtmlOutputModule b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> HtmlOutputModule b -> HtmlOutputModule a
$c<$ :: forall a b. a -> HtmlOutputModule b -> HtmlOutputModule a
fmap :: forall a b. (a -> b) -> HtmlOutputModule a -> HtmlOutputModule b
$cfmap :: forall a b. (a -> b) -> HtmlOutputModule a -> HtmlOutputModule b
Functor)
data HtmlRenderContext = HtmlRenderContext
{ HtmlRenderContext
-> Namespace -> Text -> ContainingModule -> Maybe DocLink
buildDocLink :: Namespace -> Text -> ContainingModule -> Maybe DocLink
, HtmlRenderContext -> DocLink -> Text
renderDocLink :: DocLink -> Text
, HtmlRenderContext -> SourceSpan -> Maybe Text
renderSourceLink :: P.SourceSpan -> Maybe Text
}
nullRenderContext :: HtmlRenderContext
nullRenderContext :: HtmlRenderContext
nullRenderContext = HtmlRenderContext
{ buildDocLink :: Namespace -> Text -> ContainingModule -> Maybe DocLink
buildDocLink = forall a b. a -> b -> a
const (forall a b. a -> b -> a
const (forall a b. a -> b -> a
const forall a. Maybe a
Nothing))
, renderDocLink :: DocLink -> Text
renderDocLink = forall a b. a -> b -> a
const Text
""
, renderSourceLink :: SourceSpan -> Maybe Text
renderSourceLink = forall a b. a -> b -> a
const forall a. Maybe a
Nothing
}
packageAsHtml
:: (InPackage P.ModuleName -> Maybe HtmlRenderContext)
-> Package a
-> HtmlOutput Html
packageAsHtml :: forall a.
(InPackage ModuleName -> Maybe HtmlRenderContext)
-> Package a -> HtmlOutput Html
packageAsHtml InPackage ModuleName -> Maybe HtmlRenderContext
getHtmlCtx Package{a
[(PackageName, Version)]
[Module]
Maybe UTCTime
(GithubUser, GithubRepo)
Version
Map ModuleName PackageName
Text
PackageMeta
pkgCompilerVersion :: forall a. Package a -> Version
pkgUploader :: forall a. Package a -> a
pkgGithub :: forall a. Package a -> (GithubUser, GithubRepo)
pkgResolvedDependencies :: forall a. Package a -> [(PackageName, Version)]
pkgModuleMap :: forall a. Package a -> Map ModuleName PackageName
pkgModules :: forall a. Package a -> [Module]
pkgTagTime :: forall a. Package a -> Maybe UTCTime
pkgVersionTag :: forall a. Package a -> Text
pkgVersion :: forall a. Package a -> Version
pkgMeta :: forall a. Package a -> PackageMeta
pkgCompilerVersion :: Version
pkgUploader :: a
pkgGithub :: (GithubUser, GithubRepo)
pkgResolvedDependencies :: [(PackageName, Version)]
pkgModuleMap :: Map ModuleName PackageName
pkgModules :: [Module]
pkgTagTime :: Maybe UTCTime
pkgVersionTag :: Text
pkgVersion :: Version
pkgMeta :: PackageMeta
..} =
forall a.
[(Maybe Char, a)]
-> [(ModuleName, HtmlOutputModule a)] -> HtmlOutput a
HtmlOutput forall {a}. [a]
indexFile [(ModuleName, HtmlOutputModule Html)]
modules
where
indexFile :: [a]
indexFile = []
modules :: [(ModuleName, HtmlOutputModule Html)]
modules = (InPackage ModuleName -> Maybe HtmlRenderContext)
-> Module -> (ModuleName, HtmlOutputModule Html)
moduleAsHtml InPackage ModuleName -> Maybe HtmlRenderContext
getHtmlCtx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Module]
pkgModules
moduleAsHtml
:: (InPackage P.ModuleName -> Maybe HtmlRenderContext)
-> Module
-> (P.ModuleName, HtmlOutputModule Html)
moduleAsHtml :: (InPackage ModuleName -> Maybe HtmlRenderContext)
-> Module -> (ModuleName, HtmlOutputModule Html)
moduleAsHtml InPackage ModuleName -> Maybe HtmlRenderContext
getHtmlCtx Module{[(InPackage ModuleName, [Declaration])]
[Declaration]
Maybe Text
ModuleName
modReExports :: Module -> [(InPackage ModuleName, [Declaration])]
modDeclarations :: Module -> [Declaration]
modComments :: Module -> Maybe Text
modName :: Module -> ModuleName
modReExports :: [(InPackage ModuleName, [Declaration])]
modDeclarations :: [Declaration]
modComments :: Maybe Text
modName :: ModuleName
..} = (ModuleName
modName, forall a. a -> [(InPackage ModuleName, a)] -> HtmlOutputModule a
HtmlOutputModule Html
modHtml [(InPackage ModuleName, Html)]
reexports)
where
modHtml :: Html
modHtml = do
let r :: HtmlRenderContext
r = forall a. a -> Maybe a -> a
fromMaybe HtmlRenderContext
nullRenderContext forall a b. (a -> b) -> a -> b
$ InPackage ModuleName -> Maybe HtmlRenderContext
getHtmlCtx (forall a. a -> InPackage a
Local ModuleName
modName)
in do
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Text
modComments Text -> Html
renderMarkdown
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Declaration]
modDeclarations (HtmlRenderContext -> Declaration -> Html
declAsHtml HtmlRenderContext
r)
reexports :: [(InPackage ModuleName, Html)]
reexports =
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [(InPackage ModuleName, [Declaration])]
modReExports forall a b. (a -> b) -> a -> b
$ \(InPackage ModuleName
pkg, [Declaration]
decls) ->
let r :: HtmlRenderContext
r = forall a. a -> Maybe a -> a
fromMaybe HtmlRenderContext
nullRenderContext forall a b. (a -> b) -> a -> b
$ InPackage ModuleName -> Maybe HtmlRenderContext
getHtmlCtx InPackage ModuleName
pkg
in (InPackage ModuleName
pkg, forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (HtmlRenderContext -> Declaration -> Html
declAsHtml HtmlRenderContext
r) [Declaration]
decls)
declAsHtml :: HtmlRenderContext -> Declaration -> Html
declAsHtml :: HtmlRenderContext -> Declaration -> Html
declAsHtml HtmlRenderContext
r d :: Declaration
d@Declaration{[ChildDeclaration]
Maybe Text
Maybe SourceSpan
Maybe KindInfo
Text
DeclarationInfo
declKind :: Declaration -> Maybe KindInfo
declInfo :: Declaration -> DeclarationInfo
declChildren :: Declaration -> [ChildDeclaration]
declSourceSpan :: Declaration -> Maybe SourceSpan
declComments :: Declaration -> Maybe Text
declTitle :: Declaration -> Text
declKind :: Maybe KindInfo
declInfo :: DeclarationInfo
declChildren :: [ChildDeclaration]
declSourceSpan :: Maybe SourceSpan
declComments :: Maybe Text
declTitle :: Text
..} = do
let declFragment :: Text
declFragment = Namespace -> Text -> Text
makeFragment (DeclarationInfo -> Namespace
declInfoNamespace DeclarationInfo
declInfo) Text
declTitle
Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"decl" forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (Text -> AttributeValue
v (Int -> Text -> Text
T.drop Int
1 Text
declFragment)) forall a b. (a -> b) -> a -> b
$ do
Html -> Html
h3 forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"decl__title clearfix" forall a b. (a -> b) -> a -> b
$ do
Html -> Html
a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"decl__anchor" forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (Text -> AttributeValue
v Text
declFragment) forall a b. (a -> b) -> a -> b
$ Html
"#"
Html -> Html
H.span forall a b. (a -> b) -> a -> b
$ Text -> Html
text Text
declTitle
Text -> Html
text Text
" "
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe SourceSpan
declSourceSpan (HtmlRenderContext -> SourceSpan -> Html
linkToSource HtmlRenderContext
r)
Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"decl__body" forall a b. (a -> b) -> a -> b
$ do
case DeclarationInfo
declInfo of
AliasDeclaration Fixity
fixity FixityAlias
alias_ ->
Fixity -> FixityAlias -> Html
renderAlias Fixity
fixity FixityAlias
alias_
DeclarationInfo
_ -> do
Html -> Html
pre forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"decl__signature" forall a b. (a -> b) -> a -> b
$ do
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe KindInfo
declKind forall a b. (a -> b) -> a -> b
$ \KindInfo
kindInfo -> do
Html -> Html
code forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"decl__kind" forall a b. (a -> b) -> a -> b
$ do
HtmlRenderContext -> RenderedCode -> Html
codeAsHtml HtmlRenderContext
r (Text -> KindInfo -> RenderedCode
Render.renderKindSig Text
declTitle KindInfo
kindInfo)
Html -> Html
code forall a b. (a -> b) -> a -> b
$ HtmlRenderContext -> RenderedCode -> Html
codeAsHtml HtmlRenderContext
r (Declaration -> RenderedCode
Render.renderDeclaration Declaration
d)
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Text
declComments Text -> Html
renderMarkdown
let ([ChildDeclaration]
instances, [ChildDeclaration]
dctors, [ChildDeclaration]
members) = [ChildDeclaration]
-> ([ChildDeclaration], [ChildDeclaration], [ChildDeclaration])
partitionChildren [ChildDeclaration]
declChildren
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ChildDeclaration]
dctors) forall a b. (a -> b) -> a -> b
$ do
Html -> Html
h4 Html
"Constructors"
HtmlRenderContext -> [ChildDeclaration] -> Html
renderChildren HtmlRenderContext
r [ChildDeclaration]
dctors
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ChildDeclaration]
members) forall a b. (a -> b) -> a -> b
$ do
Html -> Html
h4 Html
"Members"
HtmlRenderContext -> [ChildDeclaration] -> Html
renderChildren HtmlRenderContext
r [ChildDeclaration]
members
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ChildDeclaration]
instances) forall a b. (a -> b) -> a -> b
$ do
Html -> Html
h4 Html
"Instances"
HtmlRenderContext -> [ChildDeclaration] -> Html
renderChildren HtmlRenderContext
r [ChildDeclaration]
instances
where
linkToSource :: HtmlRenderContext -> P.SourceSpan -> Html
linkToSource :: HtmlRenderContext -> SourceSpan -> Html
linkToSource HtmlRenderContext
ctx SourceSpan
srcspan =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) Text -> Html
go (HtmlRenderContext -> SourceSpan -> Maybe Text
renderSourceLink HtmlRenderContext
ctx SourceSpan
srcspan)
where
go :: Text -> Html
go Text
href =
Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"decl__source" forall a b. (a -> b) -> a -> b
$
Html -> Html
a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (Text -> AttributeValue
v Text
href) forall a b. (a -> b) -> a -> b
$ Text -> Html
text Text
"Source"
renderChildren :: HtmlRenderContext -> [ChildDeclaration] -> Html
renderChildren :: HtmlRenderContext -> [ChildDeclaration] -> Html
renderChildren HtmlRenderContext
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
renderChildren HtmlRenderContext
r [ChildDeclaration]
xs = Html -> Html
ul forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ChildDeclaration -> Html
item [ChildDeclaration]
xs
where
item :: ChildDeclaration -> Html
item ChildDeclaration
decl =
Html -> Html
li forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (Text -> AttributeValue
v (Int -> Text -> Text
T.drop Int
1 (ChildDeclaration -> Text
fragment ChildDeclaration
decl))) forall a b. (a -> b) -> a -> b
$ do
ChildDeclaration -> Html
renderCode ChildDeclaration
decl
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (ChildDeclaration -> Maybe Text
cdeclComments ChildDeclaration
decl) forall a b. (a -> b) -> a -> b
$ \Text
coms ->
Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"decl__child_comments" forall a b. (a -> b) -> a -> b
$ Text -> Html
renderMarkdown Text
coms
fragment :: ChildDeclaration -> Text
fragment ChildDeclaration
decl = Namespace -> Text -> Text
makeFragment (ChildDeclarationInfo -> Namespace
childDeclInfoNamespace (ChildDeclaration -> ChildDeclarationInfo
cdeclInfo ChildDeclaration
decl)) (ChildDeclaration -> Text
cdeclTitle ChildDeclaration
decl)
renderCode :: ChildDeclaration -> Html
renderCode = Html -> Html
code forall b c a. (b -> c) -> (a -> b) -> a -> c
. HtmlRenderContext -> RenderedCode -> Html
codeAsHtml HtmlRenderContext
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChildDeclaration -> RenderedCode
Render.renderChildDeclaration
codeAsHtml :: HtmlRenderContext -> RenderedCode -> Html
codeAsHtml :: HtmlRenderContext -> RenderedCode -> Html
codeAsHtml HtmlRenderContext
r = forall a.
Monoid a =>
(RenderedCodeElement -> a) -> RenderedCode -> a
outputWith RenderedCodeElement -> Html
elemAsHtml
where
elemAsHtml :: RenderedCodeElement -> Html
elemAsHtml RenderedCodeElement
e = case RenderedCodeElement
e of
Syntax Text
x ->
String -> Html -> Html
withClass String
"syntax" (Text -> Html
text Text
x)
Keyword Text
x ->
String -> Html -> Html
withClass String
"keyword" (Text -> Html
text Text
x)
RenderedCodeElement
Space ->
Text -> Html
text Text
" "
Symbol Namespace
ns Text
name Link
link_ ->
case Link
link_ of
Link ContainingModule
mn ->
let
class_ :: String
class_ =
if Text -> Bool
startsWithUpper Text
name then String
"ctor" else String
"ident"
target :: Text
target
| Text -> Bool
isOp Text
name =
if Namespace
ns forall a. Eq a => a -> a -> Bool
== Namespace
TypeLevel
then Text
"type (" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
")"
else Text
"(" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
")"
| Bool
otherwise = Text
name
in
Namespace -> Text -> ContainingModule -> Html -> Html
linkToDecl Namespace
ns Text
target ContainingModule
mn (String -> Html -> Html
withClass String
class_ (Text -> Html
text Text
name))
Link
NoLink ->
Text -> Html
text Text
name
Role Text
role ->
case Text
role of
Text
"nominal" -> Text -> AttributeValue -> Html
renderRole Text
describeNominal AttributeValue
"decl__role_nominal"
Text
"phantom" -> Text -> AttributeValue -> Html
renderRole Text
describePhantom AttributeValue
"decl__role_phantom"
Text
"representational" -> forall a. ToMarkup a => a -> Html
toHtml (Text
"" :: Text)
Text
x -> forall a. HasCallStack => String -> a
P.internalError forall a b. (a -> b) -> a -> b
$ String
"codeAsHtml: unknown value for role annotation: '" forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
x forall a. Semigroup a => a -> a -> a
<> String
"'"
where
renderRole :: Text -> AttributeValue -> Html
renderRole Text
hoverTextContent AttributeValue
className =
Html -> Html
H.a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (Text -> AttributeValue
v Text
docRepoRolePage) forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.target (Text -> AttributeValue
v Text
"_blank") forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"decl__role" forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.abbr forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"decl__role_hover" forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.title (Text -> AttributeValue
v Text
hoverTextContent) forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.sub forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
className forall a b. (a -> b) -> a -> b
$ do
forall a. ToMarkup a => a -> Html
toHtml (Text
"" :: Text)
docRepoRolePage :: Text
docRepoRolePage =
Text
"https://github.com/purescript/documentation/blob/master/language/Roles.md"
describeNominal :: Text
describeNominal =
Text
"The 'nominal' role means this argument may not change when coercing the type."
describePhantom :: Text
describePhantom =
Text
"The 'phantom' role means this argument can change freely when coercing the type."
linkToDecl :: Namespace -> Text -> ContainingModule -> Html -> Html
linkToDecl = HtmlRenderContext
-> Namespace -> Text -> ContainingModule -> Html -> Html
linkToDeclaration HtmlRenderContext
r
startsWithUpper :: Text -> Bool
startsWithUpper :: Text -> Bool
startsWithUpper Text
str = Bool -> Bool
not (Text -> Bool
T.null Text
str) Bool -> Bool -> Bool
&& Char -> Bool
isUpper (Text -> Int -> Char
T.index Text
str Int
0)
isOp :: Text -> Bool
isOp = forall a b. Either a b -> Bool
isRight forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Text -> Either String a
runParser Parser OpName
CST.parseOperator
runParser :: CST.Parser a -> Text -> Either String a
runParser :: forall a. Parser a -> Text -> Either String a
runParser Parser a
p' =
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (ParserError -> String
CST.prettyPrintError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> a
NE.head) forall a b. (a, b) -> b
snd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Parser a
-> [LexResult]
-> Either (NonEmpty ParserError) ([ParserWarning], a)
CST.runTokenParser Parser a
p'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [LexResult]
CST.lex
renderLink :: HtmlRenderContext -> DocLink -> Html -> Html
renderLink :: HtmlRenderContext -> DocLink -> Html -> Html
renderLink HtmlRenderContext
r link_ :: DocLink
link_@DocLink{Text
Namespace
LinkLocation
linkNamespace :: DocLink -> Namespace
linkTitle :: DocLink -> Text
linkLocation :: DocLink -> LinkLocation
linkNamespace :: Namespace
linkTitle :: Text
linkLocation :: LinkLocation
..} =
Html -> Html
a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (Text -> AttributeValue
v (HtmlRenderContext -> DocLink -> Text
renderDocLink HtmlRenderContext
r DocLink
link_ forall a. Semigroup a => a -> a -> a
<> DocLink -> Text
fragmentFor DocLink
link_))
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.title (Text -> AttributeValue
v Text
fullyQualifiedName)
where
fullyQualifiedName :: Text
fullyQualifiedName =
ModuleName -> Text
P.runModuleName ModuleName
modName forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> Text
linkTitle
modName :: ModuleName
modName = case LinkLocation
linkLocation of
LocalModule ModuleName
m -> ModuleName
m
DepsModule PackageName
_ Version
_ ModuleName
m -> ModuleName
m
BuiltinModule ModuleName
m -> ModuleName
m
makeFragment :: Namespace -> Text -> Text
makeFragment :: Namespace -> Text -> Text
makeFragment Namespace
ns = (Text
prefix forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. a -> a
escape
where
prefix :: Text
prefix = case Namespace
ns of
Namespace
TypeLevel -> Text
"#t:"
Namespace
ValueLevel -> Text
"#v:"
escape :: a -> a
escape = forall {a}. a -> a
id
fragmentFor :: DocLink -> Text
fragmentFor :: DocLink -> Text
fragmentFor DocLink
l = Namespace -> Text -> Text
makeFragment (DocLink -> Namespace
linkNamespace DocLink
l) (DocLink -> Text
linkTitle DocLink
l)
linkToDeclaration ::
HtmlRenderContext ->
Namespace ->
Text ->
ContainingModule ->
Html ->
Html
linkToDeclaration :: HtmlRenderContext
-> Namespace -> Text -> ContainingModule -> Html -> Html
linkToDeclaration HtmlRenderContext
r Namespace
ns Text
target ContainingModule
containMn =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {a}. a -> a
id (HtmlRenderContext -> DocLink -> Html -> Html
renderLink HtmlRenderContext
r) (HtmlRenderContext
-> Namespace -> Text -> ContainingModule -> Maybe DocLink
buildDocLink HtmlRenderContext
r Namespace
ns Text
target ContainingModule
containMn)
renderAlias :: P.Fixity -> FixityAlias -> Html
renderAlias :: Fixity -> FixityAlias -> Html
renderAlias (P.Fixity Associativity
associativity Precedence
precedence) FixityAlias
alias_ =
Html -> Html
p forall a b. (a -> b) -> a -> b
$ do
forall a. ToMarkup a => a -> Html
toHtml forall a b. (a -> b) -> a -> b
$ Text
"Operator alias for " forall a. Semigroup a => a -> a -> a
<> forall a. (a -> Text) -> Qualified a -> Text
P.showQualified forall {a :: ProperNameType} {a :: ProperNameType}.
Either (ProperName a) (Either Ident (ProperName a)) -> Text
showAliasName FixityAlias
alias_ forall a. Semigroup a => a -> a -> a
<> Text
" "
Html -> Html
em forall a b. (a -> b) -> a -> b
$
Text -> Html
text (Text
"(" forall a. Semigroup a => a -> a -> a
<> Text
associativityStr forall a. Semigroup a => a -> a -> a
<> Text
" / precedence " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Precedence
precedence) forall a. Semigroup a => a -> a -> a
<> Text
")")
where
showAliasName :: Either (ProperName a) (Either Ident (ProperName a)) -> Text
showAliasName (Left ProperName a
valueAlias) = forall (a :: ProperNameType). ProperName a -> Text
P.runProperName ProperName a
valueAlias
showAliasName (Right Either Ident (ProperName a)
typeAlias) = case Either Ident (ProperName a)
typeAlias of
(Left Ident
identifier) -> Ident -> Text
P.runIdent Ident
identifier
(Right ProperName a
properName) -> forall (a :: ProperNameType). ProperName a -> Text
P.runProperName ProperName a
properName
associativityStr :: Text
associativityStr = case Associativity
associativity of
Associativity
P.Infixl -> Text
"left-associative"
Associativity
P.Infixr -> Text
"right-associative"
Associativity
P.Infix -> Text
"non-associative"
renderMarkdown :: Text -> H.Html
renderMarkdown :: Text -> Html
renderMarkdown =
forall a. ToMarkup a => a -> Html
H.toMarkup forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
removeRelativeLinks forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> Text -> Doc
Cheapskate.markdown Options
opts
where
opts :: Options
opts = forall a. Default a => a
Cheapskate.def { allowRawHtml :: Bool
Cheapskate.allowRawHtml = Bool
False }
removeRelativeLinks :: Cheapskate.Doc -> Cheapskate.Doc
removeRelativeLinks :: Doc -> Doc
removeRelativeLinks = forall a b. (Data a, Data b) => (a -> a) -> b -> b
Cheapskate.walk Inlines -> Inlines
go
where
go :: Cheapskate.Inlines -> Cheapskate.Inlines
go :: Inlines -> Inlines
go = (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Inline -> Inlines
stripRelatives)
stripRelatives :: Cheapskate.Inline -> Cheapskate.Inlines
stripRelatives :: Inline -> Inlines
stripRelatives (Cheapskate.Link Inlines
contents_ Text
href Text
_)
| Text -> Bool
isRelativeURI Text
href = Inlines
contents_
stripRelatives Inline
other = forall (f :: * -> *) a. Applicative f => a -> f a
pure Inline
other
isRelativeURI :: Text -> Bool
isRelativeURI :: Text -> Bool
isRelativeURI =
(Char -> Bool) -> Text -> Text
T.takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'/') forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Char -> Bool) -> Text -> Bool
T.all (forall a. Eq a => a -> a -> Bool
/= Char
':')
v :: Text -> AttributeValue
v :: Text -> AttributeValue
v = forall a. ToValue a => a -> AttributeValue
toValue
withClass :: String -> Html -> Html
withClass :: String -> Html -> Html
withClass String
className = Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ (forall a. IsString a => String -> a
fromString String
className)
partitionChildren ::
[ChildDeclaration] ->
([ChildDeclaration], [ChildDeclaration], [ChildDeclaration])
partitionChildren :: [ChildDeclaration]
-> ([ChildDeclaration], [ChildDeclaration], [ChildDeclaration])
partitionChildren =
forall {a} {a} {a}. ([a], [a], [a]) -> ([a], [a], [a])
reverseAll forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ([ChildDeclaration], [ChildDeclaration], [ChildDeclaration])
-> ChildDeclaration
-> ([ChildDeclaration], [ChildDeclaration], [ChildDeclaration])
go ([], [], [])
where
go :: ([ChildDeclaration], [ChildDeclaration], [ChildDeclaration])
-> ChildDeclaration
-> ([ChildDeclaration], [ChildDeclaration], [ChildDeclaration])
go ([ChildDeclaration]
instances, [ChildDeclaration]
dctors, [ChildDeclaration]
members) ChildDeclaration
rcd =
case ChildDeclaration -> ChildDeclarationInfo
cdeclInfo ChildDeclaration
rcd of
ChildInstance [Constraint']
_ Type'
_ -> (ChildDeclaration
rcd forall a. a -> [a] -> [a]
: [ChildDeclaration]
instances, [ChildDeclaration]
dctors, [ChildDeclaration]
members)
ChildDataConstructor [Type']
_ -> ([ChildDeclaration]
instances, ChildDeclaration
rcd forall a. a -> [a] -> [a]
: [ChildDeclaration]
dctors, [ChildDeclaration]
members)
ChildTypeClassMember Type'
_ -> ([ChildDeclaration]
instances, [ChildDeclaration]
dctors, ChildDeclaration
rcd forall a. a -> [a] -> [a]
: [ChildDeclaration]
members)
reverseAll :: ([a], [a], [a]) -> ([a], [a], [a])
reverseAll ([a]
xs, [a]
ys, [a]
zs) = (forall a. [a] -> [a]
reverse [a]
xs, forall a. [a] -> [a]
reverse [a]
ys, forall a. [a] -> [a]
reverse [a]
zs)