git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Add ability to omit pretty printing of objects
b8f2bf2Harry Garrood
src/Language/PureScript/Docs/Render.hs+21−11
compare with golang
unifiedsplit
@@ -18,33 +18,36 @@ import Language.PureScript.Docs.RenderedCode
18import Language.PureScript.Docs.Utils.MonoidExtras
18import Language.PureScript.Docs.Utils.MonoidExtras
19
19
20renderDeclaration :: Declaration -> RenderedCode
20renderDeclaration :: Declaration -> RenderedCode
21−renderDeclaration Declaration{..} =
21+renderDeclaration = renderDeclarationWithOptions defaultRenderTypeOptions
22+
23+renderDeclarationWithOptions :: RenderTypeOptions -> Declaration -> RenderedCode
24+renderDeclarationWithOptions opts Declaration{..} =
22 mintersperse sp $ case declInfo of
25 mintersperse sp $ case declInfo of
23 ValueDeclaration ty ->
26 ValueDeclaration ty ->
24 [ ident declTitle
27 [ ident declTitle
25 , syntax "::"
28 , syntax "::"
26− , renderType ty
29+ , renderType' ty
27 ]
30 ]
28 DataDeclaration dtype args ->
31 DataDeclaration dtype args ->
29 [ keyword (show dtype)
32 [ keyword (show dtype)
30− , renderType (typeApp declTitle args)
33+ , renderType' (typeApp declTitle args)
31 ]
34 ]
32 ExternDataDeclaration kind' ->
35 ExternDataDeclaration kind' ->
33 [ keywordData
36 [ keywordData
34− , renderType (P.TypeConstructor (notQualified declTitle))
37+ , renderType' (P.TypeConstructor (notQualified declTitle))
35 , syntax "::"
38 , syntax "::"
36 , renderKind kind'
39 , renderKind kind'
37 ]
40 ]
38 TypeSynonymDeclaration args ty ->
41 TypeSynonymDeclaration args ty ->
39 [ keywordType
42 [ keywordType
40− , renderType (typeApp declTitle args)
43+ , renderType' (typeApp declTitle args)
41 , syntax "="
44 , syntax "="
42− , renderType ty
45+ , renderType' ty
43 ]
46 ]
44 TypeClassDeclaration args implies ->
47 TypeClassDeclaration args implies ->
45 [ keywordClass ]
48 [ keywordClass ]
46 ++ maybe [] (:[]) superclasses
49 ++ maybe [] (:[]) superclasses
47− ++ [renderType (typeApp declTitle args)]
50+ ++ [renderType' (typeApp declTitle args)]
48 ++ if any (isTypeClassMember . cdeclInfo) declChildren
51 ++ if any (isTypeClassMember . cdeclInfo) declChildren
49 then [keywordWhere]
52 then [keywordWhere]
50 else []
53 else []
@@ -59,16 +62,21 @@ renderDeclaration Declaration{..} =
59
62
60 isTypeClassMember (ChildTypeClassMember _) = True
63 isTypeClassMember (ChildTypeClassMember _) = True
61 isTypeClassMember _ = False
64 isTypeClassMember _ = False
65+ where
66+ renderType' = renderTypeWithOptions opts
62
67
63renderChildDeclaration :: ChildDeclaration -> RenderedCode
68renderChildDeclaration :: ChildDeclaration -> RenderedCode
64−renderChildDeclaration ChildDeclaration{..} =
69+renderChildDeclaration = renderChildDeclarationWithOptions defaultRenderTypeOptions
70+
71+renderChildDeclarationWithOptions :: RenderTypeOptions -> ChildDeclaration -> RenderedCode
72+renderChildDeclarationWithOptions opts ChildDeclaration{..} =
65 mintersperse sp $ case cdeclInfo of
73 mintersperse sp $ case cdeclInfo of
66 ChildInstance constraints ty ->
74 ChildInstance constraints ty ->
67 [ keywordInstance
75 [ keywordInstance
68 , ident cdeclTitle
76 , ident cdeclTitle
69 , syntax "::"
77 , syntax "::"
70 ] ++ maybe [] (:[]) constraints'
78 ] ++ maybe [] (:[]) constraints'
71− ++ [ renderType ty ]
79+ ++ [ renderType' ty ]
72 where
80 where
73 constraints'
81 constraints'
74 | null constraints = Nothing
82 | null constraints = Nothing
@@ -80,7 +88,7 @@ renderChildDeclaration ChildDeclaration{..} =
80 renderedConstraints = mintersperse (syntax "," <> sp)
88 renderedConstraints = mintersperse (syntax "," <> sp)
81 (map renderConstraint constraints)
89 (map renderConstraint constraints)
82 ChildDataConstructor args ->
90 ChildDataConstructor args ->
83− [ renderType typeApp' ]
91+ [ renderType' typeApp' ]
84 where
92 where
85 typeApp' = foldl P.TypeApp ctor' args
93 typeApp' = foldl P.TypeApp ctor' args
86 ctor' = P.TypeConstructor (notQualified cdeclTitle)
94 ctor' = P.TypeConstructor (notQualified cdeclTitle)
@@ -88,8 +96,10 @@ renderChildDeclaration ChildDeclaration{..} =
88 ChildTypeClassMember ty ->
96 ChildTypeClassMember ty ->
89 [ ident cdeclTitle
97 [ ident cdeclTitle
90 , syntax "::"
98 , syntax "::"
91− , renderType ty
99+ , renderType' ty
92 ]
100 ]
101+ where
102+ renderType' = renderTypeWithOptions opts
93
103
94renderConstraint :: (P.Qualified P.ProperName, [P.Type]) -> RenderedCode
104renderConstraint :: (P.Qualified P.ProperName, [P.Type]) -> RenderedCode
95renderConstraint (pn, tys) =
105renderConstraint (pn, tys) =
src/Language/PureScript/Docs/RenderedCode/Render.hs+26−12
@@ -5,7 +5,10 @@ module Language.PureScript.Docs.RenderedCode.Render (
5 renderType,
5 renderType,
6 renderTypeAtom,
6 renderTypeAtom,
7 renderRow,
7 renderRow,
8− renderKind
8+ renderKind,
9+ RenderTypeOptions(..),
10+ defaultRenderTypeOptions,
11+ renderTypeWithOptions
9) where
12) where
10
13
11import Data.Monoid ((<>), mconcat, mempty)
14import Data.Monoid ((<>), mconcat, mempty)
@@ -119,9 +122,9 @@ forall_ = mkPattern match
119 match (PrettyPrintForAll idents ty) = Just (idents, ty)
122 match (PrettyPrintForAll idents ty) = Just (idents, ty)
120 match _ = Nothing
123 match _ = Nothing
121
124
122−insertPlaceholders :: Type -> Type
125+insertPlaceholders :: RenderTypeOptions -> Type -> Type
123−insertPlaceholders =
126+insertPlaceholders opts =
124− everywhereOnTypesTopDown convertForAlls . everywhereOnTypes convert
127+ everywhereOnTypesTopDown convertForAlls . everywhereOnTypes (convert opts)
125
128
126dePrim :: Type -> Type
129dePrim :: Type -> Type
127dePrim ty@(TypeConstructor (Qualified _ name))
130dePrim ty@(TypeConstructor (Qualified _ name))
@@ -129,10 +132,10 @@ dePrim ty@(TypeConstructor (Qualified _ name))
129 TypeConstructor $ Qualified Nothing name
132 TypeConstructor $ Qualified Nothing name
130dePrim other = other
133dePrim other = other
131
134
132−convert :: Type -> Type
135+convert :: RenderTypeOptions -> Type -> Type
133−convert (TypeApp (TypeApp f arg) ret) | f == tyFunction = PrettyPrintFunction arg ret
136+convert _ (TypeApp (TypeApp f arg) ret) | f == tyFunction = PrettyPrintFunction arg ret
134−convert (TypeApp o r) | o == tyObject = PrettyPrintObject r
137+convert opts (TypeApp o r) | o == tyObject && prettyPrintObjects opts = PrettyPrintObject r
135−convert other = other
138+convert _ other = other
136
139
137convertForAlls :: Type -> Type
140convertForAlls :: Type -> Type
138convertForAlls (ForAll i ty _) = go [i] ty
141convertForAlls (ForAll i ty _) = go [i] ty
@@ -141,8 +144,8 @@ convertForAlls (ForAll i ty _) = go [i] ty
141 go idents other = PrettyPrintForAll idents other
144 go idents other = PrettyPrintForAll idents other
142convertForAlls other = other
145convertForAlls other = other
143
146
144−preprocessType :: Type -> Type
147+preprocessType :: RenderTypeOptions -> Type -> Type
145−preprocessType = dePrim . insertPlaceholders
148+preprocessType opts = dePrim . insertPlaceholders opts
146
149
147-- |
150-- |
148-- Render code representing a Kind
151-- Render code representing a Kind
@@ -154,12 +157,23 @@ renderKind = kind . prettyPrintKind
154-- Render code representing a Type, as it should appear inside parentheses
157-- Render code representing a Type, as it should appear inside parentheses
155--
158--
156renderTypeAtom :: Type -> RenderedCode
159renderTypeAtom :: Type -> RenderedCode
160+renderTypeAtom =
157−renderTypeAtom = fromMaybe (error "Incomplete pattern") . pattern matchTypeAtom () . preprocessType
161+ fromMaybe (error "Incomplete pattern") . pattern matchTypeAtom () . preprocessType defaultRenderTypeOptions
158
162
159
163
160-- |
164-- |
161-- Render code representing a Type
165-- Render code representing a Type
162--
166--
163renderType :: Type -> RenderedCode
167renderType :: Type -> RenderedCode
164−renderType = fromMaybe (error "Incomplete pattern") . pattern matchType () . preprocessType
168+renderType = renderTypeWithOptions defaultRenderTypeOptions
165
169
170+data RenderTypeOptions = RenderTypeOptions
171+ { prettyPrintObjects :: Bool
172+ }
173+
174+defaultRenderTypeOptions :: RenderTypeOptions
175+defaultRenderTypeOptions = RenderTypeOptions { prettyPrintObjects = True }
176+
177+renderTypeWithOptions :: RenderTypeOptions -> Type -> RenderedCode
178+renderTypeWithOptions opts =
179+ fromMaybe (error "Incomplete pattern") . pattern matchType () . preprocessType opts