outfoxxed/blog-proxy
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

refactor template map to use Text over String

Browse source
This commit is contained in:
outfoxxed 2025-02-10 22:36:44 -08:00
parent ba38e5e66e
commit 7a7a3b65f8
Signed by: outfoxxed
GPG key ID: 4C88A185FB89301E
3 changed files with 22 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

23
src/Server.hs
View file

@ -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