f78904d · rowtype-yoga/purescript-native

docgen/Main.hs+2−1

compare with golang

unifiedsplit

@@ -58,8 +58,9 @@ renderModules ms = do

58 headerLevel 1 "Module Documentation"

59 mapM_ renderModule ms

60

61+-- TODO: filter everything by exports

61renderModule :: P.Module -> Docs

62renderModule :: P.Module -> Docs

62−renderModule (P.Module moduleName ds) = do

63+renderModule (P.Module moduleName ds exps) = do

63 headerLevel 2 $ "Module " ++ P.runModuleName moduleName

64 headerLevel 2 $ "Module " ++ P.runModuleName moduleName

64 spacer

65 spacer

65 headerLevel 3 "Types"

66 headerLevel 3 "Types"

psci/Main.hs+3−2

@@ -161,6 +161,7 @@ quitMessage = "See ya!"

161

162-- |

163-- Loads module, function, and file completions.

164+-- TODO: filter names to only include exported decls

164--

165--

165completion :: CompletionFunc (StateT PSCiState IO)

166completion :: CompletionFunc (StateT PSCiState IO)

166completion = completeWord Nothing " \t\n\r" findCompletions

167completion = completeWord Nothing " \t\n\r" findCompletions

@@ -176,7 +177,7 @@ completion = completeWord Nothing " \t\n\r" findCompletions

176 getDeclName _ = Nothing

177 getDeclName _ = Nothing

177 names :: [P.Module] -> [String]

178 names :: [P.Module] -> [String]

178 names ms = nub [ show qual

179 names ms = nub [ show qual

179− | P.Module moduleName ds <- ms

180+ | P.Module moduleName ds _ <- ms

180 , ident <- mapMaybe getDeclName ds

181 , ident <- mapMaybe getDeclName ds

181 , qual <- [ P.Qualified Nothing ident

182 , qual <- [ P.Qualified Nothing ident

182 , P.Qualified (Just moduleName) ident]

183 , P.Qualified (Just moduleName) ident]

@@ -207,7 +208,7 @@ createTemporaryModule exec PSCiState{psciImportedModuleNames = imports, psciLetB

207 mainDecl = P.ValueDeclaration (P.Ident "main") [] Nothing mainValue

208 mainDecl = P.ValueDeclaration (P.Ident "main") [] Nothing mainValue

208 decls = if exec then [itDecl, mainDecl] else [itDecl]

209 decls = if exec then [itDecl, mainDecl] else [itDecl]

209 in

210 in

210− P.Module moduleName $ map importDecl imports ++ decls

211+ P.Module moduleName ((importDecl `map` imports) ++ decls) Nothing

211

212

212-- |

213-- |

213-- Takes a value declaration and evaluates it with the current state.

214-- Takes a value declaration and evaluates it with the current state.

src/Language/PureScript.hs+3−3

@@ -33,7 +33,7 @@ import Language.PureScript.DeadCodeElimination as P

33import Data.List (intercalate)

34import Data.Maybe (mapMaybe)

35import Control.Monad.State.Lazy

36−import Control.Applicative ((<$>))

36+import Control.Applicative ((<$>), (<*>), pure)

37import qualified Data.Map as M

38

39-- |

@@ -59,9 +59,9 @@ compile :: Options -> [Module] -> Either String (String, String, Environment)

59compile opts ms = do

60 sorted <- sortModules ms

61 desugared <- desugar sorted

62− (elaborated, env) <- runCheck $ forM desugared $ \(Module moduleName' decls) -> do

62+ (elaborated, env) <- runCheck $ forM desugared $ \(Module moduleName' decls exps) -> do

63 modify (\s -> s { checkCurrentModule = Just moduleName' })

64− Module moduleName' <$> typeCheckAll mainModuleIdent moduleName' decls

64+ Module moduleName' <$> typeCheckAll mainModuleIdent moduleName' decls <*> pure exps

65 regrouped <- createBindingGroupsModule . collapseBindingGroupsModule $ elaborated

66 let entryPoints = moduleNameFromString `map` optionsModules opts

67 let elim = if null entryPoints then regrouped else eliminateDeadCode env entryPoints regrouped

src/Language/PureScript/CodeGen/Externs.hs+2−1

@@ -27,9 +27,10 @@ import Data.List (intercalate)

27

28-- |

29-- Generate foreign imports for all declarations in a module

30+-- TODO: only expose items listed in "exps"

30--

31--

31moduleToPs :: Module -> Environment -> String

32moduleToPs :: Module -> Environment -> String

32−moduleToPs (Module mn decls) env =

33+moduleToPs (Module mn decls exps) env =

33 "module " ++ runModuleName mn ++ " where\n" ++

34 "module " ++ runModuleName mn ++ " where\n" ++

34 (intercalate "\n" . map (" " ++) . concatMap (declToPs mn env) $ decls)

35 (intercalate "\n" . map (" " ++) . concatMap (declToPs mn env) $ decls)

35

36

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

@@ -49,7 +49,7 @@ import Language.PureScript.CodeGen.Common

49-- module.

50--

51moduleToJs :: Options -> Module -> Environment -> Maybe JS

52−moduleToJs opts (Module name decls) env =

52+moduleToJs opts (Module name decls exps) env =

53 case jsDecls of

54 [] -> Nothing

55 _ -> Just $ JSAssignment (JSAccessor (moduleNameToJs name) (JSVar "_ps")) $

src/Language/PureScript/DeadCodeElimination.hs+2−2

@@ -35,12 +35,12 @@ eliminateDeadCode env entryPoints ms =

35 let declarations = concatMap (declarationsByModule env) ms

36 (graph, _, vertexFor) = graphFromEdges $ map (\(key, deps) -> (key, key, deps)) declarations

37 entryPointVertices = mapMaybe (vertexFor . fst) . filter (\((mn, _), _) -> mn `elem` entryPoints) $ declarations

38− in flip map ms $ \(Module moduleName ds) -> Module moduleName (filter (isUsed moduleName graph vertexFor entryPointVertices) ds)

38+ in flip map ms $ \(Module moduleName ds exps) -> Module moduleName (filter (isUsed moduleName graph vertexFor entryPointVertices) ds) exps

39

40type Key = (ModuleName, Either Ident ProperName)

41

42declarationsByModule :: Environment -> Module -> [(Key, [Key])]

43−declarationsByModule env (Module moduleName ds) = concatMap go ds

43+declarationsByModule env (Module moduleName ds _) = concatMap go ds

44 where

45 go :: Declaration -> [(Key, [Key])]

46 go d@(ValueDeclaration name _ _ _) = [((moduleName, Left name), dependencies moduleName d)]

src/Language/PureScript/Declarations.hs+3−2

@@ -40,9 +40,10 @@ data Associativity = Infixl | Infixr deriving (Show, D.Data, D.Typeable)

40data Fixity = Fixity Associativity Precedence deriving (Show, D.Data, D.Typeable)

41

42-- |

43−-- A module declaration, consisting of a module name and a list of declarations

43+-- A module declaration, consisting of a module name, a list of declarations, and a list of the

44+-- declarations that are explicitly imported. If the export list is Nothing, everything is exported.

44--

45--

45−data Module = Module ModuleName [Declaration] deriving (Show, D.Data, D.Typeable)

46+data Module = Module ModuleName [Declaration] (Maybe [DeclarationRef]) deriving (Show, D.Data, D.Typeable)

46

47

47-- |

48-- |

48-- The type of a foreign import

49-- The type of a foreign import

src/Language/PureScript/ModuleDependencies.hs+1−1

@@ -51,7 +51,7 @@ usedModules = nub . everything (++) (mkQ [] qualifiedIdents `extQ` qualifiedProp

51 imports _ = []

52

53getModuleName :: Module -> ModuleName

54−getModuleName (Module mn _) = mn

54+getModuleName (Module mn _ _) = mn

55

56-- |

57-- Convert a strongly connected component of the module graph to a module

src/Language/PureScript/Parser/Declarations.hs+2−1

@@ -146,9 +146,10 @@ parseModule = do

146 reserved "module"

147 indented

148 name <- moduleName

149+ exports <- P.optionMaybe $ parens $ commaSep1 parseDeclarationRef

149 _ <- lexeme $ P.string "where"

150 _ <- lexeme $ P.string "where"

150 decls <- mark (P.many (same *> parseDeclaration))

151 decls <- mark (P.many (same *> parseDeclaration))

151− return $ Module name decls

152+ return $ Module name decls exports

152

153

153-- |

154-- |

154-- Parse a collection of modules

155-- Parse a collection of modules

src/Language/PureScript/Sugar/BindingGroups.hs+3−3

@@ -25,7 +25,7 @@ import Data.Data

25import Data.Graph

26import Data.Generics

27import Data.List (nub, intersect)

28−import Control.Applicative ((<$>))

28+import Control.Applicative ((<$>), (<*>), pure)

29

30import Language.PureScript.Declarations

31import Language.PureScript.Names

@@ -36,13 +36,13 @@ import Language.PureScript.Types

36-- Replace all sets of mutually-recursive declarations in a module with binding groups

37--

38createBindingGroupsModule :: [Module] -> Either String [Module]

39−createBindingGroupsModule = mapM $ \(Module name ds) -> Module name <$> createBindingGroups name ds

39+createBindingGroupsModule = mapM $ \(Module name ds exps) -> Module name <$> createBindingGroups name ds <*> pure exps

40

41-- |

42-- Collapse all binding groups in a module to individual declarations

43--

44collapseBindingGroupsModule :: [Module] -> [Module]

45−collapseBindingGroupsModule = map $ \(Module name ds) -> Module name (collapseBindingGroups ds)

45+collapseBindingGroupsModule = map $ \(Module name ds exps) -> Module name (collapseBindingGroups ds) exps

46

47-- |

48-- Replace all sets of mutually-recursive declarations with binding groups

src/Language/PureScript/Sugar/CaseDeclarations.hs+1−1

@@ -35,7 +35,7 @@ import Language.PureScript.Scope

35-- Replace all top-level binders in a module with case expressions.

36--

37desugarCasesModule :: [Module] -> Either String [Module]

38−desugarCasesModule ms = forM ms $ \(Module name ds) -> Module name <$> (desugarCases . desugarAbs $ ds)

38+desugarCasesModule ms = forM ms $ \(Module name ds exps) -> Module name <$> (desugarCases . desugarAbs $ ds) <*> pure exps

39

40desugarAbs :: [Declaration] -> [Declaration]

41desugarAbs = everywhere (mkT replace)

src/Language/PureScript/Sugar/Names.hs+5−5

@@ -143,14 +143,14 @@ desugarImports modules = do

143-- Rethrow an error with the name of the current module in the case of a failure

144--

145rethrowForModule :: Module -> Either String a -> Either String a

146−rethrowForModule (Module mn _) = flip catchError $ \e -> throwError ("Error in module '" ++ show mn ++ "':\n" ++ e)

146+rethrowForModule (Module mn _ _) = flip catchError $ \e -> throwError ("Error in module '" ++ show mn ++ "':\n" ++ e)

147

148-- |

149-- Replaces all local names with qualified names within a module.

150--

151renameInModule :: ImportEnvironment -> Module -> Either String Module

152−renameInModule imports (Module mn decls) =

152+renameInModule imports (Module mn decls exps) =

153− Module mn <$> mapM updateDecl decls >>= everywhereM (mkM updateType `extM` updateValue `extM` updateBinder `extM` updateVars)

153+ Module mn <$> (mapM updateDecl decls >>= everywhereM (mkM updateType `extM` updateValue `extM` updateBinder `extM` updateVars)) <*> pure exps

154 where

155 updateDecl (TypeInstanceDeclaration name cs (Qualified Nothing cn) ts ds) =

156 TypeInstanceDeclaration name <$> updateConstraints cs <*> updateClassName cn <*> pure ts <*> pure ds

@@ -197,7 +197,7 @@ renameInModule imports (Module mn decls) =

197findExports :: [Module] -> Either String ExportEnvironment

198findExports = foldM addModule M.empty

199 where

200− addModule env m@(Module mn ds) = rethrowForModule m $ foldM (addDecl mn) (addEmptyModule env mn) ds

200+ addModule env m@(Module mn ds exps) = rethrowForModule m $ foldM (addDecl mn) (addEmptyModule env mn) ds

201 addDecl mn env (TypeClassDeclaration tcn _ ds) = do

202 env' <- addTypeClass env mn tcn

203 foldM (\env'' (TypeDeclaration name _) -> addValue env'' mn name) env' ds

@@ -227,7 +227,7 @@ findImports = foldl findImports' M.empty

227-- Constructs a local environment for a module.

228--

229resolveImports :: ExportEnvironment -> Module -> Either String ImportEnvironment

230−resolveImports env (Module currentModule decls) =

230+resolveImports env (Module currentModule decls _) =

231 foldM resolveImport' (ImportEnvironment M.empty M.empty M.empty M.empty) (M.toList scope)

232 where

233 -- A Map from module name to imports from that module, where Nothing indicates everything is to be imported

src/Language/PureScript/Sugar/Operators.hs+2−2

@@ -49,11 +49,11 @@ rebracket :: [Module] -> Either String [Module]

49rebracket = go M.empty []

50 where

51 go _ rb [] = return . reverse $ rb

52− go m rb (Module name ds : ms) = do

52+ go m rb (Module name ds exps : ms) = do

53 m' <- M.union m <$> collectFixities m name ds

54 let opTable = customOperatorTable m'

55 ds' <- G.everywhereM' (G.mkM (matchOperators name opTable)) ds

56− go m' (Module name (G.everywhere (G.mkT removeParens) ds') : rb) ms

56+ go m' (Module name (G.everywhere (G.mkT removeParens) ds') exps : rb) ms

57

58removeParens :: Value -> Value

59removeParens (Parens val) = val

src/Language/PureScript/Sugar/TypeClasses.hs+1−1

@@ -47,7 +47,7 @@ desugarTypeClasses :: [Module] -> Either String [Module]

47desugarTypeClasses = flip evalStateT M.empty . mapM desugarModule

48

49desugarModule :: Module -> Desugar Module

50−desugarModule (Module name decls) = Module name <$> concat <$> mapM (desugarDecl name) decls

50+desugarModule (Module name decls exps) = Module name <$> concat <$> mapM (desugarDecl name) decls <*> pure exps

51

52-- |

53-- Desugar type class and type class instance declarations

src/Language/PureScript/Sugar/TypeDeclarations.hs+1−1

@@ -30,7 +30,7 @@ import Language.PureScript.Values

30-- Replace all top level type declarations in a module with type annotations

31--

32desugarTypeDeclarationsModule :: [Module] -> Either String [Module]

33−desugarTypeDeclarationsModule ms = forM ms $ \(Module name ds) -> Module name <$> desugarTypeDeclarations ds

33+desugarTypeDeclarationsModule ms = forM ms $ \(Module name ds exps) -> Module name <$> desugarTypeDeclarations ds <*> pure exps

34

35-- |

36-- Replace all top level type declarations with type annotations