log exceptions that occur to a local file

This commit is contained in:
2025-08-04 06:23:52 +01:00
parent 528aea59a1
commit 83634ef20e
3 changed files with 40 additions and 15 deletions

1
.gitignore vendored
View File

@@ -1,2 +1,3 @@
shf
shf-tests
exceptions.log

View File

@@ -229,9 +229,7 @@ struct
end
fun yank (shellState: t, str) =
( Glfw.setClipboardString (#window shellState, str);
shellState
)
(Glfw.setClipboardString (#window shellState, str); shellState)
fun consumeDrawEvent (shellState, msg) =
let

View File

@@ -2,6 +2,7 @@ structure UpdateThread =
struct
open CML
open MailboxType
open InputMsg
fun sendMsg (msg, drawMailbox) =
case msg of DRAW msg => Mailbox.send (drawMailbox, msg)
@@ -14,21 +15,46 @@ struct
end
| [] => ()
val textCommands = ref ""
fun addTextCommand inputMsg =
case inputMsg of
CHAR_EVENT chr =>
let
val chr = CharVector.fromList [chr]
val newInput = !textCommands ^ chr
in
textCommands := newInput
end
| _ => ()
fun handleException e =
let
(* print stack trace for debugging purposes,
* and then raise another exception to exit the program *)
val stackTrace = MLton.Exn.history e
val stackTrace = String.concatWith "\n" stackTrace
val () = print "ERROR:\n"
val () = print (stackTrace ^ "\n\n")
val history = !textCommands ^ "\n\n"
val () = print ("HISTORY: " ^ history)
val textOutput = stackTrace ^ "\n" ^ history
val io = TextIO.openAppend "exceptions.log"
val () = TextIO.output (io, textOutput)
val () = TextIO.closeOut io
in
raise Empty
end
fun loop (app: AppType.app_type, inputMailbox, drawMailbox) =
let
val inputMsg = Mailbox.recv inputMailbox
val app =
AppUpdate.update (app, inputMsg)
handle e =>
let
(* print stack trace for debugging purposes,
* and then raise another exception to exit the program *)
val stackTrace = MLton.Exn.history e
val stackTrace = String.concatWith "\n" stackTrace
val () = print (stackTrace ^ "\n")
in
raise Empty
end
val () = addTextCommand inputMsg
val app = AppUpdate.update (app, inputMsg) handle e => handleException e
val () = sendMsgs (#msgs app, drawMailbox)
in