Skip to content

Commit f4375ae

Browse files
paf31paf31
committed
Merge pull request purescript#901 from joneshf/master
Add comments to `Module`.
2 parents ea531ab + 9b73cef commit f4375ae

22 files changed

Lines changed: 75 additions & 69 deletions

‎hierarchy/Main.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -64,7 +64,7 @@ compile (HierarchyOptions input mOutput) = do
6464
case modules of
6565
Left err -> hPutStr stderr (show err) >> exitFailure
6666
Right ms -> do
67-
for_ ms $ \(P.Module moduleName decls _) ->
67+
for_ ms $ \(P.Module _ moduleName decls _) ->
6868
let name = runModuleName moduleName
6969
tcs = filter P.isTypeClassDeclaration decls
7070
supers = sort . nub . filter (not . null) $ fmap superClasses tcs

‎psc-docs/Main.hs‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -86,9 +86,11 @@ renderModules ms = do
8686
mapM_ renderModule ms
8787

8888
renderModule :: P.Module -> Docs
89-
renderModule mdl@(P.Module moduleName _ exps) = do
89+
renderModule mdl@(P.Module coms moduleName _ exps) = do
9090
headerLevel 2 $ "Module " ++ P.runModuleName moduleName
9191
spacer
92+
renderComments coms
93+
spacer
9294
renderTopLevel exps (P.exportedDeclarations mdl)
9395
spacer
9496

‎psci/Main.hs‎

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -286,7 +286,7 @@ completion = completeWordWithPrev Nothing " \t\n\r" findCompletions
286286
getTypeName _ = Nothing
287287

288288
identNames :: P.Module -> [N.Ident]
289-
identNames (P.Module _ ds exports) = nub [ ident | ident <- mapMaybe (getDeclName exports) (D.flattenDecls ds) ]
289+
identNames (P.Module _ _ ds exports) = nub [ ident | ident <- mapMaybe (getDeclName exports) (D.flattenDecls ds) ]
290290
where getDeclName :: Maybe [P.DeclarationRef] -> P.Declaration -> Maybe P.Ident
291291
getDeclName exts decl@(P.ValueDeclaration ident _ _ _) | P.isExported exts decl = Just ident
292292
getDeclName exts decl@(P.ExternDeclaration _ ident _ _) | P.isExported exts decl = Just ident
@@ -307,7 +307,7 @@ completion = completeWordWithPrev Nothing " \t\n\r" findCompletions
307307
onlyDataDecls = (filter P.isDataDecl (P.exportedDeclarations m))
308308

309309
moduleNames :: [P.Module] -> [String]
310-
moduleNames ms = nub [show moduleName | P.Module moduleName _ _ <- ms]
310+
moduleNames ms = nub [show moduleName | P.Module _ moduleName _ _ <- ms]
311311

312312
sorter :: Completion -> Completion -> Ordering
313313
sorter (Completion _ d1 _) (Completion _ d2 _) = if ":" `isPrefixOf` d1 then LT else compare d1 d2
@@ -364,7 +364,7 @@ createTemporaryModule exec PSCiState{psciImportedModuleNames = imports, psciLetB
364364
mainDecl = P.ValueDeclaration (P.Ident "main") P.Value [] $ Right mainValue
365365
decls = if exec then [itDecl, mainDecl] else [itDecl]
366366
in
367-
P.Module moduleName ((importDecl `map` imports) ++ lets ++ decls) Nothing
367+
P.Module [] moduleName ((importDecl `map` imports) ++ lets ++ decls) Nothing
368368

369369

370370
-- |
@@ -377,7 +377,7 @@ createTemporaryModuleForKind PSCiState{psciImportedModuleNames = imports} typ =
377377
importDecl m = P.ImportDeclaration m P.Unqualified Nothing
378378
itDecl = P.TypeSynonymDeclaration (P.ProperName "IT") [] typ
379379
in
380-
P.Module moduleName ((importDecl `map` imports) ++ [itDecl]) Nothing
380+
P.Module [] moduleName ((importDecl `map` imports) ++ [itDecl]) Nothing
381381

382382
-- |
383383
-- Makes a volatile module to execute the current imports.
@@ -388,7 +388,7 @@ createTemporaryModuleForImports PSCiState{psciImportedModuleNames = imports} =
388388
moduleName = P.ModuleName [P.ProperName "$PSCI"]
389389
importDecl m = P.ImportDeclaration m P.Unqualified Nothing
390390
in
391-
P.Module moduleName (importDecl `map` imports) Nothing
391+
P.Module [] moduleName (importDecl `map` imports) Nothing
392392

393393
modulesDir :: FilePath
394394
modulesDir = ".psci_modules" ++ pathSeparator : "node_modules"
@@ -439,7 +439,7 @@ handleShowLoadedModules = do
439439
psciIO $ readModules loadedModules >>= putStrLn
440440
return ()
441441
where readModules = return . unlines . sort . nub . map toModuleName
442-
toModuleName = N.runModuleName . (\ (D.Module mdName _ _) -> mdName) . snd
442+
toModuleName = N.runModuleName . (\ (D.Module _ mdName _ _) -> mdName) . snd
443443

444444
-- |
445445
-- Show the imported modules in psci.
@@ -510,7 +510,7 @@ handleBrowse moduleName = do
510510
case env of
511511
Left err -> PSCI $ outputStrLn err
512512
Right env' ->
513-
if moduleName `notElem` (nub . map ((\ (P.Module modName _ _ ) -> modName) . snd)) loadedModules
513+
if moduleName `notElem` (nub . map ((\ (P.Module _ modName _ _ ) -> modName) . snd)) loadedModules
514514
then PSCI $ outputStrLn $ "Module '" ++ N.runModuleName moduleName ++ "' is not valid."
515515
else printModuleSignatures moduleName env'
516516

‎src/Language/PureScript.hs‎

Lines changed: 12 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,7 @@
1919
{-# LANGUAGE FlexibleContexts #-}
2020
{-# LANGUAGE ScopedTypeVariables #-}
2121

22-
module Language.PureScript
22+
module Language.PureScript
2323
( module P
2424
, compile
2525
, compile'
@@ -104,7 +104,7 @@ compile' env ms prefix = do
104104
let elim = if null entryPoints then corefn else eliminateDeadCode entryPoints corefn
105105
let renamed = renameInModules elim
106106
let codeGenModuleNames = moduleNameFromString `map` codeGenModules additional
107-
let modulesToCodeGen = if null codeGenModuleNames then renamed else filter (\(CoreFn.Module mn _ _ _ _) -> mn `elem` codeGenModuleNames) renamed
107+
let modulesToCodeGen = if null codeGenModuleNames then renamed else filter (\(CoreFn.Module _ mn _ _ _ _) -> mn `elem` codeGenModuleNames) renamed
108108
js <- concat <$> (evalSupplyT nextVar $ T.traverse moduleToJs modulesToCodeGen)
109109
let exts = intercalate "\n" . map (`moduleToPs` env') $ regrouped
110110
js' <- generateMain env' js
@@ -170,11 +170,11 @@ make :: forall m. (Functor m, Applicative m, Monad m, MonadMake m)
170170
=> FilePath -> [(Either RebuildPolicy FilePath, Module)] -> [String] -> m Environment
171171
make outputDir ms prefix = do
172172
noPrelude <- asks optionsNoPrelude
173-
let filePathMap = M.fromList (map (\(fp, Module mn _ _) -> (mn, fp)) ms)
173+
let filePathMap = M.fromList (map (\(fp, Module _ mn _ _) -> (mn, fp)) ms)
174174

175175
(sorted, graph) <- sortModules $ map importPrim $ if noPrelude then map snd ms else map (importPrelude . snd) ms
176176

177-
toRebuild <- foldM (\s (Module moduleName' _ _) -> do
177+
toRebuild <- foldM (\s (Module _ moduleName' _ _) -> do
178178
let filePath = runModuleName moduleName'
179179

180180
jsFile = outputDir </> filePath </> "index.js"
@@ -203,18 +203,18 @@ make outputDir ms prefix = do
203203
(_, env') <- lift . runCheck' env $ typeCheckModule Nothing m
204204

205205
go env' ms'
206-
go env ((True, m@(Module moduleName' _ exps)) : ms') = do
206+
go env ((True, m@(Module coms moduleName' _ exps)) : ms') = do
207207
let filePath = runModuleName moduleName'
208208
jsFile = outputDir </> filePath </> "index.js"
209209
externsFile = outputDir </> filePath </> "externs.purs"
210210

211211
lift . progress $ "Compiling " ++ runModuleName moduleName'
212212

213-
(Module _ elaborated _, env') <- lift . runCheck' env $ typeCheckModule Nothing m
213+
(Module _ _ elaborated _, env') <- lift . runCheck' env $ typeCheckModule Nothing m
214214

215215
regrouped <- stringifyErrorStack True . createBindingGroups moduleName' . collapseBindingGroups $ elaborated
216216

217-
let mod' = Module moduleName' regrouped exps
217+
let mod' = Module coms moduleName' regrouped exps
218218
let corefn = CoreFn.moduleToCoreFn env' mod'
219219
let [renamed] = renameInModules [corefn]
220220

@@ -229,16 +229,16 @@ make outputDir ms prefix = do
229229

230230
rebuildIfNecessary :: M.Map ModuleName [ModuleName] -> S.Set ModuleName -> [Module] -> m [(Bool, Module)]
231231
rebuildIfNecessary _ _ [] = return []
232-
rebuildIfNecessary graph toRebuild (m@(Module moduleName' _ _) : ms') | moduleName' `S.member` toRebuild = do
232+
rebuildIfNecessary graph toRebuild (m@(Module _ moduleName' _ _) : ms') | moduleName' `S.member` toRebuild = do
233233
let deps = fromMaybe [] $ moduleName' `M.lookup` graph
234234
toRebuild' = toRebuild `S.union` S.fromList deps
235235
(:) (True, m) <$> rebuildIfNecessary graph toRebuild' ms'
236-
rebuildIfNecessary graph toRebuild (Module moduleName' _ _ : ms') = do
236+
rebuildIfNecessary graph toRebuild (Module _ moduleName' _ _ : ms') = do
237237
let externsFile = outputDir </> runModuleName moduleName' </> "externs.purs"
238238
externs <- readTextFile externsFile
239239
externsModules <- fmap (map snd) . either (throwError . show) return $ P.parseModulesFromFiles id [(externsFile, externs)]
240240
case externsModules of
241-
[m'@(Module moduleName'' _ _)] | moduleName'' == moduleName' -> (:) (False, m') <$> rebuildIfNecessary graph toRebuild ms'
241+
[m'@(Module _ moduleName'' _ _)] | moduleName'' == moduleName' -> (:) (False, m') <$> rebuildIfNecessary graph toRebuild ms'
242242
_ -> throwError $ "Externs file " ++ externsFile ++ " was invalid"
243243

244244
reverseDependencies :: ModuleGraph -> M.Map ModuleName [ModuleName]
@@ -251,9 +251,9 @@ reverseDependencies g = combine [ (dep, mn) | (mn, deps) <- g, dep <- deps ]
251251
-- Add an import declaration for a module if it does not already explicitly import it.
252252
--
253253
addDefaultImport :: ModuleName -> Module -> Module
254-
addDefaultImport toImport m@(Module mn decls exps) =
254+
addDefaultImport toImport m@(Module coms mn decls exps) =
255255
if isExistingImport `any` decls || mn == toImport then m
256-
else Module mn (ImportDeclaration toImport Unqualified Nothing : decls) exps
256+
else Module coms mn (ImportDeclaration toImport Unqualified Nothing : decls) exps
257257
where
258258
isExistingImport (ImportDeclaration mn' _ _) | mn' == toImport = True
259259
isExistingImport (PositionedDeclaration _ _ d) = isExistingImport d

‎src/Language/PureScript/AST/Declarations.hs‎

Lines changed: 7 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -30,14 +30,15 @@ import Language.PureScript.CodeGen.JS.AST
3030
import Language.PureScript.Environment
3131

3232
-- |
33-
-- A module declaration, consisting of a module name, a list of declarations, and a list of the
34-
-- declarations that are explicitly exported. If the export list is Nothing, everything is exported.
33+
-- A module declaration, consisting of comments about the module, a module name,
34+
-- a list of declarations, and a list of the declarations that are
35+
-- explicitly exported. If the export list is Nothing, everything is exported.
3536
--
36-
data Module = Module ModuleName [Declaration] (Maybe [DeclarationRef]) deriving (Show, D.Data, D.Typeable)
37+
data Module = Module [Comment] ModuleName [Declaration] (Maybe [DeclarationRef]) deriving (Show, D.Data, D.Typeable)
3738

3839
-- | Return a module's name.
3940
getModuleName :: Module -> ModuleName
40-
getModuleName (Module name _ _) = name
41+
getModuleName (Module _ name _ _) = name
4142

4243
-- |
4344
-- Test if a declaration is exported, given a module's export list.
@@ -60,7 +61,7 @@ isExported (Just exps) decl = any (matches decl) exps
6061
matches _ _ = False
6162

6263
exportedDeclarations :: Module -> [Declaration]
63-
exportedDeclarations (Module _ decls exps) = filter (isExported exps) (flattenDecls decls)
64+
exportedDeclarations (Module _ _ decls exps) = filter (isExported exps) (flattenDecls decls)
6465

6566
-- |
6667
-- Test if a data constructor for a given type is exported, given a module's export list.
@@ -78,7 +79,7 @@ isDctorExported ident (Just exps) ctor = test `any` exps
7879
-- Return the exported data constructors for a given type.
7980
--
8081
exportedDctors :: Module -> ProperName -> [ProperName]
81-
exportedDctors (Module _ decls exps) ident =
82+
exportedDctors (Module _ _ decls exps) ident =
8283
filter (isDctorExported ident exps) dctors
8384
where
8485
dctors = concatMap getDctors (flattenDecls decls)

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -36,8 +36,8 @@ import Language.PureScript.Comments
3636
-- Generate foreign imports for all declarations in a module
3737
--
3838
moduleToPs :: Module -> Environment -> String
39-
moduleToPs (Module _ _ Nothing) _ = error "Module exports were not elaborated in moduleToPs"
40-
moduleToPs (Module moduleName ds (Just exts)) env = intercalate "\n" . execWriter $ do
39+
moduleToPs (Module _ _ _ Nothing) _ = error "Module exports were not elaborated in moduleToPs"
40+
moduleToPs (Module _ moduleName ds (Just exts)) env = intercalate "\n" . execWriter $ do
4141
tell [ "module " ++ runModuleName moduleName ++ " where"]
4242
mapM_ declToPs ds
4343
mapM_ exportToPs exts

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

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -49,14 +49,14 @@ import qualified Language.PureScript.Constants as C
4949
--
5050
moduleToJs :: (Functor m, Applicative m, Monad m, MonadReader (Options mode) m, MonadSupply m)
5151
=> Module Ann -> m [JS]
52-
moduleToJs (Module name imps exps foreigns decls) = do
52+
moduleToJs (Module coms name imps exps foreigns decls) = do
5353
additional <- asks optionsAdditional
5454
jsImports <- T.traverse importToJs . delete (ModuleName [ProperName C.prim]) . (\\ [name]) $ imps
5555
let foreigns' = mapMaybe (\(_, js, _) -> js) foreigns
5656
jsDecls <- mapM (bindToJs name) decls
5757
optimized <- T.traverse (T.traverse optimize) jsDecls
5858
let isModuleEmpty = null exps
59-
let moduleBody = JSStringLiteral "use strict" : jsImports ++ foreigns' ++ concat optimized
59+
let moduleBody = JSComment coms (JSStringLiteral "use strict") : jsImports ++ foreigns' ++ concat optimized
6060
let exps' = JSObjectLiteral $ map (runIdent &&& JSVar . identToJs) exps
6161
return $ case additional of
6262
MakeOptions -> moduleBody ++ [JSAssignment (JSAccessor "exports" (JSVar "module")) exps']
@@ -197,7 +197,7 @@ valueToJs _ (Constructor _ _ (ProperName ctor) fields) =
197197
in return $ iife ctor [ constructor
198198
, JSAssignment (JSAccessor "create" (JSVar ctor)) createFn
199199
]
200-
200+
201201
iife :: String -> [JS] -> JS
202202
iife v exprs = JSApp (JSFunction Nothing [] (JSBlock $ exprs ++ [JSReturn $ JSVar v])) []
203203

‎src/Language/PureScript/CoreFn/Desugar.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -40,14 +40,14 @@ import qualified Language.PureScript.AST as A
4040
-- Desugars a module from AST to CoreFn representation.
4141
--
4242
moduleToCoreFn :: Environment -> A.Module -> Module Ann
43-
moduleToCoreFn _ (A.Module _ _ Nothing) =
43+
moduleToCoreFn _ (A.Module _ _ _ Nothing) =
4444
error "Module exports were not elaborated before moduleToCoreFn"
45-
moduleToCoreFn env (A.Module mn decls (Just exps)) =
45+
moduleToCoreFn env (A.Module coms mn decls (Just exps)) =
4646
let imports = nub $ mapMaybe importToCoreFn decls ++ findQualModules decls
4747
exps' = nub $ concatMap exportToCoreFn exps
4848
externs = nub $ mapMaybe externToCoreFn decls
4949
decls' = concatMap (declToCoreFn Nothing []) decls
50-
in Module mn imports exps' externs decls'
50+
in Module coms mn imports exps' externs decls'
5151

5252
where
5353

‎src/Language/PureScript/CoreFn/Module.hs‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -15,12 +15,14 @@
1515
module Language.PureScript.CoreFn.Module where
1616

1717
import Language.PureScript.CodeGen.JS.AST
18+
import Language.PureScript.Comments
1819
import Language.PureScript.CoreFn.Expr
1920
import Language.PureScript.Names
2021
import Language.PureScript.Types
2122

2223
data Module a = Module
23-
{ moduleName :: ModuleName
24+
{ moduleComments :: [Comment]
25+
, moduleName :: ModuleName
2426
, moduleImports :: [ModuleName]
2527
, moduleExports :: [Ident]
2628
, moduleForeign :: [ForeignDecl]

‎src/Language/PureScript/DeadCodeElimination.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,7 @@ import Language.PureScript.Names
2929
eliminateDeadCode :: [ModuleName] -> [Module a] -> [Module a]
3030
eliminateDeadCode entryPoints ms = map go ms
3131
where
32-
go (Module mn imps exps foreigns ds) = Module mn imps exps' foreigns' ds'
32+
go (Module coms mn imps exps foreigns ds) = Module coms mn imps exps' foreigns' ds'
3333
where
3434
ds' = filter (isUsed mn graph vertexFor entryPointVertices) ds
3535
foreigns' = filter (isUsed' mn graph vertexFor entryPointVertices . foreignIdent) foreigns
@@ -61,7 +61,7 @@ type Key = (ModuleName, Ident)
6161
-- Find dependencies for each member in a module.
6262
--
6363
declarationsByModule :: Module a -> [(Key, [Key])]
64-
declarationsByModule (Module mn _ _ fs ds) =
64+
declarationsByModule (Module _ mn _ _ fs ds) =
6565
let fs' = map ((\name -> ((mn, name), [])) . foreignIdent) fs
6666
in fs' ++ concatMap go ds
6767
where

0 commit comments

Comments
 (0)