1-- |
2-- Functions for creating `RenderedCode` values from data types in
3-- Language.PureScript.Docs.Types.
4--
5-- These functions are the ones that are used in markdown/html documentation
6-- generation, but the intention is that you are able to supply your own
7-- instead if necessary. For example, the Hoogle input file generator
8-- substitutes some of these
9
10module Language.PureScript.Docs.Render where
11
12import Prelude.Compat
13
14import Data.Maybe (maybeToList)
15import Data.Text (Text)
16import qualified Data.Text as T
17
18import Language.PureScript.Docs.RenderedCode
19import Language.PureScript.Docs.Types
20import Language.PureScript.Docs.Utils.MonoidExtras
21
22import qualified Language.PureScript.AST as P
23import qualified Language.PureScript.Environment as P
24import qualified Language.PureScript.Names as P
25import qualified Language.PureScript.Types as P
26
27renderKindSig :: Text -> KindInfo -> RenderedCode
28renderKindSig declTitle KindInfo{..} =
29  mintersperse sp
30      [ keyword $ kindSignatureForKeyword kiKeyword
31      , renderType (P.TypeConstructor () (notQualified declTitle))
32      , syntax "::"
33      , renderType kiKind
34      ]
35
36renderDeclaration :: Declaration -> RenderedCode
37renderDeclaration Declaration{..} =
38  mintersperse sp $ case declInfo of
39    ValueDeclaration ty ->
40      [ ident' declTitle
41      , syntax "::"
42      , renderType ty
43      ]
44    DataDeclaration dtype args ->
45      [ keyword (P.showDataDeclType dtype)
46      , renderType (typeApp declTitle args)
47      ]
48    ExternDataDeclaration kind' ->
49      [ keywordData
50      , renderType (P.TypeConstructor () (notQualified declTitle))
51      , syntax "::"
52      , renderType kind'
53      ]
54    TypeSynonymDeclaration args ty ->
55      [ keywordType
56      , renderType (typeApp declTitle args)
57      , syntax "="
58      , renderType ty
59      ]
60    TypeClassDeclaration args implies fundeps ->
61      [ keywordClass ]
62      ++ maybeToList superclasses
63      ++ [renderType (typeApp declTitle args)]
64      ++ fundepsList
65      ++ [keywordWhere | any isTypeClassMember declChildren]
66
67      where
68      superclasses
69        | null implies = Nothing
70        | otherwise = Just $
71            syntax "("
72            <> mintersperse (syntax "," <> sp) (map renderConstraint implies)
73            <> syntax ")" <> sp <> syntax "<="
74
75      fundepsList =
76           [syntax "|" | not (null fundeps)]
77        ++ [mintersperse
78             (syntax "," <> sp)
79             [typeVars from <> sp <> syntax "->" <> sp <> typeVars to | (from, to) <- fundeps ]
80           ]
81        where
82          typeVars = mintersperse sp . map typeVar
83
84    AliasDeclaration (P.Fixity associativity precedence) for ->
85      [ keywordFixity associativity
86      , syntax $ T.pack $ show precedence
87      , alias for
88      , keywordAs
89      , aliasName for declTitle
90      ]
91
92renderChildDeclaration :: ChildDeclaration -> RenderedCode
93renderChildDeclaration ChildDeclaration{..} =
94  mintersperse sp $ case cdeclInfo of
95    ChildInstance constraints ty ->
96      maybeToList (renderConstraints constraints) ++ [ renderType ty ]
97    ChildDataConstructor args ->
98      dataCtor' cdeclTitle : map renderTypeAtom args
99
100    ChildTypeClassMember ty ->
101      [ ident' cdeclTitle
102      , syntax "::"
103      , renderType ty
104      ]
105
106renderConstraint :: Constraint' -> RenderedCode
107renderConstraint (P.Constraint ann pn kinds tys _) =
108  renderType $ foldl (P.TypeApp ann) (foldl (P.KindApp ann) (P.TypeConstructor ann (fmap P.coerceProperName pn)) kinds) tys
109
110renderConstraints :: [Constraint'] -> Maybe RenderedCode
111renderConstraints constraints
112  | null constraints = Nothing
113  | otherwise = Just $
114        syntax "("
115        <> renderedConstraints
116        <> syntax ")" <> sp <> syntax "=>"
117  where
118  renderedConstraints =
119    mintersperse (syntax "," <> sp)
120                 (map renderConstraint constraints)
121
122notQualified :: Text -> P.Qualified (P.ProperName a)
123notQualified = P.Qualified Nothing . P.ProperName
124
125ident' :: Text -> RenderedCode
126ident' = ident . P.Qualified Nothing . P.Ident
127
128dataCtor' :: Text -> RenderedCode
129dataCtor' = dataCtor . notQualified
130
131typeApp :: Text -> [(Text, Maybe Type')] -> Type'
132typeApp title typeArgs =
133  foldl (P.TypeApp ())
134        (P.TypeConstructor () (notQualified title))
135        (map toTypeVar typeArgs)
136
137toTypeVar :: (Text, Maybe Type') -> Type'
138toTypeVar (s, Nothing) = P.TypeVar () s
139toTypeVar (s, Just k) = P.KindedType () (P.TypeVar () s) k
140