带有 Yesod 的可配置路径前缀答案

【问题标题】：Configurable path prefix with Yesod带有 Yesod 的可配置路径前缀
【发布时间】：2020-05-12 18:48:20
【问题描述】：

我有以下网络服务器：

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE TypeFamilies      #-}
import           Data.Text        (Text)
import           Yesod

data App = App

mkYesod "App" [parseRoutes|
/      HomeR  GET
/link1 Link1R GET
/link2 Link2R GET
/link3 Link3R GET
/link4 Link4R GET
|]

instance Yesod App where

getHomeR :: Handler Html
getHomeR = defaultLayout $ do
    setTitle "Redirects"
    [whamlet|
        <p>
            <a href=@{Link1R}>Click to start the redirect chain!
    |]

getLink1R, getLink2R, getLink3R :: Handler ()
getLink1R = redirect Link2R -- /link2
getLink2R = redirect (Link3R, [("foo", "bar")]) -- /link3?foo=bar
getLink3R = redirect $ Link4R :#: ("baz" :: Text) -- /link4#baz

getLink4R :: Handler Html
getLink4R = defaultLayout
    [whamlet|
        <p>You made it!
    |]

main :: IO ()
main = warp 3000 App

但我有来自环境变量等某处的路由前缀：

/prefix/      HomeR  GET
/prefix/link1 Link1R GET
/prefix/link2 Link2R GET
/prefix/link3 Link3R GET
/prefix/link4 Link4R GET

如何实现？

我尝试了approot，但它似乎不起作用......

【问题讨论】：

我不完全确定我是否理解问题所在。什么不工作？
url 前缀来自设置或环境变量。我不确定最好的方法是什么。
它应该是编译时还是运行时的变量？如果是后者，那么 Template Haskell 不可能用于它。
两者都可以作为一个选项。出于学习目的，两者的最佳方式是什么？我对函数式编程很陌生 :) 非常感谢！
我认为编译时间会更好，但我想学习这两种解决方案。

标签： haskell yesod template-haskell

【解决方案1】：

我正在使用cleanPath 删除前缀：

    cleanPath app s =
        if corrected == s
            then Right $ dropPrefix $ map dropDash s
            else Left corrected
      where
        corrected = filter (not . T.null) s
        dropDash t
            | T.all (== '-') t = T.drop 1 t
            | otherwise = t
        dropPrefix s' = case routePrefix $ appSettings app of
            Nothing -> s'
            Just prefix -> case headMay s' of
                            Just t -> if t == prefix then drop 1 s' else ["wrong prefix"]
                            Nothing -> ["wrong prefix"]

如果您知道更好的方法，请发表评论或添加答案。谢谢！

【讨论】：