From 7a7a3b65f89173f421d1f42abbdad06f8be199e1 Mon Sep 17 00:00:00 2001
From: outfoxxed <outfoxxed@outfoxxed.me>
Date: Mon, 10 Feb 2025 22:36:44 -0800
Subject: [PATCH] refactor template map to use Text over String

---
 src/PlausibleQuery.hs |  9 ++++++---
 src/Server.hs         | 23 +++++++++++------------
 src/TemplateLoader.hs |  7 +++++--
 3 files changed, 22 insertions(+), 17 deletions(-)

diff --git a/src/PlausibleQuery.hs b/src/PlausibleQuery.hs
index 293978b..4c999a2 100644
--- a/src/PlausibleQuery.hs
+++ b/src/PlausibleQuery.hs
@@ -30,9 +30,12 @@ parseMetricsResponse MetricsResponse { results = r } = Map.fromList <$> mapM par
         parseResult MRResult { metrics = [count], dimensions = [path] } = Right (removeTrailingSlash path, count)
         parseResult result = Left $ "Could not parse result: " ++ show result
 
-        removeTrailingSlash "" = ""
-        removeTrailingSlash "/" = ""
-        removeTrailingSlash (x:xs) = x : removeTrailingSlash xs
+        removeTrailingSlash "/" = "/"
+        removeTrailingSlash xs = removeTrailingSlash' xs
+
+        removeTrailingSlash' "" = ""
+        removeTrailingSlash' "/" = ""
+        removeTrailingSlash' (x:xs) = x : removeTrailingSlash' xs
 
 queryPageviews :: C.Config -> IO (Either String (Map String Int))
 queryPageviews config = do
diff --git a/src/Server.hs b/src/Server.hs
index 50a5a4d..8672048 100644
--- a/src/Server.hs
+++ b/src/Server.hs
@@ -5,27 +5,26 @@ module Server (
 ) where
 
 import Control.Applicative ((<|>))
+import Control.Concurrent (MVar, readMVar, tryPutMVar)
+import Data.Map (Map)
+import qualified Data.Text as T
+import Data.Text (Text)
+import qualified Data.ByteString as BS
+import Data.ByteString (ByteString)
 import Network.Wai (Application, Response, responseLBS, Request (pathInfo))
 import Network.Wai.Handler.Warp (run)
 import qualified Network.HTTP.Types as H
 import qualified Data.Map as Map
-import Data.Map (Map)
-import qualified Data.Text as T
 
 import TemplatePage (PageContext, PageTemplate, buildPage)
 
-import qualified Data.ByteString as BS
-import Data.ByteString (ByteString)
-import Control.Concurrent (MVar, readMVar, tryPutMVar)
-
-app :: Map String PageTemplate -> MVar PageContext -> MVar () -> Application
+app :: Map Text PageTemplate -> MVar PageContext -> MVar () -> Application
 app templates context updateNotify request respond = do
-   let path = T.unpack $ T.intercalate "/" $ filter (not . T.null) $ pathInfo request
-       slashPath = if path /= "" then '/' : path else path
-       indexPath = slashPath ++ "/index.html"
+   let path = T.concat ["/", T.intercalate "/" $ filter (not . T.null) (pathInfo request)]
+       indexPath = T.concat [path, "/index.html"]
        template = Map.lookup path templates <|> Map.lookup indexPath templates
 
-   putStrLn $ "Page requested: " ++ slashPath
+   putStrLn $ "Page requested: " ++ T.unpack path
    context' <- readMVar context
 
    -- Unblock pageview cache if waiting for a request.
@@ -40,5 +39,5 @@ respMaybe (Just text) = responseLBS H.status200 [("content-type", "text/html")]
 notFound :: Response
 notFound = responseLBS H.status404 [(H.hContentType, "text/plain")] "404 - File not found"
 
-servePages :: Int -> Map String PageTemplate -> MVar PageContext -> MVar () -> IO ()
+servePages :: Int -> Map Text PageTemplate -> MVar PageContext -> MVar () -> IO ()
 servePages port templates context updateNotify = run port $ app templates context updateNotify
diff --git a/src/TemplateLoader.hs b/src/TemplateLoader.hs
index 2502a5c..b1a3244 100644
--- a/src/TemplateLoader.hs
+++ b/src/TemplateLoader.hs
@@ -4,13 +4,16 @@ import Data.Bool (bool)
 import System.FilePath ((</>))
 import System.Directory (listDirectory, doesDirectoryExist)
 import qualified Data.ByteString as BS
+import qualified Data.Text as T
+import Data.Text (Text)
+
 import TemplatePage (PageTemplate, parsePage, isUntemplated)
 
 walkFiles :: FilePath -> IO [FilePath]
 walkFiles path = foldr (mappend . forEntry . (path </>)) mempty =<< listDirectory path
   where forEntry path' = bool (pure [path']) (walkFiles path') =<< doesDirectoryExist path'
 
-loadTemplates :: String -> FilePath -> IO [(String, PageTemplate)]
+loadTemplates :: String -> FilePath -> IO [(Text, PageTemplate)]
 loadTemplates baseUrl basePath = filter (not . isUntemplated . snd) <$> (mapM loadTemplate =<< walkFiles basePath)
-  where pathToUrl path = baseUrl ++ drop (length basePath) path
+  where pathToUrl path = T.pack $ baseUrl ++ drop (length basePath) path
         loadTemplate path = (\d -> (pathToUrl path, parsePage d)) <$> BS.readFile path