Add diagnosis when failed deployment of prototype framework

AmpersandTarski · Apr 19, 2019 · 7697f8c · 7697f8c
1 parent 928d0a9
commit 7697f8c
Showing 1 changed file with 21 additions and 6 deletions.
diff --git a/src/Ampersand/Prototype/GenFrontend.hs b/src/Ampersand/Prototype/GenFrontend.hs
@@ -462,10 +462,14 @@ downloadPrototypeFramework Options{..} =
     then do
       verboseLn "Emptying folder to deploy prototype framework"
       destroyDestinationDir
+      let url = "https://github.com/AmpersandTarski/Prototype/archive/"++zwolleVersion++".zip"
       verboseLn "Start downloading prototype framework."
-      response <- 
-        parseRequest ("https://github.com/AmpersandTarski/Prototype/archive/"++zwolleVersion++".zip") >>=
-        httpBS  
+      response <- (parseRequest url >>= httpBS) `catch` \err ->  
+                          exitWith . FailedToInstallPrototypeFramework $
+                              [ "Error encountered during deployment of prototype framework:"
+                              , "  Failed to download "<>url
+                              , show (err :: SomeException)
+                              ]
       let archive = removeTopLevelFolder 
                   . toArchive 
                   . BL.fromStrict 
@@ -474,9 +478,20 @@ downloadPrototypeFramework Options{..} =
       let zipoptions = 
               [OptVerbose | verboseP ]
             ++ [OptDestination destination]
-      extractFilesFromArchive zipoptions archive
-      writeFile (destination </> ".frameworkSHA")
-                (show . zComment $ archive)
+      (extractFilesFromArchive zipoptions archive `catch` \err ->  
+                          exitWith . FailedToInstallPrototypeFramework $
+                              [ "Error encountered during deployment of prototype framework:"
+                              , "  Failed to extract the archive found at "<>url
+                              , show (err :: SomeException)
+                              ])
+      let dest = destination </> ".frameworkSHA"  
+      (writeFile dest (show . zComment $ archive) `catch` \err ->  
+                          exitWith . FailedToInstallPrototypeFramework $
+                              [ "Error encountered during deployment of prototype framework:"
+                              , "Archive seems valid: "<>url
+                              , "  Failed to write contents of archive to "<>dest
+                              , show (err :: SomeException)
+                              ])
       return x
     else return x
   ) `catch` \err ->  -- git failed to execute