@@ -625,13 +625,47 @@ printCallStack <- function(call_stack, header=TRUE) {
625
625
)
626
626
}
627
627
628
+ stackTraceToHTML <- function (call_stack ,
629
+ throwing_call ,
630
+ error_message ) {
631
+ if (is.null(call_stack )) {
632
+ return (NULL )
633
+ }
634
+ header <- " ### DashR Traceback (most recent/innermost call last) ###"
635
+
636
+ formattedStack <- c(paste0(
637
+ " " ,
638
+ seq_along(
639
+ call_stack
640
+ ),
641
+ " : " ,
642
+ call_stack ,
643
+ collapse = " <br>"
644
+ )
645
+ )
646
+
647
+ template <- " <!DOCTYPE HTML><html><body><pre><h3>%s</h3><br>Error: %s: %s<br>%s</pre></body></html>"
648
+ response <- sprintf(template ,
649
+ header ,
650
+ throwing_call ,
651
+ error_message ,
652
+ formattedStack )
653
+
654
+ # remove anonymous tags from call stack
655
+ response <- gsub(" <anonymous>" , " <anonymous>" , response )
656
+
657
+ return (response )
658
+ }
659
+
628
660
# This function is essentially the R equivalent of a
629
661
# Python decorator method; if debug mode is active,
630
662
# it will wrap an expression using withCallingHandlers
631
663
# and capture the call stack. By default, the call
632
664
# stack will be "pruned" of error handling functions
633
665
# for greater readability.
634
666
getStackTrace <- function (expr , debug = FALSE , pruned_errors = TRUE ) {
667
+ tryenv <- new.env()
668
+ browser()
635
669
if (debug ) {
636
670
tryCatch(withCallingHandlers(
637
671
expr ,
@@ -689,26 +723,33 @@ getStackTrace <- function(expr, debug = FALSE, pruned_errors = TRUE) {
689
723
690
724
startIndex <- match(TRUE , lapply(functionsAsList , function (fn ) fn == " getStackTrace" ))
691
725
functionsAsList <- function sAsList [startIndex : stopIndex ]
692
- warning(call. = FALSE , immediate. = TRUE , sprintf(" Execution error in %s: %s" ,
693
- functionsAsList [[length(functionsAsList )]],
694
- conditionMessage(e )))
695
- printCallStack(removeHandlers(functionsAsList ))
696
- } else {
697
- warning(call. = FALSE , immediate. = TRUE , sprintf(" Execution error in %s: %s" ,
698
- functionsAsList [[length(functionsAsList )]],
699
- conditionMessage(e )))
700
- printCallStack(functionsAsList )
726
+ functionsAsList <- removeHandlers(functionsAsList )
701
727
}
702
-
728
+ browser()
729
+
730
+ warning(call. = FALSE , immediate. = TRUE , sprintf(" Execution error in %s: %s" ,
731
+ functionsAsList [[length(functionsAsList )]],
732
+ conditionMessage(e )))
733
+
734
+ stack_message <- stackTraceToHTML(functionsAsList ,
735
+ functionsAsList [[length(functionsAsList )]],
736
+ conditionMessage(e ))
737
+
738
+ assign(" stack_message" , value = stack_message ,
739
+ envir = sys.frame(1 )$ private )
740
+
741
+ printCallStack(functionsAsList )
703
742
}
704
743
}
705
744
),
706
- error = function (e ) {write(crayon :: yellow $ bold(" in debug mode, catching error as warning ..." ), stderr())}
745
+ error = function (e ) {
746
+ write(crayon :: yellow $ bold(" in debug mode, catching error as warning ..." ), stderr())
747
+ }
707
748
)
708
- } else {
709
- evalq(expr )
749
+ } else {
750
+ evalq(expr )
751
+ }
710
752
}
711
- }
712
753
713
754
# This helper function drops error
714
755
# handling functions from the call
0 commit comments