Merge pull request commercialhaskell#3879 from commercialhaskell/improved-parse-errors

snoyberg · web-flow · commit a6ae6a51e1b0 · 2018-02-20T13:54:07.000+02:00
Improved error messages for snapshot parse exceptions
diff --git a/ChangeLog.md b/ChangeLog.md
@@ -43,6 +43,7 @@ Other enhancements:
   It is best used with ghc's equivalent flag,
   i.e. `stack build --keep-tmp-files --ghc-options=-keep-tmp-files`.
   See [#3857](https://github.com/commercialhaskell/stack/issues/3857)
+* Improved error messages for snapshot parse exceptions
 
 Bug fixes:
 
diff --git a/src/Stack/Snapshot.hs b/src/Stack/Snapshot.hs
@@ -75,6 +75,7 @@ data SnapshotException
   | NeedResolverOrCompiler !Text
   | MissingPackages !(Set PackageName)
   | CustomResolverException !Text !(Either Request FilePath) !ParseException
+  | InvalidStackageException !SnapName !String
   deriving Typeable
 instance Exception SnapshotException
 instance Show SnapshotException where
@@ -124,10 +125,20 @@ instance Show SnapshotException where
   show (CustomResolverException url loc e) = concat
     [ "Unable to load custom resolver "
     , T.unpack url
-    , " from location\n"
-    , show loc
+    , " from "
+    , case loc of
+        Left _req -> "HTTP request"
+        Right fp -> "local file:\n  " ++ fp
     , "\nException: "
-    , show e
+    , case e of
+        AesonException s -> s
+        _ -> show e
+    ]
+  show (InvalidStackageException snapName e) = concat
+    [ "Unable to parse Stackage snapshot "
+    , T.unpack (renderSnapName snapName)
+    , ": "
+    , e
     ]
 
 -- | Convert a 'Resolver' into a 'SnapshotDef'
@@ -146,7 +157,7 @@ loadResolver (ResolverStackage name) = do
             Left e -> throwIO e
             Right value ->
               case parseEither parseStackageSnapshot value of
-                Left s -> throwIO $ AesonException s
+                Left s -> throwIO $ InvalidStackageException name s
                 Right x -> return x
     logDebug $ "Decoding build plan from: " <> T.pack (toFilePath fp)
     eres <- tryDecode
@@ -277,7 +288,7 @@ loadResolver (ResolverCustom url loc) = do
       WithJSONWarnings (sd0, mparentResolver, mcompiler) warnings <-
         liftIO (decodeFileEither fp) >>= either
           (throwM . CustomResolverException url loc)
-          (either (throwM . AesonException) return . parseEither parseCustom)
+          (either (throwM . CustomResolverException url loc . AesonException) return . parseEither parseCustom)
       logJSONWarnings (T.unpack url) warnings
       forM_ (sdLocations sd0) $ \loc' ->
         case loc' of
