Humza Shahid
6b91d64fc3
git-subtree-dir: shf git-subtree-mainline:401408448fgit-subtree-split:b6c5a95b66
39 lines
952 B
Standard ML
39 lines
952 B
Standard ML
structure ExceptionLogger =
|
|
struct
|
|
open InputMsg
|
|
|
|
val textCommands = ref ""
|
|
|
|
fun addCommand inputMsg =
|
|
case inputMsg of
|
|
CHAR_EVENT chr =>
|
|
let
|
|
val chr = CharVector.fromList [chr]
|
|
val newInput = !textCommands ^ chr
|
|
in
|
|
textCommands := newInput
|
|
end
|
|
| _ => ()
|
|
|
|
fun log e =
|
|
let
|
|
(* print stack trace for debugging purposes,
|
|
* and then raise another exception to exit the program *)
|
|
val errName = General.exnName e ^ "\n"
|
|
val stackTrace = MLton.Exn.history e
|
|
val stackTrace = (String.concatWith "\n" stackTrace) ^ "\n"
|
|
val history = !textCommands ^ "\n\n"
|
|
|
|
val log = String.concat
|
|
["ERROR: ", errName, stackTrace, "HISTORY: ", history]
|
|
|
|
val () = print ("\n" ^ log)
|
|
|
|
val io = TextIO.openAppend "exceptions.log"
|
|
val () = TextIO.output (io, log)
|
|
val () = TextIO.closeOut io
|
|
in
|
|
raise e
|
|
end
|
|
end
|