Merge pull request purescript#1164 from purescript/require-path-prefix

garyb · garyb · commit bfb4c0ecc509 · 2015-06-14T19:10:45.000+01:00
Allow a prefix to be specified for require() paths
diff --git a/psc-make/Main.hs b/psc-make/Main.hs
@@ -105,6 +105,12 @@ outputDirectory = strOption $
   <> showDefault
   <> help "The output directory"
 
+requirePath :: Parser (Maybe FilePath)
+requirePath = optional $ strOption $
+     short 'r'
+  <> long "require-path"
+  <> help "The path prefix to use for require() calls in the generated JavaScript"
+
 noTco :: Parser Bool
 noTco = switch $
      long "no-tco"
@@ -113,18 +119,18 @@ noTco = switch $
 noMagicDo :: Parser Bool
 noMagicDo = switch $
      long "no-magic-do"
-  <> help "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad."
+  <> help "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad"
 
 noOpts :: Parser Bool
 noOpts = switch $
      long "no-opts"
-  <> help "Skip the optimization phase."
+  <> help "Skip the optimization phase"
 
 comments :: Parser Bool
 comments = switch $
      short 'c'
   <> long "comments"
-  <> help "Include comments in the generated code."
+  <> help "Include comments in the generated code"
 
 verboseErrors :: Parser Bool
 verboseErrors = switch $
@@ -146,7 +152,10 @@ options = P.Options <$> noTco
                     <*> noOpts
                     <*> verboseErrors
                     <*> (not <$> comments)
-                    <*> pure P.MakeOptions
+                    <*> additionalOptions
+  where
+  additionalOptions =
+    P.MakeOptions <$> requirePath
 
 pscMakeOptions :: Parser PSCMakeOptions
 pscMakeOptions = PSCMakeOptions <$> many inputFile
diff --git a/psci/Make.hs b/psci/Make.hs
@@ -43,7 +43,7 @@ import qualified Language.PureScript.CoreFn as CF
 import IO (mkdirp)
 
 options :: P.Options P.Make
-options = P.Options False False Nothing False False False P.MakeOptions
+options = P.Options False False Nothing False False False (P.MakeOptions Nothing)
 
 modulesDir :: FilePath
 modulesDir = ".psci_modules" ++ pathSeparator : "node_modules"
diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs
@@ -44,6 +44,8 @@ import Language.PureScript.Options
 import Language.PureScript.Traversals (sndM)
 import qualified Language.PureScript.Constants as C
 
+import System.FilePath.Posix ((</>))
+
 -- |
 -- Generate code in the simplified Javascript intermediate representation for all declarations in a
 -- module.
@@ -66,7 +68,7 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign = do
   let exps' = JSObjectLiteral $ map (runIdent &&& JSVar . identToJs) standardExps
                              ++ map (runIdent &&& foreignIdent) foreignExps
   return $ case additional of
-    MakeOptions -> moduleBody ++ [JSAssignment (JSAccessor "exports" (JSVar "module")) exps']
+    MakeOptions _ -> moduleBody ++ [JSAssignment (JSAccessor "exports" (JSVar "module")) exps']
     CompileOptions ns _ _ | not isModuleEmpty ->
       [ JSVariableIntroduction ns
                                (Just (JSBinary Or (JSVar ns) (JSObjectLiteral [])) )
@@ -84,7 +86,7 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign = do
   importToJs mn' = do
     additional <- asks optionsAdditional
     let moduleBody = case additional of
-          MakeOptions -> JSApp (JSVar "require") [JSStringLiteral (runModuleName mn')]
+          MakeOptions path -> JSApp (JSVar "require") [JSStringLiteral (maybe id (</>) path $ runModuleName mn')]
           CompileOptions ns _ _ -> JSAccessor (moduleNameToJs mn') (JSVar ns)
     return $ JSVariableIntroduction (moduleNameToJs mn') (Just moduleBody)
 
diff --git a/src/Language/PureScript/Options.hs b/src/Language/PureScript/Options.hs
@@ -27,7 +27,7 @@ data Mode = Compile | Make
 --
 data ModeOptions mode where
   CompileOptions :: String -> [String] -> [String] -> ModeOptions Compile
-  MakeOptions :: ModeOptions Make
+  MakeOptions :: Maybe FilePath -> ModeOptions Make
 
 browserNamespace :: ModeOptions Compile -> String
 browserNamespace (CompileOptions ns _ _) = ns
@@ -38,6 +38,9 @@ entryPointModules (CompileOptions _ ms _) = ms
 codeGenModules :: ModeOptions Compile -> [String]
 codeGenModules (CompileOptions _ _ ms) = ms
 
+requirePath :: ModeOptions Make -> Maybe FilePath
+requirePath (MakeOptions mp) = mp
+
 deriving instance Show (ModeOptions mode)
 
 -- |
@@ -85,4 +88,4 @@ defaultCompileOptions = Options False False Nothing False False False (CompileOp
 -- Default make options
 --
 defaultMakeOptions :: Options Make
-defaultMakeOptions = Options False False Nothing False False False MakeOptions
+defaultMakeOptions = Options False False Nothing False False False (MakeOptions Nothing)
