b8f2bf2 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Add ability to omit pretty printing of objects

For Hoogle.

commitb8f2bf28d838540c00000cb407e220ea46942049 authorHarry Garrood <harry@garrood.me> dateSun 28 Jun 2015, 02:54 (11 years ago) parenta11335e

2 files changed+47−23

compare with golang

unifiedsplit

src/Language/PureScript/Docs/Render.hs+21−11 src/Language/PureScript/Docs/RenderedCode/Render.hs+26−12

src/Language/PureScript/Docs/Render.hs+21−11

@@ -18,33 +18,36 @@ import Language.PureScript.Docs.RenderedCode

1818import Language.PureScript.Docs.Utils.MonoidExtras

1919

2020renderDeclaration :: Declaration -> RenderedCode

21−renderDeclaration Declaration{..} =

21+renderDeclaration = renderDeclarationWithOptions defaultRenderTypeOptions

22+

23+renderDeclarationWithOptions :: RenderTypeOptions -> Declaration -> RenderedCode

24+renderDeclarationWithOptions opts Declaration{..} =

2225 mintersperse sp $ case declInfo of

2326 ValueDeclaration ty ->

2427 [ ident declTitle

2528 , syntax "::"

26− , renderType ty

29+ , renderType' ty

2730 ]

2831 DataDeclaration dtype args ->

2932 [ keyword (show dtype)

30− , renderType (typeApp declTitle args)

33+ , renderType' (typeApp declTitle args)

3134 ]

3235 ExternDataDeclaration kind' ->

3336 [ keywordData

34− , renderType (P.TypeConstructor (notQualified declTitle))

37+ , renderType' (P.TypeConstructor (notQualified declTitle))

3538 , syntax "::"

3639 , renderKind kind'

3740 ]

3841 TypeSynonymDeclaration args ty ->

3942 [ keywordType

40− , renderType (typeApp declTitle args)

43+ , renderType' (typeApp declTitle args)

4144 , syntax "="

42− , renderType ty

45+ , renderType' ty

4346 ]

4447 TypeClassDeclaration args implies ->

4548 [ keywordClass ]

4649 ++ maybe [] (:[]) superclasses

47− ++ [renderType (typeApp declTitle args)]

50+ ++ [renderType' (typeApp declTitle args)]

4851 ++ if any (isTypeClassMember . cdeclInfo) declChildren

4952 then [keywordWhere]

5053 else []

@@ -59,16 +62,21 @@ renderDeclaration Declaration{..} =

5962

6063 isTypeClassMember (ChildTypeClassMember _) = True

6164 isTypeClassMember _ = False

65+ where

66+ renderType' = renderTypeWithOptions opts

6267

6368renderChildDeclaration :: ChildDeclaration -> RenderedCode

64−renderChildDeclaration ChildDeclaration{..} =

69+renderChildDeclaration = renderChildDeclarationWithOptions defaultRenderTypeOptions

70+

71+renderChildDeclarationWithOptions :: RenderTypeOptions -> ChildDeclaration -> RenderedCode

72+renderChildDeclarationWithOptions opts ChildDeclaration{..} =

6573 mintersperse sp $ case cdeclInfo of

6674 ChildInstance constraints ty ->

6775 [ keywordInstance

6876 , ident cdeclTitle

6977 , syntax "::"

7078 ] ++ maybe [] (:[]) constraints'

71− ++ [ renderType ty ]

79+ ++ [ renderType' ty ]

7280 where

7381 constraints'

7482 | null constraints = Nothing

@@ -80,7 +88,7 @@ renderChildDeclaration ChildDeclaration{..} =

8088 renderedConstraints = mintersperse (syntax "," <> sp)

8189 (map renderConstraint constraints)

8290 ChildDataConstructor args ->

83− [ renderType typeApp' ]

91+ [ renderType' typeApp' ]

8492 where

8593 typeApp' = foldl P.TypeApp ctor' args

8694 ctor' = P.TypeConstructor (notQualified cdeclTitle)

@@ -88,8 +96,10 @@ renderChildDeclaration ChildDeclaration{..} =

8896 ChildTypeClassMember ty ->

8997 [ ident cdeclTitle

9098 , syntax "::"

91− , renderType ty

99+ , renderType' ty

92100 ]

101+ where

102+ renderType' = renderTypeWithOptions opts

93103

94104renderConstraint :: (P.Qualified P.ProperName, [P.Type]) -> RenderedCode

95105renderConstraint (pn, tys) =

src/Language/PureScript/Docs/RenderedCode/Render.hs+26−12

@@ -5,7 +5,10 @@ module Language.PureScript.Docs.RenderedCode.Render (

55 renderType,

66 renderTypeAtom,

77 renderRow,

8− renderKind

8+ renderKind,

9+ RenderTypeOptions(..),

10+ defaultRenderTypeOptions,

11+ renderTypeWithOptions

912) where

1013

1114import Data.Monoid ((<>), mconcat, mempty)

@@ -119,9 +122,9 @@ forall_ = mkPattern match

119122 match (PrettyPrintForAll idents ty) = Just (idents, ty)

120123 match _ = Nothing

121124

122−insertPlaceholders :: Type -> Type

123−insertPlaceholders =

124− everywhereOnTypesTopDown convertForAlls . everywhereOnTypes convert

125+insertPlaceholders :: RenderTypeOptions -> Type -> Type

126+insertPlaceholders opts =

127+ everywhereOnTypesTopDown convertForAlls . everywhereOnTypes (convert opts)

125128

126129dePrim :: Type -> Type

127130dePrim ty@(TypeConstructor (Qualified _ name))

@@ -129,10 +132,10 @@ dePrim ty@(TypeConstructor (Qualified _ name))

129132 TypeConstructor $ Qualified Nothing name

130133dePrim other = other

131134

132−convert :: Type -> Type

133−convert (TypeApp (TypeApp f arg) ret) | f == tyFunction = PrettyPrintFunction arg ret

134−convert (TypeApp o r) | o == tyObject = PrettyPrintObject r

135−convert other = other

135+convert :: RenderTypeOptions -> Type -> Type

136+convert _ (TypeApp (TypeApp f arg) ret) | f == tyFunction = PrettyPrintFunction arg ret

137+convert opts (TypeApp o r) | o == tyObject && prettyPrintObjects opts = PrettyPrintObject r

138+convert _ other = other

136139

137140convertForAlls :: Type -> Type

138141convertForAlls (ForAll i ty _) = go [i] ty

@@ -141,8 +144,8 @@ convertForAlls (ForAll i ty _) = go [i] ty

141144 go idents other = PrettyPrintForAll idents other

142145convertForAlls other = other

143146

144−preprocessType :: Type -> Type

145−preprocessType = dePrim . insertPlaceholders

147+preprocessType :: RenderTypeOptions -> Type -> Type

148+preprocessType opts = dePrim . insertPlaceholders opts

146149

147150-- |

148151-- Render code representing a Kind

@@ -154,12 +157,23 @@ renderKind = kind . prettyPrintKind

154157-- Render code representing a Type, as it should appear inside parentheses

155158--

156159renderTypeAtom :: Type -> RenderedCode

157−renderTypeAtom = fromMaybe (error "Incomplete pattern") . pattern matchTypeAtom () . preprocessType

160+renderTypeAtom =

161+ fromMaybe (error "Incomplete pattern") . pattern matchTypeAtom () . preprocessType defaultRenderTypeOptions

158162

159163

160164-- |

161165-- Render code representing a Type

162166--

163167renderType :: Type -> RenderedCode

164−renderType = fromMaybe (error "Incomplete pattern") . pattern matchType () . preprocessType

168+renderType = renderTypeWithOptions defaultRenderTypeOptions

165169

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