From 5f040b642dda8d31794f1ed70ccf253a3ece7542 Mon Sep 17 00:00:00 2001
From: Craig Oates <craig@craigoates.net>
Date: Sat, 22 Oct 2022 01:39:14 +0100
Subject: [PATCH] implement build-url and build-url-root functions in utils
 package.

These functions are mostly aimed at the site's XML-generated site map. The piece
together the site's URL from lack's request struct. I don't know if there is a
pre-built string containing this information (I.E. http://localhost:5000 and
http://localhost:5000/testing) which is why I have written these functions.
---
 src/utils.lisp | 25 ++++++++++++++++++++++++-
 src/view.lisp  |  1 -
 2 files changed, 24 insertions(+), 2 deletions(-)

diff --git a/src/utils.lisp b/src/utils.lisp
index a5565e9..0e5d87f 100644
--- a/src/utils.lisp
+++ b/src/utils.lisp
@@ -3,6 +3,7 @@
   (:use #:cl
 	#:caveman2
 	#:log4cl
+        #:xml-emitter
 	#:app-constants
 	#:storage)
   (:export #:i18n-load
@@ -24,7 +25,9 @@
 	   #:format-filename
 	   #:format-keywords
 	   #:build-alert-string
-           #:month-number-to-name)
+           #:month-number-to-name
+           #:build-url-root
+           #:build-url)
   (:documentation "Utilities that do not depend on models."))
 
 (in-package #:utils)
@@ -183,3 +186,23 @@ to operate properly."
         ((= 11 month-number) "November")
         ((= 12 month-number) "December")
         (t nil)))
+
+(defun build-url (request)
+  "Concatenates parts of the web request to form the full URL the user requested."
+  (format nil "~a://~a~a~a"
+          (lack.request:request-uri-scheme request)
+          (lack.request:request-server-name request)
+          (if (string= "localhost" (lack.request:request-server-name request))
+              (format nil ":~a" (lack.request:request-server-port request))
+              "")
+          (lack.request:request-uri request)))
+
+(defun build-url-root (request)
+  "Concatenates parts of the web request to form site's root URL.
+This is mostly used for generating the site map (XML file for crawlers)."
+  (format nil "~a://~a~a"
+          (lack.request:request-uri-scheme request)
+          (lack.request:request-server-name request)
+          (if (string= "localhost" (lack.request:request-server-name request))
+              (format nil ":~a" (lack.request:request-server-port request))
+              "")))
diff --git a/src/view.lisp b/src/view.lisp
index cdcbde7..596e459 100644
--- a/src/view.lisp
+++ b/src/view.lisp
@@ -34,7 +34,6 @@
   (setf (getf (response-headers *response*) :content-type) "application/json")
   (encode-json object))
 
-
 ;;
 ;; Execute package definition