routing

1 files changed, 33 insertions, 0 deletions

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