8700e35 · rowtype-yoga/purescript-native

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

Render comments in markdown docs, and generated JS and externs

commit8700e356a5ae3bcbb1efb9c503aebafede9e1415 authorPhil Freeman <paf31@cantab.net> dateTue 6 Jan 2015, 21:56 (12 years ago) parentfa89354

6 files changed+102−14

compare with golang

unifiedsplit

psc-docs/Main.hs+11−1 src/Language/PureScript/CodeGen/JS.hs+20−12 src/Language/PureScript/CodeGen/JS/AST.hs+10−1 src/Language/PureScript/CoreFn/Ann.hs+6 src/Language/PureScript/CoreFn/Expr.hs+28 src/Language/PureScript/Pretty/JS.hs+27

psc-docs/Main.hs+11−1

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

152152 [] -> ""

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

154154 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

156158 renderDeclaration n exps d

157159renderDeclaration _ _ _ = return ()

158160

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+

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

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

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

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

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

1313--

1414-----------------------------------------------------------------------------

1515

16−{-# LANGUAGE GADTs #-}

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

1717

1818module Language.PureScript.CodeGen.JS (

1919 module AST,

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

2323) where

2424

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

26−import Data.Maybe (catMaybes, mapMaybe)

26+import Data.Maybe (mapMaybe)

2727

2828import Control.Applicative

2929import Control.Arrow ((&&&))

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

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

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

5050 jsDecls <- mapM (bindToJs name) decls

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

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

5252 let isModuleEmpty = null exps

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

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

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

7676-- |

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

7878--

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

80−bindToJs mp (NonRec ident val) = do

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

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

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

87− return $ Just jss

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

95+

8896

8997-- |

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

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

155163 vals <- mapM (valueToJs m) values

156164 bindersToJs m binders vals

157165valueToJs m (Let _ ds val) = do

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

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

159167 ret <- valueToJs m val

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

161169valueToJs _ (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

1919

2020import Data.Data

2121

22+import Language.PureScript.Parser.Lexer

23+

2224-- |

2325-- Built-in unary operators

2426--

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

240242 -- |

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

242244 --

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

245+ | JSRaw String

246+ -- |

247+ -- Commented Javascript

248+ --

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

244250

245251--

246252-- Traversals

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

271277 go (JSTypeOf js) = f (JSTypeOf (go js))

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

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

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

274281 go other = f other

275282

276283everywhereOnJSTopDown :: (JS -> JS) -> JS -> JS

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

298305 go (JSTypeOf j) = JSTypeOf (go (f j))

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

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

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

301309 go other = f other

302310

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

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

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

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

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

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

328337 go other = f other

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

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

2929--

3030nullAnn :: Ann

3131nullAnn = (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

9595 --

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

9797 } 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

2929import Language.PureScript.CodeGen.JS.AST

3030import Language.PureScript.CodeGen.JS.Common

3131import Language.PureScript.Pretty.Common

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

3233

3334import Numeric

3435

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

119120 [ return $ lbl ++ ": "

120121 , prettyPrintJS' js

121122 ]

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 [] = []

122149 match (JSRaw js) = return js

123150 match _ = mzero

124151