git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #1984 from LiamGoodacre/fix/renderdocs

Fix for rendered constrained types needing parens.

commitd86e085e48cd3e481e18bbcc1806361c0652e7fb authorPhil Freeman <paf31@cantab.net> dateSat 2 Apr 2016, 12:00 (11 years ago) parent762c98c838ba7b
5 files changed+65−12
compare with golang
unifiedsplit
CONTRIBUTORS.md+1 examples/docs/src/ConstrainedArgument.purs+9 src/Language/PureScript/Docs/AsMarkdown.hs+1 src/Language/PureScript/Docs/RenderedCode/Render.hs+24−12 tests/TestDocs.hs+30
CONTRIBUTORS.md+1
@@ -68,6 +68,7 @@ This file lists the contributors to the PureScript compiler project, and the ter
6868- [@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).
6969- [@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.
7070- [@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).
7172
7273### Companies
7374
examples/docs/src/ConstrainedArgument.pursnew file+9
@@ -0,0 +1,9 @@
1+module ConstrainedArgument where
2+
3+class Foo t
4+
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
9+
src/Language/PureScript/Docs/AsMarkdown.hs+1
@@ -6,6 +6,7 @@ module Language.PureScript.Docs.AsMarkdown
66 , Docs
77 , runDocs
88 , modulesAsMarkdown
9+ , codeToString
910 ) where
1011
1112import Prelude ()
src/Language/PureScript/Docs/RenderedCode/Render.hs+24−12
@@ -44,18 +44,6 @@ typeLiterals = mkPattern match
4444 ]
4545 match (TypeConstructor (Qualified mn name)) =
4646 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
5947 match REmpty =
6048 Just (syntax "()")
6149 match row@RCons{} =
@@ -63,6 +51,23 @@ typeLiterals = mkPattern match
6351 match _ =
6452 Nothing
6553
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+
6671-- |
6772-- Render code representing a Row
6873--
@@ -104,6 +109,12 @@ kinded = mkPattern match
104109 match (KindedType t k) = Just (k, t)
105110 match _ = Nothing
106111
112+constrained :: Pattern () Type ([Constraint], Type)
113+constrained = mkPattern match
114+ where
115+ match (ConstrainedType deps ty) = Just (deps, ty)
116+ match _ = Nothing
117+
107118matchTypeAtom :: Pattern () Type RenderedCode
108119matchTypeAtom = typeLiterals <+> fmap parens matchType
109120 where
@@ -116,6 +127,7 @@ matchType = buildPrettyPrinter operators matchTypeAtom
116127 operators =
117128 OperatorTable [ [ AssocL typeApp $ \f x -> f <> sp <> x ]
118129 , [ AssocR appliedFunction $ \arg ret -> mintersperse sp [arg, syntax "->", ret] ]
130+ , [ Wrap constrained $ \deps ty -> renderConstraints deps ty ]
119131 , [ Wrap forall_ $ \idents ty -> mconcat [syntax "forall", sp, mintersperse sp (map ident idents), syntax ".", sp, ty] ]
120132 , [ Wrap kinded $ \k ty -> mintersperse sp [ty, syntax "::", renderKind k] ]
121133 ]
tests/TestDocs.hs+30
@@ -17,6 +17,7 @@ import System.Exit
1717
1818import qualified Language.PureScript as P
1919import qualified Language.PureScript.Docs as Docs
20+import Language.PureScript.Docs.AsMarkdown (codeToString)
2021import qualified Language.PureScript.Publish as Publish
2122import qualified Language.PureScript.Publish.ErrorsWarnings as Publish
2223
@@ -59,6 +60,10 @@ data Assertion
5960 -- | Assert that a particular value declaration exists, and its type
6061 -- satisfies the given predicate.
6162 | 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
6267 deriving (Show)
6368
6469newtype ShowFn a = ShowFn a
@@ -85,6 +90,9 @@ data AssertionFailure
8590 -- should have been.
8691 -- Fields: module name, declaration name, actual type.
8792 | 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
8896 deriving (Show)
8997
9098data AssertionResult
@@ -149,6 +157,21 @@ runAssertion assertion Docs.Module{..} =
149157 Fail (WrongDeclarationType mn decl "value"
150158 (Docs.declInfoToString declInfo))
151159
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+
152175 where
153176 declarationsFor mn =
154177 if mn == modName
@@ -261,6 +284,13 @@ testCases =
261284 , ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "anInt" (ShowFn (P.tyInt ==))
262285 , ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "aNumber" (ShowFn (P.tyNumber ==))
263286 ])
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+ ])
264294 ]
265295
266296 where