12fdbae · rowtype-yoga/purescript-native

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

Merge branch 'master' into pure11

commit12fdbae9e6cb21cc40130aad77d62cfbe9e54df6 authorAndy Arvanitis <andyarvanitis@gmail.com> dateSat 2 Apr 2016, 17:39 (11 years ago) parent045e69d d86e085

11 files changed+254−206

compare with golang

unifiedsplit

.travis.yml+2−2 CONTRIBUTORS.md+1 examples/docs/src/ConstrainedArgument.purs+9 purescript.cabal+1−1 src/Language/PureScript/AST/Traversals.hs+1−1 src/Language/PureScript/Bundle.hs+182−189 src/Language/PureScript/Docs/AsMarkdown.hs+1 src/Language/PureScript/Docs/RenderedCode/Render.hs+24−12 stack-lts-5.yaml+1 stack-nightly.yaml+2−1 tests/TestDocs.hs+30

.travis.yml+2−2

@@ -35,8 +35,8 @@ install:

3535 fi

3636 - mkdir -p .cabal-sandbox

3737 - cabal sandbox init --sandbox .cabal-sandbox

38− # Download stackage cabal.config, not sure whether filtering is necessary

39− - if [ -n "$STACKAGE" ]; then curl https://www.stackage.org/$STACKAGE/cabal.config | egrep -v 'purescript|sourcemap|bower-json' > cabal.config; fi

38+ # Download stackage cabal.config. Filter this package and 'extra deps'

39+ - if [ -n "$STACKAGE" ]; then curl https://www.stackage.org/$STACKAGE/cabal.config | egrep -v 'purescript|language-javascript|bower-json' > cabal.config; fi

4040 - cabal install --only-dependencies --enable-tests

4141 - cabal install hpc-coveralls

4242 # Snapshot state of the sandbox now, so we don't need to make new one for test install

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

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

purescript.cabal+1−1

@@ -75,7 +75,7 @@ library

7575 bytestring -any,

7676 text -any,

7777 split -any,

78− language-javascript == 0.5.*,

78+ language-javascript == 0.6.*,

7979 syb -any,

8080 Glob >= 0.7 && < 0.8,

8181 process >= 1.2.0 && < 1.5,

src/Language/PureScript/AST/Traversals.hs+1−1

@@ -508,7 +508,7 @@ everythingWithScope f g h i j = (f'', g'', h'', i'', \s -> snd . j'' s)

508508 g' :: S.Set Ident -> Expr -> r

509509 g' s (Literal l) = lit g'' s l

510510 g' s (UnaryMinus v1) = g'' s v1

511− g' s (BinaryNoParens op v1 v2) = g' s op <> g' s v1 <> g' s v2

511+ g' s (BinaryNoParens op v1 v2) = g'' s op <> g'' s v1 <> g'' s v2

512512 g' s (Parens v1) = g'' s v1

513513 g' s (OperatorSection op (Left v)) = g'' s op <> g'' s v

514514 g' s (OperatorSection op (Right v)) = g'' s op <> g'' s v

src/Language/PureScript/Bundle.hs+182−189

@@ -43,6 +43,7 @@ import qualified Data.Set as S

4343import Control.Monad

4444import Control.Monad.Error.Class

4545import Language.JavaScript.Parser

46+import Language.JavaScript.Parser.AST

4647

4748import qualified Paths_purescript as Paths

4849

@@ -83,7 +84,7 @@ type Key = (ModuleIdentifier, String)

8384data ExportType

8485 = RegularExport String

8586 | ForeignReexport

86− deriving (Show, Read, Eq, Ord)

87+ deriving (Show, Eq, Ord)

8788

8889-- | There are four types of module element we are interested in:

8990--

@@ -95,14 +96,14 @@ data ExportType

9596-- Each is labelled with the original AST node which generated it, so that we can dump it back

9697-- into the output during codegen.

9798data ModuleElement

98− = Require JSNode String (Either String ModuleIdentifier)

99− | Member JSNode Bool String [JSNode] [Key]

100− | ExportsList [(ExportType, String, JSNode, [Key])]

101− | Other JSNode

102− deriving (Show, Read)

99+ = Require JSStatement String (Either String ModuleIdentifier)

100+ | Member JSStatement Bool String JSExpression [Key]

101+ | ExportsList [(ExportType, String, JSExpression, [Key])]

102+ | Other JSStatement

103+ deriving (Show)

103104

104105-- | A module is just a list of elements of the types listed above.

105−data Module = Module ModuleIdentifier [ModuleElement] deriving (Show, Read)

106+data Module = Module ModuleIdentifier [ModuleElement] deriving (Show)

106107

107108-- | Prepare an error message for consumption by humans.

108109printErrorMessage :: ErrorMessage -> [String]

@@ -131,11 +132,6 @@ printErrorMessage (ErrorInModule mid e) =

131132 displayIdentifier (ModuleIdentifier name ty) =

132133 name ++ " (" ++ showModuleType ty ++ ")"

133134

134−-- | Unpack the node inside a JSNode. This is useful when pattern matching.

135−node :: JSNode -> Node

136−node (NN n) = n

137−node (NT n _ _) = n

138−

139135-- | Calculate the ModuleIdentifier which a require(...) statement imports.

140136checkImportPath :: Maybe FilePath -> String -> ModuleIdentifier -> S.Set String -> Either String ModuleIdentifier

141137checkImportPath _ "./foreign" m _ =

@@ -179,114 +175,124 @@ withDeps (Module modulePath es) = Module modulePath (map expandDeps es)

179175

180176 -- | Calculate dependencies and add them to the current element.

181177 expandDeps :: ModuleElement -> ModuleElement

182− expandDeps (Member n f nm decl _) = Member n f nm decl (nub (concatMap (dependencies modulePath) decl))

178+ expandDeps (Member n f nm decl _) = Member n f nm decl (nub $ dependencies modulePath decl)

183179 expandDeps (ExportsList exps) = ExportsList (map expand exps)

184180 where

185181 expand (ty, nm, n1, _) = (ty, nm, n1, nub (dependencies modulePath n1))

186182 expandDeps other = other

187183

188− dependencies :: ModuleIdentifier -> JSNode -> [(ModuleIdentifier, String)]

184+ dependencies :: ModuleIdentifier -> JSExpression -> [(ModuleIdentifier, String)]

189185 dependencies m = everything (++) (mkQ [] toReference)

190186 where

191− toReference :: Node -> [(ModuleIdentifier, String)]

192− toReference (JSMemberDot [ mn ] _ nm)

193− | JSIdentifier mn' <- node mn

194− , JSIdentifier nm' <- node nm

187+ toReference :: JSExpression -> [(ModuleIdentifier, String)]

188+ toReference (JSMemberDot mn _ nm)

189+ | JSIdentifier _ mn' <- mn

190+ , JSIdentifier _ nm' <- nm

195191 , Just mid <- lookup mn' imports

196192 = [(mid, nm')]

197− toReference (JSMemberSquare [ mn ] _ nm _)

198− | JSIdentifier mn' <- node mn

199− , JSExpression [ s ] <- node nm

200− , JSStringLiteral _ nm' <- node s

193+ toReference (JSMemberSquare mn _ nm _)

194+ | JSIdentifier _ mn' <- mn

195+ , Just nm' <- fromStringLiteral nm

201196 , Just mid <- lookup mn' imports

202197 = [(mid, nm')]

203− toReference (JSIdentifier nm)

198+ toReference (JSIdentifier _ nm)

204199 | nm `elem` boundNames

205200 = [(m, nm)]

206201 toReference _ = []

207202

203+-- String literals include the quote chars

204+fromStringLiteral :: JSExpression -> Maybe String

205+fromStringLiteral (JSStringLiteral _ str) = Just $ trimStringQuotes str

206+fromStringLiteral _ = Nothing

207+

208+trimStringQuotes :: String -> String

209+trimStringQuotes str = reverse $ drop 1 $ reverse $ drop 1 $ str

210+

211+commaList :: JSCommaList a -> [a]

212+commaList JSLNil = []

213+commaList (JSLOne x) = [x]

214+commaList (JSLCons l _ x) = commaList l ++ [x]

215+

216+trailingCommaList :: JSCommaTrailingList a -> [a]

217+trailingCommaList (JSCTLComma l _) = commaList l

218+trailingCommaList (JSCTLNone l) = commaList l

219+

208220-- | Attempt to create a Module from a Javascript AST.

209221--

210222-- Each type of module element is matched using pattern guards, and everything else is bundled into the

211223-- Other constructor.

212−toModule :: forall m. (MonadError ErrorMessage m) => Maybe FilePath -> S.Set String -> ModuleIdentifier -> JSNode -> m Module

224+toModule :: forall m. (MonadError ErrorMessage m) => Maybe FilePath -> S.Set String -> ModuleIdentifier -> JSAST -> m Module

213225toModule requirePath mids mid top

214− | JSSourceElementsTop ns <- node top = Module mid <$> traverse toModuleElement ns

226+ | JSAstProgram smts _ <- top = Module mid <$> traverse toModuleElement smts

215227 | otherwise = err InvalidTopLevel

216228 where

217229 err = throwError . ErrorInModule mid

218230

219− toModuleElement :: JSNode -> m ModuleElement

220− toModuleElement n

221− | JSVariables var [ varIntro ] _ <- node n

222− , JSLiteral "var" <- node var

223− , JSVarDecl impN [ eq, req, impP ] <- node varIntro

224− , JSIdentifier importName <- node impN

225− , JSLiteral "=" <- node eq

226− , JSIdentifier "require" <- node req

227− , JSArguments _ [ impS ] _ <- node impP

228− , JSStringLiteral _ importPath <- node impS

231+ toModuleElement :: JSStatement -> m ModuleElement

232+ -- var ModuleName = require("file");

233+ toModuleElement stmt

234+ | JSVariable _ jsInit _ <- stmt

235+ , [JSVarInitExpression var varInit] <- commaList jsInit

236+ , JSIdentifier _ importName <- var

237+ , JSVarInit _ jsInitEx <- varInit

238+ , JSMemberExpression req _ argsE _ <- jsInitEx

239+ , JSIdentifier _ "require" <- req

240+ , [ Just importPath ] <- map fromStringLiteral (commaList argsE)

229241 , importPath' <- checkImportPath requirePath importPath mid mids

230− = pure (Require n importName importPath')

231− toModuleElement n

232− | JSVariables var [ varIntro ] _ <- node n

233− , JSLiteral "var" <- node var

234− , JSVarDecl declN (eq : decl) <- node varIntro

235− , JSIdentifier name <- node declN

236− , JSLiteral "=" <- node eq

237− = pure (Member n False name decl [])

238− toModuleElement n

239− | JSExpression (e : op : decl) <- node n

240− , Just name <- accessor (node e)

241− , JSOperator eq <- node op

242− , JSLiteral "=" <- node eq

243− = pure (Member n True name decl [])

242+ = pure (Require stmt importName importPath')

243+ -- var foo = expr;

244+ toModuleElement stmt

245+ | JSVariable _ jsInit _ <- stmt

246+ , [JSVarInitExpression var varInit] <- commaList jsInit

247+ , JSIdentifier _ name <- var

248+ , JSVarInit _ decl <- varInit

249+ = pure (Member stmt False name decl [])

250+ -- exports.foo = expr; exports["foo"] = expr;

251+ toModuleElement stmt

252+ | JSAssignStatement e (JSAssign _) decl _ <- stmt

253+ , Just name <- accessor e

254+ = pure (Member stmt True name decl [])

244255 where

245− accessor :: Node -> Maybe String

246− accessor (JSMemberDot [ exports ] _ nm)

247− | JSIdentifier "exports" <- node exports

248− , JSIdentifier name <- node nm

256+ accessor :: JSExpression -> Maybe String

257+ accessor (JSMemberDot exports _ nm)

258+ | JSIdentifier _ "exports" <- exports

259+ , JSIdentifier _ name <- nm

249260 = Just name

250− accessor (JSMemberSquare [ exports ] _ nm _)

251− | JSIdentifier "exports" <- node exports

252− , JSExpression [e] <- node nm

253− , JSStringLiteral _ name <- node e

261+ accessor (JSMemberSquare exports _ nm _)

262+ | JSIdentifier _ "exports" <- exports

263+ , Just name <- fromStringLiteral nm

254264 = Just name

255265 accessor _ = Nothing

256− toModuleElement n

257− | JSExpression (mnExp : op : obj: _) <- node n

258− , JSMemberDot [ mn ] _ e <- node mnExp

259− , JSIdentifier "module" <- node mn

260− , JSIdentifier "exports" <- node e

261− , JSOperator eq <- node op

262− , JSLiteral "=" <- node eq

263− , JSObjectLiteral _ props _ <- node obj

264− = ExportsList <$> traverse toExport (filter (not . isSeparator) (map node props))

266+ -- module.exports = { ... }

267+ toModuleElement stmt

268+ | JSAssignStatement e (JSAssign _) decl _ <- stmt

269+ , JSMemberDot module' _ exports <- e

270+ , JSIdentifier _ "module" <- module'

271+ , JSIdentifier _ "exports" <- exports

272+ , JSObjectLiteral _ props _ <- decl

273+ = (ExportsList <$> traverse toExport (trailingCommaList props))

265274 where

266− toExport :: Node -> m (ExportType, String, JSNode, [Key])

267− toExport (JSPropertyNameandValue name _ [val] ) =

268− (,,val,[]) <$> exportType (node val)

269− <*> extractLabel (node name)

270− toExport _ = err UnsupportedExport

271−

272− exportType :: Node -> m ExportType

273− exportType (JSMemberDot [f] _ _)

274− | JSIdentifier "$foreign" <- node f

275− = pure ForeignReexport

276− exportType (JSMemberSquare [f] _ _ _)

277− | JSIdentifier "$foreign" <- node f

278− = pure ForeignReexport

279− exportType (JSIdentifier s) = pure (RegularExport s)

280− exportType _ = err UnsupportedExport

281−

282− extractLabel :: Node -> m String

283− extractLabel (JSStringLiteral _ nm) = pure nm

284− extractLabel (JSIdentifier nm) = pure nm

285− extractLabel _ = err UnsupportedExport

286−

287− isSeparator :: Node -> Bool

288− isSeparator (JSLiteral ",") = True

289− isSeparator _ = False

275+ toExport :: JSObjectProperty -> m (ExportType, String, JSExpression, [Key])

276+ toExport (JSPropertyNameandValue name _ [val]) =

277+ (,,val,[]) <$> exportType val

278+ <*> extractLabel name

279+ toExport _ = err UnsupportedExport

280+

281+ exportType :: JSExpression -> m ExportType

282+ exportType (JSMemberDot f _ _)

283+ | JSIdentifier _ "$foreign" <- f

284+ = pure ForeignReexport

285+ exportType (JSMemberSquare f _ _ _)

286+ | JSIdentifier _ "$foreign" <- f

287+ = pure ForeignReexport

288+ exportType (JSIdentifier _ s) = pure (RegularExport s)

289+ exportType _ = err UnsupportedExport

290+--

291+ extractLabel :: JSPropertyName -> m String

292+ extractLabel (JSPropertyString _ nm) = pure (trimStringQuotes nm)

293+ extractLabel (JSPropertyIdent _ nm) = pure nm

294+ extractLabel _ = err UnsupportedExport

295+

290296 toModuleElement other = pure (Other other)

291297

292298-- | Eliminate unused code based on the specified entry point set.

@@ -339,10 +345,6 @@ compile modules entryPoints = filteredModules

339345 where

340346 go :: [ModuleElement] -> [ModuleElement]

341347 go [] = []

342− go (d : Other semi : rest)

343− | JSLiteral ";" <- node semi

344− , not (isDeclUsed d)

345− = go rest

346348 go (d : rest)

347349 | not (isDeclUsed d) = go rest

348350 | otherwise = d : go rest

@@ -405,130 +407,121 @@ codeGen :: Maybe String -- ^ main module

405407 -> String -- ^ namespace

406408 -> [Module] -- ^ input modules

407409 -> String

408−codeGen optionsMainModule optionsNamespace ms = renderToString (NN (JSSourceElementsTop (prelude ++ concatMap moduleToJS ms ++ maybe [] runMain optionsMainModule)))

410+codeGen optionsMainModule optionsNamespace ms = renderToString (JSAstProgram (prelude : concatMap moduleToJS ms ++ maybe [] runMain optionsMainModule) JSNoAnnot)

409411 where

410− moduleToJS :: Module -> [JSNode]

412+ moduleToJS :: Module -> [JSStatement]

411413 moduleToJS (Module mn ds) = wrap (moduleName mn) (indent (concatMap declToJS ds))

412414 where

413− declToJS :: ModuleElement -> [JSNode]

415+ declToJS :: ModuleElement -> [JSStatement]

414416 declToJS (Member n _ _ _ _) = [n]

415417 declToJS (Other n) = [n]

416418 declToJS (Require _ nm req) =

417− [ NN (JSVariables (NT (JSLiteral "var") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n " ])

418− [ NN (JSVarDecl (sp (JSIdentifier nm))

419− (sp (JSLiteral "=") : either require (return . moduleReference sp . moduleName) req))

420− ]

421− (nt (JSLiteral ";"))) ]

419+ [

420+ JSVariable lfsp

421+ (cList [

422+ JSVarInitExpression (JSIdentifier sp nm)

423+ (JSVarInit sp $ either require (moduleReference sp . moduleName) req )

424+ ]) (JSSemi JSNoAnnot)

425+ ]

422426 declToJS (ExportsList exps) = map toExport exps

423427

424428 where

425− toExport :: (ExportType, String, JSNode, [Key]) -> JSNode

429+ toExport :: (ExportType, String, JSExpression, [Key]) -> JSStatement

426430 toExport (_, nm, val, _) =

427− NN (JSExpression [ NN (JSMemberSquare [ NT (JSIdentifier "exports") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n " ] ]

428− (nt (JSLiteral "["))

429− (NN (JSExpression [ nt (JSStringLiteral '"' nm) ]))

430− (nt (JSLiteral "]")))

431− , NN (JSOperator (sp (JSLiteral "=")))

432− , reindent val

433− , nt (JSLiteral ";")

434− ])

435−

436− reindent :: JSNode -> JSNode

437− reindent (NT n _ _) = sp n

438− reindent nn = nn

439−

440− indent :: [JSNode] -> [JSNode]

431+ JSAssignStatement

432+ (JSMemberSquare (JSIdentifier lfsp "exports") JSNoAnnot

433+ (str nm) JSNoAnnot)

434+ (JSAssign sp)

435+ val

436+ (JSSemi JSNoAnnot)

437+

438+ -- comma lists are reverse-consed

439+ cList :: [a] -> JSCommaList a

440+ cList [] = JSLNil

441+ cList [x] = JSLOne x

442+ cList l = go $ reverse l

443+ where

444+ go [x] = JSLOne x

445+ go (h:t)= JSLCons (go t) JSNoAnnot h

446+ go [] = error "Invalid case in comma-list"

447+

448+ indent :: [JSStatement] -> [JSStatement]

441449 indent = everywhere (mkT squash)

442450 where

443− squash (NT n pos ann) = NT n (keepCol pos) (map splat ann)

444− squash nn = nn

451+ squash JSNoAnnot = (JSAnnot (TokenPn 0 0 2) [])

452+ squash (JSAnnot pos ann) = JSAnnot (keepCol pos) (map splat ann)

445453

446454 splat (CommentA pos s) = CommentA (keepCol pos) s

447455 splat (WhiteSpace pos w) = WhiteSpace (keepCol pos) w

448456 splat ann = ann

449457

450− keepCol (TokenPn _ _ c) = TokenPn 0 0 (c + 2)

451−

452− prelude :: [JSNode]

453− prelude =

454− [ NN (JSVariables (NT (JSLiteral "var") tokenPosnEmpty [ CommentA tokenPosnEmpty ("// Generated by psc-bundle " ++ showVersion Paths.version)

455− , WhiteSpace tokenPosnEmpty "\n"

456− ])

457− [ NN (JSVarDecl (sp (JSIdentifier optionsNamespace))

458− [ sp (JSLiteral "=")

459− , NN (JSObjectLiteral (sp (JSLiteral "{"))

460− []

461− (sp (JSLiteral "}")))

462− ])

463− ]

464− (nt (JSLiteral ";")))

465− , lf

466− ]

458+ keepCol (TokenPn _ _ c) = TokenPn 0 0 (if c >= 0 then c + 2 else 2)

459+

460+ prelude :: JSStatement

461+ prelude = JSVariable (JSAnnot tokenPosnEmpty [ CommentA tokenPosnEmpty $ "// Generated by psc-bundle " ++ showVersion Paths.version

462+ , WhiteSpace tokenPosnEmpty "\n" ])

463+ (cList [

464+ JSVarInitExpression (JSIdentifier sp optionsNamespace)

465+ (JSVarInit sp (emptyObj sp))

466+ ]) (JSSemi JSNoAnnot)

467+

468+ require :: String -> JSExpression

469+ require mn =

470+ JSMemberExpression (JSIdentifier JSNoAnnot "require") JSNoAnnot (cList [ str mn ]) JSNoAnnot

471+

472+ moduleReference :: JSAnnot -> String -> JSExpression

473+ moduleReference a mn =

474+ JSMemberSquare (JSIdentifier a optionsNamespace) JSNoAnnot

475+ (str mn) JSNoAnnot

467476

468− require :: String -> [JSNode]

469− require mn = [ sp (JSIdentifier "require")

470− , NN (JSArguments (nt (JSLiteral "(")) [ nt (JSStringLiteral '"' mn) ] (nt (JSLiteral ")")))

471− ]

477+ str :: String -> JSExpression

478+ str s = JSStringLiteral JSNoAnnot $ "\"" ++ s ++ "\""

472479

473− moduleReference :: (Node -> JSNode) -> String -> JSNode

474− moduleReference f mn =

475− NN (JSMemberSquare [ f (JSIdentifier optionsNamespace) ]

476− (nt (JSLiteral "["))

477− (NN (JSExpression [ nt (JSStringLiteral '"' mn) ]))

478− (nt (JSLiteral "]")))

479480

480− wrap :: String -> [JSNode] -> [JSNode]

481+ emptyObj :: JSAnnot -> JSExpression

482+ emptyObj a = JSObjectLiteral a (JSCTLNone JSLNil) JSNoAnnot

483+

484+ wrap :: String -> [JSStatement] -> [JSStatement]

481485 wrap mn ds =

482− [ NN (JSExpression [ NN (JSExpressionParen (nt (JSLiteral "("))

483− (NN (JSExpression [ NN (JSFunctionExpression (nt (JSLiteral "function"))

484− []

485− (nt (JSLiteral "(") ) [nt (JSIdentifier "exports")] (nt (JSLiteral ")"))

486− (NN (JSBlock [sp (JSLiteral "{")]

487− (lf : ds)

488− [nl (JSLiteral "}")])))]))

489− (nt (JSLiteral ")")))

490− , NN (JSArguments (nt (JSLiteral "("))

491− [ NN (JSExpression [ moduleReference nt mn

492− , NN (JSOperator (sp (JSLiteral "=")))

493− , NN (JSExpressionBinary "||"

494− [ moduleReference sp mn ]

495− (sp (JSLiteral "||"))

496− [ emptyObj ])

497− ])

498− ]

499− (nt (JSLiteral ")")))

500− ])

501− , nt (JSLiteral ";")

502− , lf

486+ [

487+ JSMethodCall (JSExpressionParen lf (JSFunctionExpression JSNoAnnot JSIdentNone JSNoAnnot

488+ (JSLOne (JSIdentName JSNoAnnot "exports")) JSNoAnnot

489+ (JSBlock sp (lfHead ds) lf)) -- \n not quite in right place

490+ JSNoAnnot)

491+ JSNoAnnot

492+ (JSLOne (JSAssignExpression (moduleReference JSNoAnnot mn) (JSAssign sp)

493+ (JSExpressionBinary (moduleReference sp mn) (JSBinOpOr sp) (emptyObj sp))))

494+ JSNoAnnot

495+ (JSSemi JSNoAnnot)

503496 ]

504497 where

505− emptyObj = NN (JSObjectLiteral (sp (JSLiteral "{")) [] (nt (JSLiteral "}")))

498+ lfHead (h:t) = (addAnn (WhiteSpace tokenPosnEmpty "\n ") h) : t

499+ lfHead x = x

500+

501+ addAnn :: CommentAnnotation -> JSStatement -> JSStatement

502+ addAnn a (JSExpressionStatement (JSStringLiteral ann s) _) =

503+ (JSExpressionStatement (JSStringLiteral (appendAnn a ann) s) (JSSemi JSNoAnnot))

504+ addAnn _ x = x

506505

507− runMain :: String -> [JSNode]

506+ appendAnn a JSNoAnnot = (JSAnnot tokenPosnEmpty [a])

507+ appendAnn a (JSAnnot _ anns) = JSAnnot tokenPosnEmpty (a:anns ++ [WhiteSpace tokenPosnEmpty " "])

508+

509+ runMain :: String -> [JSStatement]

508510 runMain mn =

509− [ NN (JSExpression [ NN (JSMemberDot [ NN (JSMemberSquare [ nl (JSIdentifier optionsNamespace) ]

510− (nt (JSLiteral "["))

511− (NN (JSExpression [ nt (JSStringLiteral '"' mn) ]))

512− (nt (JSLiteral "]")))

513− ]

514− (nt (JSLiteral "."))

515− (nt (JSIdentifier "main")))

516− , NN (JSArguments (nt (JSLiteral "(")) [] (nt (JSLiteral ")")))

517− ])

518− , nt (JSLiteral ";")

519− ]

511+ [JSMethodCall

512+ (JSMemberDot (moduleReference lf mn) JSNoAnnot

513+ (JSIdentifier JSNoAnnot "main"))

514+ JSNoAnnot (cList []) JSNoAnnot (JSSemi JSNoAnnot)]

520515

521− nt :: Node -> JSNode

522− nt n = NT n tokenPosnEmpty []

516+ lf :: JSAnnot

517+ lf = JSAnnot tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n" ]

523518

524− lf :: JSNode

525− lf = NT (JSLiteral "") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n" ]

526519

527− sp :: Node -> JSNode

528− sp n = NT n tokenPosnEmpty [ WhiteSpace tokenPosnEmpty " " ]

520+ lfsp :: JSAnnot

521+ lfsp = JSAnnot tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n " ]

529522

530− nl :: Node -> JSNode

531− nl n = NT n tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n" ]

523+ sp :: JSAnnot

524+ sp = JSAnnot tokenPosnEmpty [ WhiteSpace tokenPosnEmpty " " ]

532525

533526-- | The bundling function.

534527-- This function performs dead code elimination, filters empty modules

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 ]

stack-lts-5.yaml+1

@@ -3,4 +3,5 @@ packages:

33- '.'

44extra-deps:

55- bower-json-0.8.0

6+- language-javascript-0.6.0.4

67flags: {}

stack-nightly.yaml+2−1

@@ -1,5 +1,6 @@

11flags: {}

22packages:

33- '.'

4−extra-deps: []

4+extra-deps:

5+- language-javascript-0.6.0.4

56resolver: nightly-2016-03-17

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