Move FFI JS parsing for psc/psc-make sharing

garyb · garyb · commit d92871301e88 · 2015-05-13T20:39:19.000+01:00
diff --git a/psc/Main.hs b/psc/Main.hs
@@ -45,8 +45,6 @@ import qualified Language.PureScript.Constants as C
 import qualified Language.PureScript.CoreFn as CF
 import qualified Paths_purescript as Paths
 
-import Foreign
-
 data PSCOptions = PSCOptions
   { pscInput        :: [FilePath]
   , pscForeignInput :: [FilePath]
@@ -104,7 +102,7 @@ parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWr
             => [(Maybe FilePath, String)] -> [(FilePath, String)] -> m ([(Maybe FilePath, P.Module)], M.Map P.ModuleName String)
 parseInputs modules foreigns =
   (,) <$> P.parseModulesFromFiles (fromMaybe "") modules
-      <*> parseForeignModulesFromFiles foreigns
+      <*> P.parseForeignModulesFromFiles foreigns
 
 compileJS :: forall m. (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m, MonadReader (P.Options P.Compile) m)
           => [P.Module] -> M.Map P.ModuleName String -> [String] -> m (String, String)
diff --git a/purescript.cabal b/purescript.cabal
@@ -88,6 +88,7 @@ library
                      Language.PureScript.Parser.Lexer
                      Language.PureScript.Parser.Common
                      Language.PureScript.Parser.Declarations
+                     Language.PureScript.Parser.JS
                      Language.PureScript.Parser.Kinds
                      Language.PureScript.Parser.State
                      Language.PureScript.Parser.Types
@@ -148,7 +149,7 @@ executable psc
     main-is: Main.hs
     buildable: True
     hs-source-dirs: psc
-    other-modules: Foreign
+    other-modules:
     ghc-options: -Wall -O2 -fno-warn-unused-do-bind
 
 executable psc-make
diff --git a/src/Language/PureScript/Parser.hs b/src/Language/PureScript/Parser.hs
@@ -33,3 +33,4 @@ import Language.PureScript.Parser.State as P
 import Language.PureScript.Parser.Kinds as P
 import Language.PureScript.Parser.Lexer as P
 import Language.PureScript.Parser.Declarations as P
+import Language.PureScript.Parser.JS as P
diff --git a/src/Language/PureScript/Parser/JS.hs b/src/Language/PureScript/Parser/JS.hs
@@ -14,26 +14,30 @@
 
 {-# LANGUAGE FlexibleContexts #-}
 
-module Foreign (parseForeignModulesFromFiles) where
+module Language.PureScript.Parser.JS (parseForeignModulesFromFiles) where
 
 import Control.Applicative ((*>), (<*))
 import Control.Monad (msum)
 import Control.Monad.Error.Class (MonadError(..))
+import Language.PureScript.Errors
+import Language.PureScript.Names
+import Language.PureScript.Parser.Common
+import Language.PureScript.Parser.Lexer
+import Prelude hiding (lex)
 import qualified Data.Map as M
-import qualified Language.PureScript as P
 import qualified Text.Parsec as PS
 
-parseForeignModulesFromFiles :: (MonadError P.MultipleErrors m, Functor m) => [(FilePath, String)] -> m (M.Map P.ModuleName String)
+parseForeignModulesFromFiles :: (MonadError MultipleErrors m, Functor m) => [(FilePath, String)] -> m (M.Map ModuleName String)
 parseForeignModulesFromFiles files = do
-  foreigns <- P.parU files $ \(path, file) ->
+  foreigns <- parU files $ \(path, file) ->
     case findModuleName (lines file) of
       Just name -> return (name, file)
-      Nothing -> throwError (P.errorMessage $ P.ErrorParsingFFIModule path)
+      Nothing -> throwError (errorMessage $ ErrorParsingFFIModule path)
   return $ M.fromList foreigns
 
-findModuleName :: [String] -> Maybe P.ModuleName
+findModuleName :: [String] -> Maybe ModuleName
 findModuleName = msum . map parseComment
   where
-  parseComment :: String -> Maybe P.ModuleName
+  parseComment :: String -> Maybe ModuleName
   parseComment s = either (const Nothing) Just $
-    P.lex "" s >>= P.runTokenParser "" (P.symbol' "//" *> P.reserved "module" *> P.moduleName <* PS.eof)
+    lex "" s >>= runTokenParser "" (symbol' "//" *> reserved "module" *> moduleName <* PS.eof)
