From 0bffdaf882a9ecdae7887ac59223ed489c96dc64 Mon Sep 17 00:00:00 2001
From: Hannes Schulze <contact@haschu.me>
Date: Sat, 3 Oct 2026 22:52:15 +0200
Subject: routing

---
 src/Settlr/Routes.hs | 33 +++++++++++++++++++++++++++++++++
 1 file changed, 33 insertions(+)
 create mode 100644 src/Settlr/Routes.hs

(limited to 'src/Settlr/Routes.hs')

diff --git a/src/Settlr/Routes.hs b/src/Settlr/Routes.hs
new file mode 100644
index 0000000..d5b0158
--- /dev/null
+++ b/src/Settlr/Routes.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Settlr.Routes
+  ( Route(..)
+  , formatRoute
+  , loadRoute
+  ) where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import Control.Monad.Reader (MonadReader, asks)
+import Settlr.Config (Config(..))
+import Data.Maybe (fromMaybe)
+import Network.CGI (MonadCGI, pathInfo)
+
+data Route
+  = RouteHome
+  | RouteNew
+
+formatRoute :: MonadReader Config m => Route -> m Text
+formatRoute route = do base <- asks cfgScriptPath
+                       pure (fromMaybe base (T.stripSuffix "/" base) <> relative route)
+  where relative :: Route -> Text
+        relative RouteHome = "/"
+        relative RouteNew  = "/new"
+
+loadRoute :: MonadCGI m => m (Maybe Route)
+loadRoute = decode . filter (/= T.empty) . T.splitOn "/" . T.pack <$> pathInfo
+  where decode :: [Text] -> Maybe Route
+        decode []      = Just RouteHome
+        decode ["new"] = Just RouteNew
+        decode _       = Nothing
-- 
cgit v1.3.1