From 4949324e05bd8adfc7465a8270c9607c895d2d0c Mon Sep 17 00:00:00 2001
From: paku <paku@skyizwhite.dev>
Date: Sat, 20 Apr 2024 03:02:38 +0900
Subject: [PATCH] Add trivial-backtrace

---
 qlfile                        | 1 +
 qlfile.lock                   | 4 ++++
 src/config.lisp               | 3 +--
 src/middlewares/recovery.lisp | 9 ++++++++-
 4 files changed, 14 insertions(+), 3 deletions(-)

diff --git a/qlfile b/qlfile
index 128c9a0..2bf9557 100644
--- a/qlfile
+++ b/qlfile
@@ -6,3 +6,4 @@ git ningle-fbr https://github.com/skyizwhite/ningle-fbr.git
 ql cl-ppcre
 ql log4cl
 ql function-cache
+ql trivial-backtrace
diff --git a/qlfile.lock b/qlfile.lock
index 9399038..648bda3 100644
--- a/qlfile.lock
+++ b/qlfile.lock
@@ -34,3 +34,7 @@
  (:class qlot/source/ql:source-ql
   :initargs (:%version :latest)
   :version "ql-2023-10-21"))
+("trivial-backtrace" .
+ (:class qlot/source/ql:source-ql
+  :initargs (:%version :latest)
+  :version "ql-2023-10-21"))
diff --git a/src/config.lisp b/src/config.lisp
index 26c72df..07bc87d 100644
--- a/src/config.lisp
+++ b/src/config.lisp
@@ -1,8 +1,7 @@
 (defpackage #:hp/config
   (:use #:cl)
   (:import-from #:log4cl)
-  (:export #:*env*
-           #:dev-mode-p
+  (:export #:dev-mode-p
            #:prod-mode-p))
 (in-package #:hp/config)
 
diff --git a/src/middlewares/recovery.lisp b/src/middlewares/recovery.lisp
index 0f15496..644f171 100644
--- a/src/middlewares/recovery.lisp
+++ b/src/middlewares/recovery.lisp
@@ -1,9 +1,16 @@
 (defpackage #:hp/middlewares/recovery
   (:use #:cl)
   (:import-from #:log4cl)
+  (:local-nicknames (#:tb #:trivial-backtrace))
+  (:local-nicknames (#:cfg #:hp/config))
   (:export #:*recovery*))
 (in-package #:hp/middlewares/recovery)
 
+(defun message (condition)
+  (if (cfg:dev-mode-p)
+      (tb:print-backtrace condition :output nil)
+      "Internal Server Error"))
+
 (defparameter *recovery*
   (lambda (app)
     (lambda (env)
@@ -12,4 +19,4 @@
         (error (c)
           (log:error "Unhandled error caught: ~a" c)
           `(500 (:content-type "text/plain")
-                ("Internal Server Error")))))))
+                (,(message c))))))))