12fdbae · rowtype-yoga/purescript-native

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

on golang help sign in

Merge branch 'master' into pure11

12fdbaeAndy Arvanitis11 years ago

.travis.yml+2−2

compare with golang

unifiedsplit

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

35 fi

36 - mkdir -p .cabal-sandbox

37 - cabal sandbox init --sandbox .cabal-sandbox

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

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|sourcemap|bower-json' > cabal.config; fi

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

40 - cabal install --only-dependencies --enable-tests

41 - cabal install hpc-coveralls

42 # 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

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

purescript.cabal+1−1

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

75 bytestring -any,

76 text -any,

77 split -any,

78− language-javascript == 0.5.*,

78+ language-javascript == 0.6.*,

79 syb -any,

80 Glob >= 0.7 && < 0.8,

81 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)

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

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

510 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

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

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

514 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

43import Control.Monad

44import Control.Monad.Error.Class

45import Language.JavaScript.Parser

46+import Language.JavaScript.Parser.AST

47import qualified Paths_purescript as Paths

48import qualified Paths_purescript as Paths

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

83data ExportType

84data ExportType

84 = RegularExport String

85 = RegularExport String

85 | ForeignReexport

86 | ForeignReexport

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

87+ deriving (Show, Eq, Ord)

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

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

89--

90--

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

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

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

96-- into the output during codegen.

97-- into the output during codegen.

97data ModuleElement

98data ModuleElement

98− = Require JSNode String (Either String ModuleIdentifier)

99+ = Require JSStatement String (Either String ModuleIdentifier)

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

100+ | Member JSStatement Bool String JSExpression [Key]

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

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

101− | Other JSNode

102+ | Other JSStatement

102− deriving (Show, Read)

103+ deriving (Show)

103

104

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

105-- | 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)

106

107

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

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

108printErrorMessage :: ErrorMessage -> [String]

109printErrorMessage :: ErrorMessage -> [String]

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

131 displayIdentifier (ModuleIdentifier name ty) =

132 displayIdentifier (ModuleIdentifier name ty) =

132 name ++ " (" ++ showModuleType ty ++ ")"

133 name ++ " (" ++ showModuleType ty ++ ")"

133

134

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−

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

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

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

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

141checkImportPath _ "./foreign" m _ =

137checkImportPath _ "./foreign" m _ =

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

179

175

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

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

181 expandDeps :: ModuleElement -> ModuleElement

177 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)

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

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

184 where

180 where

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

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

186 expandDeps other = other

182 expandDeps other = other

187

183

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

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

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

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

190 where

186 where

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

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

192− toReference (JSMemberDot [ mn ] _ nm)

188+ toReference (JSMemberDot mn _ nm)

193− | JSIdentifier mn' <- node mn

189+ | JSIdentifier _ mn' <- mn

194− , JSIdentifier nm' <- node nm

190+ , JSIdentifier _ nm' <- nm

195 , Just mid <- lookup mn' imports

191 , Just mid <- lookup mn' imports

196 = [(mid, nm')]

192 = [(mid, nm')]

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

193+ toReference (JSMemberSquare mn _ nm _)

198− | JSIdentifier mn' <- node mn

194+ | JSIdentifier _ mn' <- mn

199− , JSExpression [ s ] <- node nm

195+ , Just nm' <- fromStringLiteral nm

200− , JSStringLiteral _ nm' <- node s

201 , Just mid <- lookup mn' imports

196 , Just mid <- lookup mn' imports

202 = [(mid, nm')]

197 = [(mid, nm')]

203− toReference (JSIdentifier nm)

198+ toReference (JSIdentifier _ nm)

204 | nm `elem` boundNames

199 | nm `elem` boundNames

205 = [(m, nm)]

200 = [(m, nm)]

206 toReference _ = []

201 toReference _ = []

207

202

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+

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

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

209--

221--

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

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

211-- Other constructor.

223-- 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

213toModule requirePath mids mid top

225toModule requirePath mids mid top

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

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

215 | otherwise = err InvalidTopLevel

227 | otherwise = err InvalidTopLevel

216 where

228 where

217 err = throwError . ErrorInModule mid

229 err = throwError . ErrorInModule mid

218

230

219− toModuleElement :: JSNode -> m ModuleElement

231+ toModuleElement :: JSStatement -> m ModuleElement

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

220− toModuleElement n

233+ toModuleElement stmt

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

234+ | JSVariable _ jsInit _ <- stmt

222− , JSLiteral "var" <- node var

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

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

224− , JSIdentifier importName <- node impN

236+ , JSIdentifier _ importName <- var

225− , JSLiteral "=" <- node eq

237+ , JSVarInit _ jsInitEx <- varInit

226− , JSIdentifier "require" <- node req

238+ , JSMemberExpression req _ argsE _ <- jsInitEx

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

239+ , JSIdentifier _ "require" <- req

228− , JSStringLiteral _ importPath <- node impS

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

229 , importPath' <- checkImportPath requirePath importPath mid mids

241 , importPath' <- checkImportPath requirePath importPath mid mids

230− = pure (Require n importName importPath')

242+ = pure (Require stmt importName importPath')

243+ -- var foo = expr;

231− toModuleElement n

244+ toModuleElement stmt

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

245+ | JSVariable _ jsInit _ <- stmt

233− , JSLiteral "var" <- node var

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

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

235− , JSIdentifier name <- node declN

247+ , JSIdentifier _ name <- var

236− , JSLiteral "=" <- node eq

248+ , JSVarInit _ decl <- varInit

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

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

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

238− toModuleElement n

251+ toModuleElement stmt

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

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

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

253+ , Just name <- accessor e

241− , JSOperator eq <- node op

242− , JSLiteral "=" <- node eq

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

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

244 where

255 where

245− accessor :: Node -> Maybe String

256+ accessor :: JSExpression -> Maybe String

246− accessor (JSMemberDot [ exports ] _ nm)

257+ accessor (JSMemberDot exports _ nm)

247− | JSIdentifier "exports" <- node exports

258+ | JSIdentifier _ "exports" <- exports

248− , JSIdentifier name <- node nm

259+ , JSIdentifier _ name <- nm

249 = Just name

260 = Just name

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

261+ accessor (JSMemberSquare exports _ nm _)

251− | JSIdentifier "exports" <- node exports

262+ | JSIdentifier _ "exports" <- exports

252− , JSExpression [e] <- node nm

263+ , Just name <- fromStringLiteral nm

253− , JSStringLiteral _ name <- node e

254 = Just name

264 = Just name

255 accessor _ = Nothing

265 accessor _ = Nothing

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

256− toModuleElement n

267+ toModuleElement stmt

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

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

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

269+ , JSMemberDot module' _ exports <- e

259− , JSIdentifier "module" <- node mn

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

260− , JSIdentifier "exports" <- node e

271+ , JSIdentifier _ "exports" <- exports

261− , JSOperator eq <- node op

262− , JSLiteral "=" <- node eq

263− , JSObjectLiteral _ props _ <- node obj

272+ , JSObjectLiteral _ props _ <- decl

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

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

265 where

274 where

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

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

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

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

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

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

269− <*> extractLabel (node name)

278+ <*> extractLabel name

270− toExport _ = err UnsupportedExport

279+ toExport _ = err UnsupportedExport

271−

280+

272− exportType :: Node -> m ExportType

281+ exportType :: JSExpression -> m ExportType

273− exportType (JSMemberDot [f] _ _)

282+ exportType (JSMemberDot f _ _)

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

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

275− = pure ForeignReexport

284+ = pure ForeignReexport

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

285+ exportType (JSMemberSquare f _ _ _)

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

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

278− = pure ForeignReexport

287+ = pure ForeignReexport

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

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

280− exportType _ = err UnsupportedExport

289+ exportType _ = err UnsupportedExport

281−

290+--

282− extractLabel :: Node -> m String

291+ extractLabel :: JSPropertyName -> m String

283− extractLabel (JSStringLiteral _ nm) = pure nm

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

284− extractLabel (JSIdentifier nm) = pure nm

293+ extractLabel (JSPropertyIdent _ nm) = pure nm

285− extractLabel _ = err UnsupportedExport

294+ extractLabel _ = err UnsupportedExport

286−

295+

287− isSeparator :: Node -> Bool

288− isSeparator (JSLiteral ",") = True

289− isSeparator _ = False

290 toModuleElement other = pure (Other other)

296 toModuleElement other = pure (Other other)

291

297

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

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

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

339 where

345 where

340 go :: [ModuleElement] -> [ModuleElement]

346 go :: [ModuleElement] -> [ModuleElement]

341 go [] = []

347 go [] = []

342− go (d : Other semi : rest)

343− | JSLiteral ";" <- node semi

344− , not (isDeclUsed d)

345− = go rest

346 go (d : rest)

348 go (d : rest)

347 | not (isDeclUsed d) = go rest

349 | not (isDeclUsed d) = go rest

348 | otherwise = d : go rest

350 | otherwise = d : go rest

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

405 -> String -- ^ namespace

407 -> String -- ^ namespace

406 -> [Module] -- ^ input modules

408 -> [Module] -- ^ input modules

407 -> String

409 -> 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)

409 where

411 where

410− moduleToJS :: Module -> [JSNode]

412+ moduleToJS :: Module -> [JSStatement]

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

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

412 where

414 where

413− declToJS :: ModuleElement -> [JSNode]

415+ declToJS :: ModuleElement -> [JSStatement]

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

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

415 declToJS (Other n) = [n]

417 declToJS (Other n) = [n]

416 declToJS (Require _ nm req) =

418 declToJS (Require _ nm req) =

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

419+ [

420+ JSVariable lfsp

421+ (cList [

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

422+ JSVarInitExpression (JSIdentifier sp nm)

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

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

420− ]

424+ ]) (JSSemi JSNoAnnot)

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

425+ ]

422 declToJS (ExportsList exps) = map toExport exps

426 declToJS (ExportsList exps) = map toExport exps

423

427

424 where

428 where

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

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

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

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

431+ JSAssignStatement

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

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

428− (nt (JSLiteral "["))

433+ (str nm) JSNoAnnot)

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

434+ (JSAssign sp)

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

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

432− , reindent val

435+ val

433− , nt (JSLiteral ";")

436+ (JSSemi JSNoAnnot)

434− ])

437+

435−

438+ -- comma lists are reverse-consed

436− reindent :: JSNode -> JSNode

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

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

440+ cList [] = JSLNil

438− reindent nn = nn

441+ cList [x] = JSLOne x

439−

442+ cList l = go $ reverse l

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

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]

441 indent = everywhere (mkT squash)

449 indent = everywhere (mkT squash)

442 where

450 where

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

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

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

444− squash nn = nn

445

453

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

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

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

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

448 splat ann = ann

456 splat ann = ann

449

457

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

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

451−

459+

452− prelude :: [JSNode]

460+ prelude :: JSStatement

453− prelude =

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

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

455− , WhiteSpace tokenPosnEmpty "\n"

462+ , WhiteSpace tokenPosnEmpty "\n" ])

456− ])

463+ (cList [

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

464+ JSVarInitExpression (JSIdentifier sp optionsNamespace)

458− [ sp (JSLiteral "=")

465+ (JSVarInit sp (emptyObj sp))

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

466+ ]) (JSSemi JSNoAnnot)

460− []

467+

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

468+ require :: String -> JSExpression

462− ])

469+ require mn =

463− ]

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

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

471+

465− , lf

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

466− ]

473+ moduleReference a mn =

474+ JSMemberSquare (JSIdentifier a optionsNamespace) JSNoAnnot

475+ (str mn) JSNoAnnot

467

476

468− require :: String -> [JSNode]

477+ str :: String -> JSExpression

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

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

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

471− ]

472

479

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 "]")))

479

480

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

481+ emptyObj :: JSAnnot -> JSExpression

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

483+

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

481 wrap mn ds =

485 wrap mn ds =

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

486+ [

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

487+ JSMethodCall (JSExpressionParen lf (JSFunctionExpression JSNoAnnot JSIdentNone JSNoAnnot

484− []

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

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

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

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

490+ JSNoAnnot)

487− (lf : ds)

491+ JSNoAnnot

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

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

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 ]

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

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

494+ JSNoAnnot

496− [ emptyObj ])

495+ (JSSemi JSNoAnnot)

497− ])

498− ]

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

500− ])

501− , nt (JSLiteral ";")

502− , lf

503 ]

496 ]

504 where

497 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

506

505

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

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

508+

507− runMain :: String -> [JSNode]

509+ runMain :: String -> [JSStatement]

508 runMain mn =

510 runMain mn =

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

511+ [JSMethodCall

510− (nt (JSLiteral "["))

512+ (JSMemberDot (moduleReference lf mn) JSNoAnnot

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

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

513− ]

514− (nt (JSLiteral "."))

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

513+ (JSIdentifier JSNoAnnot "main"))

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

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

517− ])

518− , nt (JSLiteral ";")

519− ]

520

515

521− nt :: Node -> JSNode

516+ lf :: JSAnnot

522− nt n = NT n tokenPosnEmpty []

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

523

518

524− lf :: JSNode

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

526

519

527− sp :: Node -> JSNode

520+ lfsp :: JSAnnot

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

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

529

522

530− nl :: Node -> JSNode

523+ sp :: JSAnnot

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

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

532

525

533-- | The bundling function.

526-- | The bundling function.

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

527-- 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

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 ]

stack-lts-5.yaml+1

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

3- '.'

4extra-deps:

5- bower-json-0.8.0

6+- language-javascript-0.6.0.4

6flags: {}

7flags: {}

stack-nightly.yaml+2−1

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

1flags: {}

2packages:

3- '.'

4−extra-deps: []

4+extra-deps:

5+- language-javascript-0.6.0.4

5resolver: nightly-2016-03-17

6resolver: nightly-2016-03-17

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