refactor template map to use Text over String

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 "/" = ""
+        removeTrailingSlash xs = removeTrailingSlash' xs
-        removeTrailingSlash (x:xs) = x : removeTrailingSlash xs
+
+        removeTrailingSlash' "" = ""
+        removeTrailingSlash' "/" = ""
+        removeTrailingSlash' (x:xs) = x : removeTrailingSlash' xs
 
 queryPageviews :: C.Config -> IO (Either String (Map String Int))
 queryPageviews config = do

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
+app :: Map Text PageTemplate -> MVar PageContext -> MVar () -> Application
-import Data.ByteString (ByteString)
-import Control.Concurrent (MVar, readMVar, tryPutMVar)
-
-app :: Map String PageTemplate -> MVar PageContext -> MVar () -> Application
 app templates context updateNotify request respond = do
-   let path = T.unpack $ T.intercalate "/" $ filter (not . T.null) $ pathInfo request
+   let path = T.concat ["/", T.intercalate "/" $ filter (not . T.null) (pathInfo request)]
-       slashPath = if path /= "" then '/' : path else path
+       indexPath = T.concat [path, "/index.html"]
-       indexPath = slashPath ++ "/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

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