-- |
-- Functions for creating `RenderedCode` values from data types in
-- Language.PureScript.Docs.Types.
--
-- These functions are the ones that are used in markdown/html documentation
-- generation, but the intention is that you are able to supply your own
-- instead if necessary. For example, the Hoogle input file generator
-- substitutes some of these

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)
      ]

    -- All FFI declarations, except for `Prim` modules' doc declarations,
    -- will have been converted to `DataDeclaration`s by this point.
    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