fixed: Suave dies if handlers raise exceptions (ionide#17)

vasily-kirichenko · Oct 21, 2016 · 79cb5ef · 79cb5ef
1 parent e187913
commit 79cb5ef
Showing 1 changed file with 18 additions and 7 deletions.
diff --git a/src/FsAutoComplete.Suave/FsAutoComplete.Suave.fs b/src/FsAutoComplete.Suave/FsAutoComplete.Suave.fs
@@ -43,9 +43,12 @@ let main argv =
 
     let handler f : WebPart = fun (r : HttpContext) -> async {
           let data = r.request |> getResourceFromReq
-          let! res = f data
-          let res' = res |> List.toArray |> Json.toJson
-          return! Response.response HttpCode.HTTP_200 res' r
+          let! res = Async.Catch (f data)
+          match res with
+          | Choice1Of2 res ->
+             let res' = res |> List.toArray |> Json.toJson
+             return! Response.response HttpCode.HTTP_200 res' r
+          | Choice2Of2 e -> return! Response.response HttpCode.HTTP_500 (Json.toJson e) r
         }
 
     let positionHandler (f : PositionRequest -> ParseAndCheckResults -> string -> string [] -> Async<string list>) : WebPart = fun (r : HttpContext) ->
@@ -58,10 +61,18 @@ let main argv =
                 | Success (options, lines, lineStr) ->
                   // TODO: Should sometimes pass options.Source in here to force a reparse
                   //       for completions e.g. `(some typed expr).$`
-                  let tyResOpt = commands.TryGetRecentTypeCheckResultsForFile(file, options)
-                  match tyResOpt with
-                  | None -> async.Return ([CommandResponse.info writeJson "Cached typecheck results not yet available"])
-                  | Some tyRes -> f data tyRes lineStr lines
+                  try 
+                    let tyResOpt = commands.TryGetRecentTypeCheckResultsForFile(file, options) 
+                    match tyResOpt with
+                    | None -> async.Return [CommandResponse.info writeJson "Cached typecheck results not yet available"]
+                    | Some tyRes -> 
+                        async {
+                            let! r = Async.Catch (f data tyRes lineStr lines)
+                            match r with
+                            | Choice1Of2 r -> return r
+                            | Choice2Of2 e -> return [CommandResponse.error writeJson e.Message]
+                        }
+                  with e -> async.Return [CommandResponse.error writeJson e.Message]
             let res' = res |> List.toArray |> Json.toJson
             return! Response.response HttpCode.HTTP_200 res' r
         }