Attempt to get psci working agian

paf31 · paf31 · commit fe7f2f1cb153 · 2015-05-27T22:42:51.000-07:00
diff --git a/psci/Make.hs b/psci/Make.hs
@@ -30,7 +30,7 @@ import Control.Monad.Error.Class (MonadError(..))
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Control.Monad.Reader (MonadReader, ReaderT, runReaderT)
 import Control.Monad.Trans.Except (ExceptT(..), runExceptT)
-import Control.Monad.Writer (MonadWriter, WriterT, runWriterT)
+import Control.Monad.Writer (MonadWriter, WriterT, runWriterT, tell)
 
 import System.Directory (getModificationTime, doesFileExist)
 import System.FilePath ((</>), pathSeparator)
@@ -90,10 +90,13 @@ buildMakeActions filePathMap foreigns =
 
   codegen :: CF.Module CF.Ann -> P.Environment -> P.SupplyVar -> P.Externs -> Make ()
   codegen m _ nextVar exts = do
+    let mn = CF.moduleName m
     foreignInclude <- case CF.moduleName m `M.lookup` foreigns of
-      Just _ | not $ requiresForeign m -> error "Found unnecessary foreign module"
-             | otherwise -> return $ Just $ J.JSApp (J.JSVar "require") [J.JSStringLiteral "./foreign"]
-      Nothing | requiresForeign m -> error "Foreign module missing"
+      Just path 
+        | not $ requiresForeign m -> do tell $ P.errorMessage $ P.UnnecessaryFFIModule mn path
+                                        return Nothing
+        | otherwise -> return $ Just $ J.JSApp (J.JSVar "require") [J.JSStringLiteral "./foreign"]
+      Nothing | requiresForeign m -> throwError . P.errorMessage $ P.MissingFFIModule mn
               | otherwise -> return Nothing
     pjs <- P.evalSupplyT nextVar $ P.prettyPrintJS <$> J.moduleToJs m foreignInclude
     let filePath = P.runModuleName $ CF.moduleName m
diff --git a/psci/PSCi.hs b/psci/PSCi.hs
@@ -16,6 +16,7 @@
 {-# LANGUAGE DoAndIfThenElse #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TupleSections #-}
 
 module PSCi where
 
@@ -491,14 +492,20 @@ loop PSCiOptions{..} = do
     Right modules -> do
       historyFilename <- getHistoryFilename
       let settings = defaultSettings { historyFile = Just historyFilename }
-      flip evalStateT (PSCiState psciInputFile defaultImports modules [] psciInputNodeFlags) . runInputT (setComplete completion settings) $ do
-        outputStrLn prologueMessage
-        traverse_ (mapM_ (runPSCI . handleCommand)) config
-        unless (consoleIsDefined (map snd modules)) . outputStrLn $ unlines
-          [ "PSCi requires the purescript-console module to be installed."
-          , "For help getting started, visit http://wiki.purescript.org/PSCi"
-          ]
-        go
+      foreignsOrError <- runMake $ do
+        foreignFiles <- forM psciForeignInputFiles (\inFile -> (inFile,) <$> makeIO (const (P.SimpleErrorWrapper $ P.CannotReadFile inFile)) (readFile inFile))
+        P.parseForeignModulesFromFiles foreignFiles
+      case foreignsOrError of
+        Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure
+        Right foreigns ->
+          flip evalStateT (PSCiState psciInputFile defaultImports modules foreigns [] psciInputNodeFlags) . runInputT (setComplete completion settings) $ do
+            outputStrLn prologueMessage
+            traverse_ (mapM_ (runPSCI . handleCommand)) config
+            unless (consoleIsDefined (map snd modules)) . outputStrLn $ unlines
+              [ "PSCi requires the purescript-console module to be installed."
+              , "For help getting started, visit http://wiki.purescript.org/PSCi"
+              ]
+            go
       where
         go :: InputT (StateT PSCiState IO) ()
         go = do
@@ -520,6 +527,12 @@ inputFile = strArgument $
      metavar "FILE"
   <> Opts.help "Optional .purs files to load on start"
 
+inputForeignFile :: Parser FilePath
+inputForeignFile = strOption $
+     short 'f'
+  <> long "ffi"
+  <> help "The input .js file(s) providing foreign import implementations"
+
 nodeFlagsFlag :: Parser [String]
 nodeFlagsFlag = option parser $
      long "node-opts"
@@ -532,6 +545,7 @@ nodeFlagsFlag = option parser $
 psciOptions :: Parser PSCiOptions
 psciOptions = PSCiOptions <$> multiLineMode
                           <*> many inputFile
+                          <*> many inputForeignFile
                           <*> nodeFlagsFlag
 
 runPSCi :: IO ()
diff --git a/psci/Types.hs b/psci/Types.hs
@@ -19,9 +19,10 @@ import qualified Data.Map as M
 import qualified Language.PureScript as P
 
 data PSCiOptions = PSCiOptions
-  { psciMultiLineMode  :: Bool
-  , psciInputFile      :: [FilePath]
-  , psciInputNodeFlags :: [String]
+  { psciMultiLineMode     :: Bool
+  , psciInputFile         :: [FilePath]
+  , psciForeignInputFiles :: [FilePath]
+  , psciInputNodeFlags    :: [String]
   }
 
 -- |
@@ -34,7 +35,7 @@ data PSCiState = PSCiState
   { psciImportedFilenames   :: [FilePath]
   , psciImportedModules     :: [ImportedModule]
   , psciLoadedModules       :: [(Either P.RebuildPolicy FilePath, P.Module)]
-  --, psciForeignFiles        :: M.Map P.ModuleName P.ForeignJS
+  , psciForeignFiles        :: M.Map P.ModuleName (FilePath, P.ForeignJS)
   , psciLetBindings         :: [P.Declaration]
   , psciNodeFlags           :: [String]
   }
