8e5e64d · rowtype-yoga/purescript-native

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

on golang help sign in

Fix module name handling in `--main`

8e5e64dGary Burgess13 years ago

src/Language/PureScript.hs+8−11

compare with golang

unifiedsplit

@@ -22,6 +22,7 @@ import Language.PureScript.Declarations as P

22import Language.PureScript.Names as P

23import Language.PureScript.Parser as P

24import Language.PureScript.CodeGen as P

25+import Language.PureScript.CodeGen.Common as P

25import Language.PureScript.TypeChecker as P

26import Language.PureScript.TypeChecker as P

26import Language.PureScript.Pretty as P

27import Language.PureScript.Pretty as P

27import Language.PureScript.Sugar as P

28import Language.PureScript.Sugar as P

@@ -63,20 +64,16 @@ compile opts ms = do

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

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

64 Module moduleName <$> typeCheckAll mainModuleIdent moduleName decls

65 Module moduleName <$> typeCheckAll mainModuleIdent moduleName decls

65 regrouped <- createBindingGroupsModule . collapseBindingGroupsModule $ elaborated

66 regrouped <- createBindingGroupsModule . collapseBindingGroupsModule $ elaborated

66− let entryPoints = (ModuleName . splitProperNames) `map` optionsModules opts

67+ let entryPoints = moduleNameFromString `map` optionsModules opts

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

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

68 let js = mapMaybe (flip (moduleToJs opts) env) elim

69 let js = mapMaybe (flip (moduleToJs opts) env) elim

69 let exts = intercalate "\n" . map (flip moduleToPs env) $ elim

70 let exts = intercalate "\n" . map (flip moduleToPs env) $ elim

70− js' <- case optionsMain opts of

71+ js' <- case mainModuleIdent of

71− Just mainModuleName -> do

72+ Just mmi@(ModuleName pns) -> do

72− when ((ModuleName [ProperName mainModuleName], Ident "main") `M.notMember` (names env)) $

73+ when ((mmi, Ident "main") `M.notMember` (names env)) $

73− Left $ mainModuleName ++ ".main is undefined"

74+ Left $ (show mmi) ++ ".main is undefined"

74− return $ js ++ [JSApp (JSAccessor "main" (JSAccessor mainModuleName (JSVar "_ps"))) []]

75+ return $ js ++ [JSApp (JSAccessor "main" (JSAccessor (moduleNameToJs mmi) (JSVar "_ps"))) []]

75 _ -> return js

76 _ -> return js

76 return (prettyPrintJS [(wrapExportsContainer opts js')], exts, env)

77 return (prettyPrintJS [(wrapExportsContainer opts js')], exts, env)

77 where

78 where

78− mainModuleIdent = ModuleName . splitProperNames <$> optionsMain opts

79+ mainModuleIdent = moduleNameFromString <$> optionsMain opts

79− splitProperNames s = case dropWhile (== '.') s of

80− "" -> []

81− s' -> ProperName w : splitProperNames s''

82− where (w, s'') = break (== '.') s'

src/Language/PureScript/Names.hs+8

@@ -70,6 +70,14 @@ data ModuleName = ModuleName [ProperName] deriving (Eq, Ord, Data, Typeable)

70runModuleName :: ModuleName -> String

71runModuleName (ModuleName pns) = intercalate "." (runProperName `map` pns)

73+moduleNameFromString :: String -> ModuleName

74+moduleNameFromString = ModuleName . splitProperNames

75+ where

76+ splitProperNames s = case dropWhile (== '.') s of

77+ "" -> []

78+ s' -> ProperName w : splitProperNames s''

79+ where (w, s'') = break (== '.') s'

80+

73instance Show ModuleName where

81instance Show ModuleName where

74 show = runModuleName

82 show = runModuleName