Merge pull request #49 from 40ants/two-actions-improvements

Two actions improvements

src/actions.lisp

@@ -2,9 +2,6 @@
   (:use #:cl)
   (:import-from #:log)
   (:import-from #:yason)
-  (:import-from #:reblocks/app
-                #:get-prefix
-                #:get-prefix-actions)
   (:import-from #:reblocks/utils/misc
                 #:safe-apply)
   (:import-from #:reblocks/variables
@@ -36,6 +33,8 @@
                 #:get-action)
   (:import-from #:serapeum
                 #:dict)
+  (:import-from #:reblocks/utils/uri
+                #:remove-parameter-from-uri)
 
   (:export #:eval-action
            #:on-missing-action
@@ -149,7 +148,10 @@ situation (e.g. redirect, signal an error, etc.)."))
    function, adds it to the session actions and returns its unique code as a string.
    Otherwise, checks if the action already exists. If it does, returns the argument as is.
    If it does not, signals an error."
-  (cond ((functionp function-or-action)
+  (cond ((or (functionp function-or-action)
+             (and (typep function-or-action
+                         'symbol)
+                  (fboundp function-or-action)))
          ;; If it is a function, first we'll try to find
          ;; a code for it in the session.
          (multiple-value-bind (code code-p)
@@ -279,10 +281,19 @@ situation (e.g. redirect, signal an error, etc.)."))
           (get-session-action action-name)))))
 
 
+(defun remove-action-from-uri (uri)
+  "Removes the action info from a URI."
+  (remove-parameter-from-uri uri *action-string*))
+
+
 (defmethod on-missing-action (app action-name)
-  (cond
-    (*ignore-missing-actions*
-     (redirect
-      (make-uri (get-prefix app))))
-    (t
-     (error "Cannot find action: ~A" action-name))))
+  (flet ((refresh ()
+           (redirect (remove-action-from-uri
+                      (reblocks/request:get-uri)))))
+    (cond
+      (*ignore-missing-actions*
+       (refresh))
+      (t
+       (cerror "Refresh page."
+               "Cannot find action: ~A" action-name)
+       (refresh)))))

src/doc/changelog.lisp

@@ -34,6 +34,16 @@
                                                    "REBLOCKS/SESSION:INIT")
                                     :external-links (("Ultralisp" . "https://ultralisp.org"))
                                     :external-docs ("https://40ants.com/log4cl-extras/"))
+  (0.57.0 2024-01-08
+          """
+Added
+=====
+
+* Error about missing action now is continuable. In case if \"continue\" restart was selected,
+  page is refreshed to update actions in the session.
+* Now it is possible to use symbol as an action and it will be funcalled to handle an action.
+
+""")
   (0.56.0 2024-01-01
           """
 Added

src/request-handler.lisp

@@ -9,8 +9,6 @@
                 #:ajax-request-p)
   (:import-from #:reblocks/utils/list
                 #:alist->plist)
-  (:import-from #:reblocks/utils/uri
-                #:remove-parameter-from-uri)
   (:import-from #:reblocks/page
                 #:in-page-context-p
                 #:*current-page*
@@ -33,6 +31,7 @@
   (:import-from #:reblocks/app
                 #:app)
   (:import-from #:reblocks/actions
+                #:remove-action-from-uri
                 #:eval-action)
   (:import-from #:reblocks/commands
                 #:get-collected-commands)
@@ -212,11 +211,6 @@ customize behavior."))
       (render-page-with-widgets app))))
 
 
-(defun remove-action-from-uri (uri)
-  "Removes the action info from a URI."
-  (remove-parameter-from-uri uri *action-string*))
-
-
 (defun handle-action-if-needed (app)
   (let ((action-name (get-action-name-from-request))
         (action-arguments

src/request.lisp

@@ -19,9 +19,7 @@
                 #:assoc-value)
   (:import-from #:reblocks/variables
                 #:*action-string*)
-  (:import-from #:reblocks/utils/uri
-                #:query-string->alist)
-
+
   ;; Just to add dependency
   (:import-from #:quri)
   (:import-from #:str
@@ -211,7 +209,7 @@ if there is an action involved (even if the user hits refresh)."
 (defun parse-location-hash ()
   (let ((raw-hash (get-parameter "reblocks-internal-location-hash")))
     (when raw-hash
-      (query-string->alist (cl-ppcre:regex-replace "^#" raw-hash "")))))
+      (quri:url-decode-params (cl-ppcre:regex-replace "^#" raw-hash "")))))
 
 
 ;; (defmacro with-path ((path) &body body)

src/utils/uri.lisp

@@ -44,14 +44,3 @@
 
 (defun remove-url-query-string (str)
   (cl-ppcre:regex-replace "\\?.*" str ""))
-
-(defun query-string->alist (query-string)
-  ;; stolen from cl-oauth -- does one of ours deps already offer this?
-  ;; TODO: doesn't handle leading ? or #
-  (check-type query-string string)
-  (let* ((kv-pairs (remove "" (cl-ppcre:split "&" query-string) :test #'equal))
-         (alist (mapcar (lambda (kv-pair)
-                          (let ((kv (cl-ppcre:split "=" kv-pair)))
-                            (cons (first kv) (second kv))))
-                        kv-pairs)))
-    alist))

t/request-handler.lisp

@@ -50,7 +50,7 @@
                    302)
             "And response code should be 302")
 
-        (testing "And user should be redirected to the app's prefix uri."
+        (testing "And user should be redirected to the same page, but without action parameter."
           (assert-that (get-custom-headers response)
-                       (has-plist-entries :location "http://localhost/test/my-app")))))))
+                       (has-plist-entries :location "http://localhost/foo/bar?")))))))