blob: d5b01583e32a49a5c9c3a8fb222cd35b48ffca7f (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
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
|
