forked from purescript/purescript
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathRender.hs
More file actions
152 lines (129 loc) · 4.87 KB
/
Render.hs
File metadata and controls
152 lines (129 loc) · 4.87 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
-- |
-- 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.Compat
import Data.Maybe (maybeToList)
import Data.Monoid ((<>))
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 as P
renderDeclaration :: Declaration -> RenderedCode
renderDeclaration = renderDeclarationWithOptions defaultRenderTypeOptions
renderDeclarationWithOptions :: RenderTypeOptions -> Declaration -> RenderedCode
renderDeclarationWithOptions opts Declaration{..} =
mintersperse sp $ case declInfo of
ValueDeclaration ty ->
[ ident' declTitle
, syntax "::"
, renderType' ty
]
DataDeclaration dtype args ->
[ keyword (P.showDataDeclType dtype)
, renderType' (typeApp declTitle args)
]
ExternDataDeclaration kind' ->
[ keywordData
, renderType' (P.TypeConstructor (notQualified declTitle))
, syntax "::"
, renderKind kind'
]
TypeSynonymDeclaration args ty ->
[ keywordType
, renderType' (typeApp declTitle args)
, syntax "="
, renderType' ty
]
TypeClassDeclaration args implies fundeps ->
[ keywordClass ]
++ maybeToList superclasses
++ [renderType' (typeApp declTitle args)]
++ fundepsList
++ [keywordWhere | any isTypeClassMember declChildren]
where
superclasses
| null implies = Nothing
| otherwise = Just $
syntax "("
<> mintersperse (syntax "," <> sp) (map renderConstraint implies)
<> syntax ")" <> sp <> syntax "<="
fundepsList =
[syntax "|" | not (null fundeps)]
++ [mintersperse
(syntax "," <> sp)
[idents from <> sp <> syntax "->" <> sp <> idents to | (from, to) <- fundeps ]
]
where
idents = mintersperse sp . map ident'
AliasDeclaration (P.Fixity associativity precedence) for ->
[ keywordFixity associativity
, syntax $ T.pack $ show precedence
, alias for
, keywordAs
, aliasName for declTitle
]
ExternKindDeclaration ->
[ keywordKind
, kind (notQualified declTitle)
]
where
renderType' :: P.Type -> RenderedCode
renderType' = renderTypeWithOptions opts
renderChildDeclaration :: ChildDeclaration -> RenderedCode
renderChildDeclaration = renderChildDeclarationWithOptions defaultRenderTypeOptions
renderChildDeclarationWithOptions :: RenderTypeOptions -> ChildDeclaration -> RenderedCode
renderChildDeclarationWithOptions opts ChildDeclaration{..} =
mintersperse sp $ case cdeclInfo of
ChildInstance constraints ty ->
maybeToList (renderConstraints constraints) ++ [ renderType' ty ]
ChildDataConstructor args ->
[ dataCtor' cdeclTitle ]
++ map renderTypeAtom' args
ChildTypeClassMember ty ->
[ ident' cdeclTitle
, syntax "::"
, renderType' ty
]
where
renderType' = renderTypeWithOptions opts
renderTypeAtom' = renderTypeAtomWithOptions opts
renderConstraint :: P.Constraint -> RenderedCode
renderConstraint = renderConstraintWithOptions defaultRenderTypeOptions
renderConstraintWithOptions :: RenderTypeOptions -> P.Constraint -> RenderedCode
renderConstraintWithOptions opts (P.Constraint pn tys _) =
renderTypeWithOptions opts $ foldl P.TypeApp (P.TypeConstructor (fmap P.coerceProperName pn)) tys
renderConstraints :: [P.Constraint] -> Maybe RenderedCode
renderConstraints = renderConstraintsWithOptions defaultRenderTypeOptions
renderConstraintsWithOptions :: RenderTypeOptions -> [P.Constraint] -> Maybe RenderedCode
renderConstraintsWithOptions opts constraints
| null constraints = Nothing
| otherwise = Just $
syntax "("
<> renderedConstraints
<> syntax ")" <> sp <> syntax "=>"
where
renderedConstraints =
mintersperse (syntax "," <> sp)
(map (renderConstraintWithOptions opts) constraints)
notQualified :: Text -> P.Qualified (P.ProperName a)
notQualified = P.Qualified Nothing . P.ProperName
ident' :: Text -> RenderedCode
ident' = ident . P.Qualified Nothing . P.Ident
dataCtor' :: Text -> RenderedCode
dataCtor' = dataCtor . notQualified
typeApp :: Text -> [(Text, Maybe P.Kind)] -> P.Type
typeApp title typeArgs =
foldl P.TypeApp
(P.TypeConstructor (notQualified title))
(map toTypeVar typeArgs)
toTypeVar :: (Text, Maybe P.Kind) -> P.Type
toTypeVar (s, Nothing) = P.TypeVar s
toTypeVar (s, Just k) = P.KindedType (P.TypeVar s) k