d86e085 · rowtype-yoga/purescript-native

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

Merge pull request #1984 from LiamGoodacre/fix/renderdocs

d86e085Phil Freeman11 years ago

CONTRIBUTORS.md+1

@@ -68,6 +68,7 @@ This file lists the contributors to the PureScript compiler project, and the ter

68- [@utkarshkukreti](https://github.com/utkarshkukreti) (Utkarsh Kukreti) My existing contributions and all future contributions until further notice are Copyright Utkarsh Kukreti, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

69- [@vkorablin](https://github.com/vkorablin) (Vladimir Korablin) - My existing contributions and all future contributions until further notice are Copyright Vladimir Korablin, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.

70- [@zudov](https://github.com/zudov) (Konstantin Zudov) My existing contributions and all future contributions until further notice are Copyright Konstantin Zudov, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

71+- [@LiamGoodacre](https://github.com/LiamGoodacre) (Liam Goodacre) My existing contributions and all future contributions until further notice are Copyright Liam Goodacre, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

72### Companies

73### Companies

examples/docs/src/ConstrainedArgument.pursnew file+9

@@ -0,0 +1,9 @@

1+module ConstrainedArgument where

3+class Foo t

5+type WithoutArgs = forall a. (Partial => a) -> a

6+type WithArgs = forall a. (Foo a => a) -> a

7+type MultiWithoutArgs = forall a. ((Partial, Partial) => a) -> a

8+type MultiWithArgs = forall a b. ((Foo a, Foo b) => a) -> a

src/Language/PureScript/Docs/AsMarkdown.hs+1

@@ -6,6 +6,7 @@ module Language.PureScript.Docs.AsMarkdown

6 , Docs

7 , runDocs

8 , modulesAsMarkdown

9+ , codeToString

9 ) where

10 ) where

11import Prelude ()

12import Prelude ()

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

@@ -44,18 +44,6 @@ typeLiterals = mkPattern match

44 ]

45 match (TypeConstructor (Qualified mn name)) =

46 Just (ctor (runProperName name) (maybeToContainingModule mn))

47− match (ConstrainedType deps ty) =

48− Just $ mintersperse sp

49− [ syntax "(" <> constraints <> syntax ")"

50− , syntax "=>"

51− , renderType ty

52− ]

53− where

54− constraints = mintersperse (syntax "," <> sp) (map renderDep deps)

55− renderDep :: Constraint -> RenderedCode

56− renderDep (pn, tys) =

57− let instApp = foldl TypeApp (TypeConstructor (fmap coerceProperName pn)) tys

58− in renderType instApp

59 match REmpty =

47 match REmpty =

60 Just (syntax "()")

48 Just (syntax "()")

61 match row@RCons{} =

49 match row@RCons{} =

@@ -63,6 +51,23 @@ typeLiterals = mkPattern match

63 match _ =

51 match _ =

64 Nothing

52 Nothing

54+renderConstraint :: Constraint -> RenderedCode

55+renderConstraint (pn, tys) =

56+ let instApp = foldl TypeApp (TypeConstructor (fmap coerceProperName pn)) tys

57+ in renderType instApp

58+

59+renderConstraints :: [Constraint] -> RenderedCode -> RenderedCode

60+renderConstraints deps ty =

61+ mintersperse sp

62+ [ if length deps == 1

63+ then constraints

64+ else syntax "(" <> constraints <> syntax ")"

65+ , syntax "=>"

66+ , ty

67+ ]

68+ where

69+ constraints = mintersperse (syntax "," <> sp) (map renderConstraint deps)

70+

66-- |

71-- |

67-- Render code representing a Row

72-- Render code representing a Row

68--

73--

@@ -104,6 +109,12 @@ kinded = mkPattern match

104 match (KindedType t k) = Just (k, t)

109 match (KindedType t k) = Just (k, t)

105 match _ = Nothing

110 match _ = Nothing

106

111

112+constrained :: Pattern () Type ([Constraint], Type)

113+constrained = mkPattern match

114+ where

115+ match (ConstrainedType deps ty) = Just (deps, ty)

116+ match _ = Nothing

117+

107matchTypeAtom :: Pattern () Type RenderedCode

118matchTypeAtom :: Pattern () Type RenderedCode

108matchTypeAtom = typeLiterals <+> fmap parens matchType

119matchTypeAtom = typeLiterals <+> fmap parens matchType

109 where

120 where

@@ -116,6 +127,7 @@ matchType = buildPrettyPrinter operators matchTypeAtom

116 operators =

127 operators =

117 OperatorTable [ [ AssocL typeApp $ \f x -> f <> sp <> x ]

128 OperatorTable [ [ AssocL typeApp $ \f x -> f <> sp <> x ]

118 , [ AssocR appliedFunction $ \arg ret -> mintersperse sp [arg, syntax "->", ret] ]

129 , [ AssocR appliedFunction $ \arg ret -> mintersperse sp [arg, syntax "->", ret] ]

130+ , [ Wrap constrained $ \deps ty -> renderConstraints deps ty ]

119 , [ Wrap forall_ $ \idents ty -> mconcat [syntax "forall", sp, mintersperse sp (map ident idents), syntax ".", sp, ty] ]

131 , [ Wrap forall_ $ \idents ty -> mconcat [syntax "forall", sp, mintersperse sp (map ident idents), syntax ".", sp, ty] ]

120 , [ Wrap kinded $ \k ty -> mintersperse sp [ty, syntax "::", renderKind k] ]

132 , [ Wrap kinded $ \k ty -> mintersperse sp [ty, syntax "::", renderKind k] ]

121 ]

133 ]

tests/TestDocs.hs+30

@@ -17,6 +17,7 @@ import System.Exit

18import qualified Language.PureScript as P

19import qualified Language.PureScript.Docs as Docs

20+import Language.PureScript.Docs.AsMarkdown (codeToString)

20import qualified Language.PureScript.Publish as Publish

21import qualified Language.PureScript.Publish as Publish

21import qualified Language.PureScript.Publish.ErrorsWarnings as Publish

22import qualified Language.PureScript.Publish.ErrorsWarnings as Publish

@@ -59,6 +60,10 @@ data Assertion

59 -- | Assert that a particular value declaration exists, and its type

60 -- | Assert that a particular value declaration exists, and its type

60 -- satisfies the given predicate.

61 -- satisfies the given predicate.

61 | ValueShouldHaveTypeSignature P.ModuleName String (ShowFn (P.Type -> Bool))

62 | ValueShouldHaveTypeSignature P.ModuleName String (ShowFn (P.Type -> Bool))

63+ -- | Assert that a particular type alias exists, and its corresponding

64+ -- type, when rendered, matches a given string exactly

65+ -- fields: module, type synonym name, expected type

66+ | TypeSynonymShouldRenderAs P.ModuleName String String

62 deriving (Show)

67 deriving (Show)

64newtype ShowFn a = ShowFn a

69newtype ShowFn a = ShowFn a

@@ -85,6 +90,9 @@ data AssertionFailure

85 -- should have been.

90 -- should have been.

86 -- Fields: module name, declaration name, actual type.

91 -- Fields: module name, declaration name, actual type.

87 | ValueDeclarationWrongType P.ModuleName String P.Type

92 | ValueDeclarationWrongType P.ModuleName String P.Type

93+ -- | A Type synonym has been rendered in an unexpected format

94+ -- Fields: module name, declaration name, expected rendering, actual rendering

95+ | TypeSynonymMismatch P.ModuleName String String String

88 deriving (Show)

96 deriving (Show)

90data AssertionResult

98data AssertionResult

@@ -149,6 +157,21 @@ runAssertion assertion Docs.Module{..} =

149 Fail (WrongDeclarationType mn decl "value"

157 Fail (WrongDeclarationType mn decl "value"

150 (Docs.declInfoToString declInfo))

158 (Docs.declInfoToString declInfo))

151

159

160+ TypeSynonymShouldRenderAs mn decl expected ->

161+ case find ((==) decl . Docs.declTitle) (declarationsFor mn) of

162+ Nothing ->

163+ Fail (NotDocumented mn decl)

164+ Just Docs.Declaration{..} ->

165+ case declInfo of

166+ Docs.TypeSynonymDeclaration [] ty ->

167+ let actual = codeToString (Docs.renderType ty) in

168+ if actual == expected

169+ then Pass

170+ else Fail (TypeSynonymMismatch mn decl expected actual)

171+ _ ->

172+ Fail (WrongDeclarationType mn decl "synonym"

173+ (Docs.declInfoToString declInfo))

174+

152 where

175 where

153 declarationsFor mn =

176 declarationsFor mn =

154 if mn == modName

177 if mn == modName

@@ -261,6 +284,13 @@ testCases =

261 , ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "anInt" (ShowFn (P.tyInt ==))

284 , ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "anInt" (ShowFn (P.tyInt ==))

262 , ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "aNumber" (ShowFn (P.tyNumber ==))

285 , ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "aNumber" (ShowFn (P.tyNumber ==))

263 ])

286 ])

287+

288+ , ("ConstrainedArgument",

289+ [ TypeSynonymShouldRenderAs (n "ConstrainedArgument") "WithoutArgs" "forall a. (Partial => a) -> a"

290+ , TypeSynonymShouldRenderAs (n "ConstrainedArgument") "WithArgs" "forall a. (Foo a => a) -> a"

291+ , TypeSynonymShouldRenderAs (n "ConstrainedArgument") "MultiWithoutArgs" "forall a. ((Partial, Partial) => a) -> a"

292+ , TypeSynonymShouldRenderAs (n "ConstrainedArgument") "MultiWithArgs" "forall a b. ((Foo a, Foo b) => a) -> a"

293+ ])

264 ]

294 ]

265

295

266 where

296 where