module Language.PureScript.Docs.Render where
import Prelude
import Data.Maybe (maybeToList)
import Data.Text (Text)
import qualified Data.Text as T
import Language.PureScript.Docs.RenderedCode
import Language.PureScript.Docs.Types
import Language.PureScript.Docs.Utils.MonoidExtras
import qualified Language.PureScript.AST as P
import qualified Language.PureScript.Environment as P
import qualified Language.PureScript.Names as P
import qualified Language.PureScript.Types as P
renderKindSig :: Text -> KindInfo -> RenderedCode
renderKindSig :: Text -> KindInfo -> RenderedCode
renderKindSig Text
declTitle KindInfo{Type'
KindSignatureFor
kiKind :: KindInfo -> Type'
kiKeyword :: KindInfo -> KindSignatureFor
kiKind :: Type'
kiKeyword :: KindSignatureFor
..} =
forall m. Monoid m => m -> [m] -> m
mintersperse RenderedCode
sp
[ Text -> RenderedCode
keyword forall a b. (a -> b) -> a -> b
$ KindSignatureFor -> Text
kindSignatureForKeyword KindSignatureFor
kiKeyword
, forall a. Type a -> RenderedCode
renderType (forall a. a -> Qualified (ProperName 'TypeName) -> Type a
P.TypeConstructor () (forall (a :: ProperNameType). Text -> Qualified (ProperName a)
notQualified Text
declTitle))
, Text -> RenderedCode
syntax Text
"::"
, forall a. Type a -> RenderedCode
renderType Type'
kiKind
]
renderDeclaration :: Declaration -> RenderedCode
renderDeclaration :: Declaration -> RenderedCode
renderDeclaration 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
..} =
forall m. Monoid m => m -> [m] -> m
mintersperse RenderedCode
sp forall a b. (a -> b) -> a -> b
$ case DeclarationInfo
declInfo of
ValueDeclaration Type'
ty ->
[ Text -> RenderedCode
ident' Text
declTitle
, Text -> RenderedCode
syntax Text
"::"
, forall a. Type a -> RenderedCode
renderType Type'
ty
]
DataDeclaration DataDeclType
dtype [(Text, Maybe Type')]
args [Role]
roles ->
[ Text -> RenderedCode
keyword (DataDeclType -> Text
P.showDataDeclType DataDeclType
dtype)
, forall a. [Role] -> Type a -> RenderedCode
renderTypeWithRole [Role]
roles (Text -> [(Text, Maybe Type')] -> Type'
typeApp Text
declTitle [(Text, Maybe Type')]
args)
]
ExternDataDeclaration Type'
kind' [Role]
_ ->
[ RenderedCode
keywordData
, forall a. Type a -> RenderedCode
renderType (forall a. a -> Qualified (ProperName 'TypeName) -> Type a
P.TypeConstructor () (forall (a :: ProperNameType). Text -> Qualified (ProperName a)
notQualified Text
declTitle))
, Text -> RenderedCode
syntax Text
"::"
, forall a. Type a -> RenderedCode
renderType Type'
kind'
]
TypeSynonymDeclaration [(Text, Maybe Type')]
args Type'
ty ->
[ RenderedCode
keywordType
, forall a. Type a -> RenderedCode
renderType (Text -> [(Text, Maybe Type')] -> Type'
typeApp Text
declTitle [(Text, Maybe Type')]
args)
, Text -> RenderedCode
syntax Text
"="
, forall a. Type a -> RenderedCode
renderType Type'
ty
]
TypeClassDeclaration [(Text, Maybe Type')]
args [Constraint']
implies [([Text], [Text])]
fundeps ->
[ RenderedCode
keywordClass ]
forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe RenderedCode
superclasses
forall a. [a] -> [a] -> [a]
++ [forall a. Type a -> RenderedCode
renderType (Text -> [(Text, Maybe Type')] -> Type'
typeApp Text
declTitle [(Text, Maybe Type')]
args)]
forall a. [a] -> [a] -> [a]
++ [RenderedCode]
fundepsList
forall a. [a] -> [a] -> [a]
++ [RenderedCode
keywordWhere | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ChildDeclaration -> Bool
isTypeClassMember [ChildDeclaration]
declChildren]
where
superclasses :: Maybe RenderedCode
superclasses
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Constraint']
implies = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
Text -> RenderedCode
syntax Text
"("
forall a. Semigroup a => a -> a -> a
<> forall m. Monoid m => m -> [m] -> m
mintersperse (Text -> RenderedCode
syntax Text
"," forall a. Semigroup a => a -> a -> a
<> RenderedCode
sp) (forall a b. (a -> b) -> [a] -> [b]
map Constraint' -> RenderedCode
renderConstraint [Constraint']
implies)
forall a. Semigroup a => a -> a -> a
<> Text -> RenderedCode
syntax Text
")" forall a. Semigroup a => a -> a -> a
<> RenderedCode
sp forall a. Semigroup a => a -> a -> a
<> Text -> RenderedCode
syntax Text
"<="
fundepsList :: [RenderedCode]
fundepsList =
[Text -> RenderedCode
syntax Text
"|" | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([Text], [Text])]
fundeps)]
forall a. [a] -> [a] -> [a]
++ [forall m. Monoid m => m -> [m] -> m
mintersperse
(Text -> RenderedCode
syntax Text
"," forall a. Semigroup a => a -> a -> a
<> RenderedCode
sp)
[[Text] -> RenderedCode
typeVars [Text]
from forall a. Semigroup a => a -> a -> a
<> RenderedCode
sp forall a. Semigroup a => a -> a -> a
<> Text -> RenderedCode
syntax Text
"->" forall a. Semigroup a => a -> a -> a
<> RenderedCode
sp forall a. Semigroup a => a -> a -> a
<> [Text] -> RenderedCode
typeVars [Text]
to | ([Text]
from, [Text]
to) <- [([Text], [Text])]
fundeps ]
]
where
typeVars :: [Text] -> RenderedCode
typeVars = forall m. Monoid m => m -> [m] -> m
mintersperse RenderedCode
sp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Text -> RenderedCode
typeVar
AliasDeclaration (P.Fixity Associativity
associativity Precedence
precedence) FixityAlias
for ->
[ Associativity -> RenderedCode
keywordFixity Associativity
associativity
, Text -> RenderedCode
syntax forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Precedence
precedence
, FixityAlias -> RenderedCode
alias FixityAlias
for
, RenderedCode
keywordAs
, FixityAlias -> Text -> RenderedCode
aliasName FixityAlias
for Text
declTitle
]
renderChildDeclaration :: ChildDeclaration -> RenderedCode
renderChildDeclaration :: ChildDeclaration -> RenderedCode
renderChildDeclaration ChildDeclaration{Maybe Text
Maybe SourceSpan
Text
ChildDeclarationInfo
cdeclInfo :: ChildDeclaration -> ChildDeclarationInfo
cdeclSourceSpan :: ChildDeclaration -> Maybe SourceSpan
cdeclComments :: ChildDeclaration -> Maybe Text
cdeclTitle :: ChildDeclaration -> Text
cdeclInfo :: ChildDeclarationInfo
cdeclSourceSpan :: Maybe SourceSpan
cdeclComments :: Maybe Text
cdeclTitle :: Text
..} =
forall m. Monoid m => m -> [m] -> m
mintersperse RenderedCode
sp forall a b. (a -> b) -> a -> b
$ case ChildDeclarationInfo
cdeclInfo of
ChildInstance [Constraint']
constraints Type'
ty ->
forall a. Maybe a -> [a]
maybeToList ([Constraint'] -> Maybe RenderedCode
renderConstraints [Constraint']
constraints) forall a. [a] -> [a] -> [a]
++ [ forall a. Type a -> RenderedCode
renderType Type'
ty ]
ChildDataConstructor [Type']
args ->
Text -> RenderedCode
dataCtor' Text
cdeclTitle forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Type a -> RenderedCode
renderTypeAtom [Type']
args
ChildTypeClassMember Type'
ty ->
[ Text -> RenderedCode
ident' Text
cdeclTitle
, Text -> RenderedCode
syntax Text
"::"
, forall a. Type a -> RenderedCode
renderType Type'
ty
]
renderConstraint :: Constraint' -> RenderedCode
renderConstraint :: Constraint' -> RenderedCode
renderConstraint (P.Constraint ()
ann Qualified (ProperName 'ClassName)
pn [Type']
kinds [Type']
tys Maybe ConstraintData
_) =
forall a. Type a -> RenderedCode
renderType forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall a. a -> Type a -> Type a -> Type a
P.TypeApp ()
ann) (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall a. a -> Type a -> Type a -> Type a
P.KindApp ()
ann) (forall a. a -> Qualified (ProperName 'TypeName) -> Type a
P.TypeConstructor ()
ann (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
P.coerceProperName Qualified (ProperName 'ClassName)
pn)) [Type']
kinds) [Type']
tys
renderConstraints :: [Constraint'] -> Maybe RenderedCode
renderConstraints :: [Constraint'] -> Maybe RenderedCode
renderConstraints [Constraint']
constraints
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Constraint']
constraints = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
Text -> RenderedCode
syntax Text
"("
forall a. Semigroup a => a -> a -> a
<> RenderedCode
renderedConstraints
forall a. Semigroup a => a -> a -> a
<> Text -> RenderedCode
syntax Text
")" forall a. Semigroup a => a -> a -> a
<> RenderedCode
sp forall a. Semigroup a => a -> a -> a
<> Text -> RenderedCode
syntax Text
"=>"
where
renderedConstraints :: RenderedCode
renderedConstraints =
forall m. Monoid m => m -> [m] -> m
mintersperse (Text -> RenderedCode
syntax Text
"," forall a. Semigroup a => a -> a -> a
<> RenderedCode
sp)
(forall a b. (a -> b) -> [a] -> [b]
map Constraint' -> RenderedCode
renderConstraint [Constraint']
constraints)
notQualified :: Text -> P.Qualified (P.ProperName a)
notQualified :: forall (a :: ProperNameType). Text -> Qualified (ProperName a)
notQualified = forall a. QualifiedBy -> a -> Qualified a
P.Qualified QualifiedBy
P.ByNullSourcePos forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: ProperNameType). Text -> ProperName a
P.ProperName
ident' :: Text -> RenderedCode
ident' :: Text -> RenderedCode
ident' = Qualified Ident -> RenderedCode
ident forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. QualifiedBy -> a -> Qualified a
P.Qualified QualifiedBy
P.ByNullSourcePos forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Ident
P.Ident
dataCtor' :: Text -> RenderedCode
dataCtor' :: Text -> RenderedCode
dataCtor' = Qualified (ProperName 'ConstructorName) -> RenderedCode
dataCtor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: ProperNameType). Text -> Qualified (ProperName a)
notQualified
typeApp :: Text -> [(Text, Maybe Type')] -> Type'
typeApp :: Text -> [(Text, Maybe Type')] -> Type'
typeApp Text
title [(Text, Maybe Type')]
typeArgs =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall a. a -> Type a -> Type a -> Type a
P.TypeApp ())
(forall a. a -> Qualified (ProperName 'TypeName) -> Type a
P.TypeConstructor () (forall (a :: ProperNameType). Text -> Qualified (ProperName a)
notQualified Text
title))
(forall a b. (a -> b) -> [a] -> [b]
map (Text, Maybe Type') -> Type'
toTypeVar [(Text, Maybe Type')]
typeArgs)
toTypeVar :: (Text, Maybe Type') -> Type'
toTypeVar :: (Text, Maybe Type') -> Type'
toTypeVar (Text
s, Maybe Type'
Nothing) = forall a. a -> Text -> Type a
P.TypeVar () Text
s
toTypeVar (Text
s, Just Type'
k) = forall a. a -> Type a -> Type a -> Type a
P.KindedType () (forall a. a -> Text -> Type a
P.TypeVar () Text
s) Type'
k