Include a module identifier in psc-bundle errors

hdgarrood · hdgarrood · commit 184d97fca116 · 2015-07-25T19:08:04.000+01:00
diff --git a/src/Language/PureScript/Bundle.hs b/src/Language/PureScript/Bundle.hs
@@ -52,7 +52,7 @@ data ErrorMessage
   | InvalidTopLevel
   | UnableToParseModule
   | UnsupportedExport
-  | ErrorInFile FilePath ErrorMessage
+  | ErrorInModule ModuleIdentifier ErrorMessage
   deriving Show
 
 -- | Modules are either "regular modules" (i.e. those generated by psc) or foreign modules.
@@ -116,10 +116,13 @@ printErrorMessage UnsupportedExport =
   , "  1) exports.name = ..."
   , "  2) exports = { ... }"
   ]
-printErrorMessage (ErrorInFile filename e) =
-  ("Error in file " ++ show filename ++ ":")
+printErrorMessage (ErrorInModule mid e) =
+  ("Error in module " ++ displayIdentifier mid ++ ":")
   : ""
   : map ("  " ++) (printErrorMessage e)
+  where
+  displayIdentifier (ModuleIdentifier name ty) =
+    name ++ " (" ++ show ty ++ ")"
 
 -- | Unpack the node inside a JSNode. This is useful when pattern matching.
 node :: JSNode -> Node
@@ -201,8 +204,10 @@ withDeps (Module modulePath es) = Module modulePath (map expandDeps es)
 toModule :: forall m. (Applicative m, MonadError ErrorMessage m) => S.Set String -> ModuleIdentifier -> JSNode -> m Module
 toModule mids mid top
   | JSSourceElementsTop ns <- node top = Module mid <$> mapM toModuleElement ns
-  | otherwise = throwError InvalidTopLevel
+  | otherwise = err InvalidTopLevel
   where
+  err = throwError . ErrorInModule mid
+
   toModuleElement :: JSNode -> m ModuleElement
   toModuleElement n
     | JSVariables var [ varIntro ] _ <- node n
@@ -254,7 +259,7 @@ toModule mids mid top
     toExport (JSPropertyNameandValue name _ [val] ) =
       (,,val,[]) <$> exportType (node val)
                  <*> extractLabel (node name)
-    toExport _ = throwError UnsupportedExport
+    toExport _ = err UnsupportedExport
 
     exportType :: Node -> m ExportType
     exportType (JSMemberDot [f] _ _)
@@ -264,12 +269,12 @@ toModule mids mid top
       | JSIdentifier "$foreign" <- node f
       = pure ForeignReexport
     exportType (JSIdentifier s) = pure (RegularExport s)
-    exportType _ = throwError UnsupportedExport
+    exportType _ = err UnsupportedExport
 
     extractLabel :: Node -> m String
     extractLabel (JSStringLiteral _ nm) = pure nm
     extractLabel (JSIdentifier nm) = pure nm
-    extractLabel _ = throwError UnsupportedExport
+    extractLabel _ = err UnsupportedExport
 
     isSeparator :: Node -> Bool
     isSeparator (JSLiteral ",") = True
@@ -525,7 +530,7 @@ bundle :: forall m. (Applicative m, MonadError ErrorMessage m)
        -> m String
 bundle inputStrs entryPoints mainModule namespace = do
   input <- forM inputStrs $ \(ident, js) -> do
-                ast <- either (const $ throwError UnableToParseModule) pure $ parse js (moduleName ident)
+                ast <- either (const $ throwError $ ErrorInModule ident UnableToParseModule) pure $ parse js (moduleName ident)
                 return (ident, ast)
 
   let mids = S.fromList (map (moduleName . fst) input)
