Skip to content

Commit 8700e35

Browse files
paf31paf31
committed
Render comments in markdown docs, and generated JS and externs
1 parent fa89354 commit 8700e35

File tree

6 files changed

+102
-14
lines changed

6 files changed

+102
-14
lines changed

‎psc-docs/Main.hs‎

Lines changed: 11 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -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
157159
renderDeclaration _ _ _ = 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+
159169
toTypeVar :: (String, Maybe P.Kind) -> P.Type
160170
toTypeVar (s, Nothing) = P.TypeVar s
161171
toTypeVar (s, Just k) = P.KindedType (P.TypeVar s) k

‎src/Language/PureScript/CodeGen/JS.hs‎

Lines changed: 20 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,7 @@
1313
--
1414
-----------------------------------------------------------------------------
1515

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

1818
module Language.PureScript.CodeGen.JS (
1919
module AST,
@@ -23,7 +23,7 @@ module Language.PureScript.CodeGen.JS (
2323
) where
2424

2525
import Data.List ((\\), delete)
26-
import Data.Maybe (catMaybes, mapMaybe)
26+
import Data.Maybe (mapMaybe)
2727

2828
import Control.Applicative
2929
import 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
157165
valueToJs 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]))) []
161169
valueToJs _ (Constructor (_, _, _, Just IsNewtype) _ (ProperName ctor) _) =

‎src/Language/PureScript/CodeGen/JS/AST.hs‎

Lines changed: 10 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,8 @@ module Language.PureScript.CodeGen.JS.AST where
1919

2020
import 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

276283
everywhereOnJSTopDown :: (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

303311
everythingOnJS :: (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‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -29,3 +29,9 @@ type Ann = (Maybe SourceSpan, [Comment], Maybe Type, Maybe Meta)
2929
--
3030
nullAnn :: Ann
3131
nullAnn = (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‎

Lines changed: 28 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -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‎

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,7 @@ import qualified Control.Arrow as A
2929
import Language.PureScript.CodeGen.JS.AST
3030
import Language.PureScript.CodeGen.JS.Common
3131
import Language.PureScript.Pretty.Common
32+
import Language.PureScript.Parser.Lexer (Comment(..))
3233

3334
import 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

0 commit comments

Comments
 (0)