8700e35 · rowtype-yoga/purescript-native

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

on golang help sign in

Render comments in markdown docs, and generated JS and externs

8700e35Phil Freeman12 years ago

psc-docs/Main.hs+11−1

compare with golang

unifiedsplit

@@ -152,10 +152,20 @@ renderDeclaration n _ (P.TypeInstanceDeclaration name constraints className tys

152 [] -> ""

153 cs -> "(" ++ intercalate ", " (map (\(pn, tys') -> show pn ++ " " ++ unwords (map P.prettyPrintTypeAtom tys')) cs) ++ ") => "

154 atIndent n $ "instance " ++ show name ++ " :: " ++ constraintsText ++ show className ++ " " ++ unwords (map P.prettyPrintTypeAtom tys)

155−renderDeclaration n exps (P.PositionedDeclaration _ _ d) =

155+renderDeclaration n exps (P.PositionedDeclaration _ com d) = do

156+ renderComments n com

157+ spacer

156 renderDeclaration n exps d

158 renderDeclaration n exps d

157renderDeclaration _ _ _ = return ()

159renderDeclaration _ _ _ = return ()

158

160

161+renderComments :: Int -> [P.Comment] -> Docs

162+renderComments n cs = mapM_ (atIndent n) ls

163+ where

164+ ls = concatMap toLines cs

165+

166+ toLines (P.LineComment s) = [s]

167+ toLines (P.BlockComment s) = lines s

168+

159toTypeVar :: (String, Maybe P.Kind) -> P.Type

169toTypeVar :: (String, Maybe P.Kind) -> P.Type

160toTypeVar (s, Nothing) = P.TypeVar s

170toTypeVar (s, Nothing) = P.TypeVar s

161toTypeVar (s, Just k) = P.KindedType (P.TypeVar s) k

171toTypeVar (s, Just k) = P.KindedType (P.TypeVar s) k

src/Language/PureScript/CodeGen/JS.hs+20−12

@@ -13,7 +13,7 @@

13--

14-----------------------------------------------------------------------------

16−{-# LANGUAGE GADTs #-}

16+{-# LANGUAGE GADTs, ViewPatterns #-}

18module Language.PureScript.CodeGen.JS (

19 module AST,

@@ -23,7 +23,7 @@ module Language.PureScript.CodeGen.JS (

23) where

25import Data.List ((\\), delete)

26−import Data.Maybe (catMaybes, mapMaybe)

26+import Data.Maybe (mapMaybe)

28import Control.Applicative

29import Control.Arrow ((&&&))

@@ -48,7 +48,7 @@ moduleToJs opts (Module name imps exps foreigns decls) = do

48 let jsImports = map (importToJs opts) . delete (ModuleName [ProperName C.prim]) . (\\ [name]) $ imps

49 let foreigns' = mapMaybe (\(_, js, _) -> js) foreigns

50 jsDecls <- mapM (bindToJs name) decls

51− let optimized = concatMap (map $ optimize opts) $ catMaybes jsDecls

51+ let optimized = concatMap (map $ optimize opts) jsDecls

52 let isModuleEmpty = null exps

53 let moduleBody = JSStringLiteral "use strict" : jsImports ++ foreigns' ++ optimized

54 let exps' = JSObjectLiteral $ map (runIdent &&& JSVar . identToJs) exps

@@ -76,15 +76,23 @@ importToJs opts mn =

76-- |

77-- Generate code in the simplified Javascript intermediate representation for a declaration

78--

79−bindToJs :: (Functor m, Applicative m, Monad m) => ModuleName -> Bind Ann -> SupplyT m (Maybe [JS])

79+bindToJs :: (Functor m, Applicative m, Monad m) => ModuleName -> Bind Ann -> SupplyT m [JS]

80−bindToJs mp (NonRec ident val) = do

80+bindToJs mp (NonRec ident val) = return <$> nonRecToJS mp ident val

81+bindToJs mp (Rec vals) = forM vals (uncurry (nonRecToJS mp))

82+

83+-- |

84+-- Generate code in the simplified Javascript intermediate representation for a single non-recursive

85+-- declaration.

86+--

87+-- The main purpose of this function is to handle code generation for comments.

88+--

89+nonRecToJS :: (Functor m, Applicative m, Monad m) => ModuleName -> Ident -> Expr Ann -> SupplyT m JS

90+nonRecToJS m i e@(extractAnn -> (_, com, _, _)) | not (null com) =

91+ JSComment com <$> nonRecToJS m i (modifyAnn removeComments e)

92+nonRecToJS mp ident val = do

81 js <- valueToJs mp val

93 js <- valueToJs mp val

82− return $ Just [JSVariableIntroduction (identToJs ident) (Just js)]

83−bindToJs mp (Rec vals) = do

84− jss <- forM vals $ \(ident, val) -> do

85− js <- valueToJs mp val

86− return $ JSVariableIntroduction (identToJs ident) (Just js)

94+ return $ JSVariableIntroduction (identToJs ident) (Just js)

87− return $ Just jss

95+

89-- |

97-- |

90-- Generate code in the simplified Javascript intermediate representation for a variable based on a

98-- Generate code in the simplified Javascript intermediate representation for a variable based on a

@@ -155,7 +163,7 @@ valueToJs m (Case _ values binders) = do

155 vals <- mapM (valueToJs m) values

163 vals <- mapM (valueToJs m) values

156 bindersToJs m binders vals

164 bindersToJs m binders vals

157valueToJs m (Let _ ds val) = do

165valueToJs m (Let _ ds val) = do

158− decls <- concat . catMaybes <$> mapM (bindToJs m) ds

166+ decls <- concat <$> mapM (bindToJs m) ds

159 ret <- valueToJs m val

167 ret <- valueToJs m val

160 return $ JSApp (JSFunction Nothing [] (JSBlock (decls ++ [JSReturn ret]))) []

168 return $ JSApp (JSFunction Nothing [] (JSBlock (decls ++ [JSReturn ret]))) []

161valueToJs _ (Constructor (_, _, _, Just IsNewtype) _ (ProperName ctor) _) =

169valueToJs _ (Constructor (_, _, _, Just IsNewtype) _ (ProperName ctor) _) =

src/Language/PureScript/CodeGen/JS/AST.hs+10−1

@@ -19,6 +19,8 @@ module Language.PureScript.CodeGen.JS.AST where

20import Data.Data

22+import Language.PureScript.Parser.Lexer

23+

22-- |

24-- |

23-- Built-in unary operators

25-- Built-in unary operators

24--

26--

@@ -240,7 +242,11 @@ data JS

240 -- |

242 -- |

241 -- Raw Javascript (generated when parsing fails for an inline foreign import declaration)

243 -- Raw Javascript (generated when parsing fails for an inline foreign import declaration)

242 --

244 --

245+ | JSRaw String

246+ -- |

247+ -- Commented Javascript

248+ --

243− | JSRaw String deriving (Show, Eq, Data, Typeable)

249+ | JSComment [Comment] JS deriving (Show, Eq, Data, Typeable)

244

250

245--

251--

246-- Traversals

252-- Traversals

@@ -271,6 +277,7 @@ everywhereOnJS f = go

271 go (JSTypeOf js) = f (JSTypeOf (go js))

277 go (JSTypeOf js) = f (JSTypeOf (go js))

272 go (JSLabel name js) = f (JSLabel name (go js))

278 go (JSLabel name js) = f (JSLabel name (go js))

273 go (JSInstanceOf j1 j2) = f (JSInstanceOf (go j1) (go j2))

279 go (JSInstanceOf j1 j2) = f (JSInstanceOf (go j1) (go j2))

280+ go (JSComment com j) = f (JSComment com (go j))

274 go other = f other

281 go other = f other

275

282

276everywhereOnJSTopDown :: (JS -> JS) -> JS -> JS

283everywhereOnJSTopDown :: (JS -> JS) -> JS -> JS

@@ -298,6 +305,7 @@ everywhereOnJSTopDown f = go . f

298 go (JSTypeOf j) = JSTypeOf (go (f j))

305 go (JSTypeOf j) = JSTypeOf (go (f j))

299 go (JSLabel name j) = JSLabel name (go (f j))

306 go (JSLabel name j) = JSLabel name (go (f j))

300 go (JSInstanceOf j1 j2) = JSInstanceOf (go (f j1)) (go (f j2))

307 go (JSInstanceOf j1 j2) = JSInstanceOf (go (f j1)) (go (f j2))

308+ go (JSComment com j) = JSComment com (go (f j))

301 go other = f other

309 go other = f other

302

310

303everythingOnJS :: (r -> r -> r) -> (JS -> r) -> JS -> r

311everythingOnJS :: (r -> r -> r) -> (JS -> r) -> JS -> r

@@ -325,4 +333,5 @@ everythingOnJS (<>) f = go

325 go j@(JSTypeOf j1) = f j <> go j1

333 go j@(JSTypeOf j1) = f j <> go j1

326 go j@(JSLabel _ j1) = f j <> go j1

334 go j@(JSLabel _ j1) = f j <> go j1

327 go j@(JSInstanceOf j1 j2) = f j <> go j1 <> go j2

335 go j@(JSInstanceOf j1 j2) = f j <> go j1 <> go j2

336+ go j@(JSComment _ j1) = f j <> go j1

328 go other = f other

337 go other = f other

src/Language/PureScript/CoreFn/Ann.hs+6

@@ -29,3 +29,9 @@ type Ann = (Maybe SourceSpan, [Comment], Maybe Type, Maybe Meta)

29--

30nullAnn :: Ann

31nullAnn = (Nothing, [], Nothing, Nothing)

32+

33+-- |

34+-- Remove the comments from an annotation

35+--

36+removeComments :: Ann -> Ann

37+removeComments (ss, _, ty, meta) = (ss, [], ty, meta)

src/Language/PureScript/CoreFn/Expr.hs+28

@@ -95,3 +95,31 @@ data CaseAlternative a = CaseAlternative

95 --

96 , caseAlternativeResult :: Either [(Guard a, Expr a)] (Expr a)

97 } deriving (Show, D.Data, D.Typeable)

98+

99+-- |

100+-- Extract the annotation from a term

101+--

102+extractAnn :: Expr a -> a

103+extractAnn (Literal a _) = a

104+extractAnn (Constructor a _ _ _) = a

105+extractAnn (Accessor a _ _) = a

106+extractAnn (ObjectUpdate a _ _) = a

107+extractAnn (Abs a _ _) = a

108+extractAnn (App a _ _) = a

109+extractAnn (Var a _) = a

110+extractAnn (Case a _ _) = a

111+extractAnn (Let a _ _) = a

112+

113+-- |

114+-- Modify the annotation on a term

115+--

116+modifyAnn :: (a -> a) -> Expr a -> Expr a

117+modifyAnn f (Literal a b) = Literal (f a) b

118+modifyAnn f (Constructor a b c d) = Constructor (f a) b c d

119+modifyAnn f (Accessor a b c) = Accessor (f a) b c

120+modifyAnn f (ObjectUpdate a b c) = ObjectUpdate (f a) b c

121+modifyAnn f (Abs a b c) = Abs (f a) b c

122+modifyAnn f (App a b c) = App (f a) b c

123+modifyAnn f (Var a b) = Var (f a) b

124+modifyAnn f (Case a b c) = Case (f a) b c

125+modifyAnn f (Let a b c) = Let (f a) b c

src/Language/PureScript/Pretty/JS.hs+27

@@ -29,6 +29,7 @@ import qualified Control.Arrow as A

29import Language.PureScript.CodeGen.JS.AST

30import Language.PureScript.CodeGen.JS.Common

31import Language.PureScript.Pretty.Common

32+import Language.PureScript.Parser.Lexer (Comment(..))

33import Numeric

34import Numeric

@@ -119,6 +120,32 @@ literals = mkPattern' match

119 [ return $ lbl ++ ": "

120 [ return $ lbl ++ ": "

120 , prettyPrintJS' js

121 , prettyPrintJS' js

121 ]

122 ]

123+ match (JSComment com js) = fmap concat $ sequence $

124+ [ return "\n"

125+ , currentIndent

126+ , return "/**\n"

127+ ] ++

128+ map asLine (concatMap commentLines com) ++

129+ [ currentIndent

130+ , return " */\n"

131+ , currentIndent

132+ , prettyPrintJS' js

133+ ]

134+ where

135+ commentLines :: Comment -> [String]

136+ commentLines (LineComment s) = [s]

137+ commentLines (BlockComment s) = lines s

138+

139+ asLine :: String -> StateT PrinterState Maybe String

140+ asLine s = do

141+ i <- currentIndent

142+ return $ i ++ " * " ++ removeComments s ++ "\n"

143+

144+ removeComments :: String -> String

145+ removeComments ('*' : '/' : s) = removeComments s

146+ removeComments (c : s) = c : removeComments s

147+

148+ removeComments [] = []

122 match (JSRaw js) = return js

149 match (JSRaw js) = return js

123 match _ = mzero

150 match _ = mzero

124

151