6e267d4 · rowtype-yoga/purescript-native

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

Merge pull request #1203 from hdgarrood/hoogle-additions

Additions for pursuit (hoogle)

commit6e267d4ab183c6dfa72488acad25c153de8a2338 authorPhil Freeman <paf31@cantab.net> dateSun 28 Jun 2015, 16:08 (11 years ago) parent087f15b 61cfbaf

2 files changed+68−36

compare with golang

unifiedsplit

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

src/Language/PureScript/Docs/Render.hs+42−24

@@ -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,28 +62,23 @@ 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 "::"

70− ] ++ maybe [] (:[]) constraints'

71− ++ [ 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)

78+ ] ++ maybe [] (:[]) (renderConstraints constraints)

79+ ++ [ renderType' ty ]

8280 ChildDataConstructor args ->

83− [ renderType typeApp' ]

81+ [ renderType' typeApp' ]

8482 where

8583 typeApp' = foldl P.TypeApp ctor' args

8684 ctor' = P.TypeConstructor (notQualified cdeclTitle)

@@ -88,12 +86,32 @@ renderChildDeclaration ChildDeclaration{..} =

8886 ChildTypeClassMember ty ->

8987 [ ident cdeclTitle

9088 , syntax "::"

91− , renderType ty

89+ , renderType' ty

9290 ]

91+ where

92+ renderType' = renderTypeWithOptions opts

9393

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

95−renderConstraint (pn, tys) =

96− renderType $ foldl P.TypeApp (P.TypeConstructor pn) tys

95+renderConstraint = renderConstraintWithOptions defaultRenderTypeOptions

96+

97+renderConstraintWithOptions :: RenderTypeOptions -> (P.Qualified P.ProperName, [P.Type]) -> RenderedCode

98+renderConstraintWithOptions opts (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)

97115

98116notQualified :: String -> P.Qualified P.ProperName

99117notQualified = P.Qualified Nothing . P.ProperName

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