git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #1203 from hdgarrood/hoogle-additions
6e267d4Phil Freeman
src/Language/PureScript/Docs/Render.hs+42−24
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,28 +62,23 @@ 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 [] (:[]) (renderConstraints constraints)
71− ++ [ renderType ty ]
79+ ++ [ renderType' ty ]
72− where
73− constraints'
74− | null constraints = Nothing
75− | otherwise = Just $
76− syntax "("
77− <> renderedConstraints
78− <> syntax ")" <> sp <> syntax "=>"
79−
80− renderedConstraints = mintersperse (syntax "," <> sp)
81− (map renderConstraint constraints)
82 ChildDataConstructor args ->
80 ChildDataConstructor args ->
83− [ renderType typeApp' ]
81+ [ renderType' typeApp' ]
84 where
82 where
85 typeApp' = foldl P.TypeApp ctor' args
83 typeApp' = foldl P.TypeApp ctor' args
86 ctor' = P.TypeConstructor (notQualified cdeclTitle)
84 ctor' = P.TypeConstructor (notQualified cdeclTitle)
@@ -88,12 +86,32 @@ renderChildDeclaration ChildDeclaration{..} =
88 ChildTypeClassMember ty ->
86 ChildTypeClassMember ty ->
89 [ ident cdeclTitle
87 [ ident cdeclTitle
90 , syntax "::"
88 , syntax "::"
91− , renderType ty
89+ , renderType' ty
92 ]
90 ]
91+ where
92+ renderType' = renderTypeWithOptions opts
93
93
94renderConstraint :: (P.Qualified P.ProperName, [P.Type]) -> RenderedCode
94renderConstraint :: (P.Qualified P.ProperName, [P.Type]) -> RenderedCode
95−renderConstraint (pn, tys) =
95+renderConstraint = renderConstraintWithOptions defaultRenderTypeOptions
96+
97+renderConstraintWithOptions :: RenderTypeOptions -> (P.Qualified P.ProperName, [P.Type]) -> RenderedCode
98+renderConstraintWithOptions opts (pn, tys) =
96− renderType $ foldl P.TypeApp (P.TypeConstructor pn) tys
99+ renderTypeWithOptions opts $ foldl P.TypeApp (P.TypeConstructor pn) tys
100+
101+renderConstraints :: [P.Constraint] -> Maybe RenderedCode
102+renderConstraints = renderConstraintsWithOptions defaultRenderTypeOptions
103+
104+renderConstraintsWithOptions :: RenderTypeOptions -> [P.Constraint] -> Maybe RenderedCode
105+renderConstraintsWithOptions opts constraints
106+ | null constraints = Nothing
107+ | otherwise = Just $
108+ syntax "("
109+ <> renderedConstraints
110+ <> syntax ")" <> sp <> syntax "=>"
111+ where
112+ renderedConstraints =
113+ mintersperse (syntax "," <> sp)
114+ (map (renderConstraintWithOptions opts) constraints)
97
115
98notQualified :: String -> P.Qualified P.ProperName
116notQualified :: String -> P.Qualified P.ProperName
99notQualified = P.Qualified Nothing . P.ProperName
117notQualified = P.Qualified Nothing . P.ProperName
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