使用 Yesod 的可配置路径前缀
Configurable path prefix with Yesod
我有以下网络服务器:
{-# 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
,但好像不行...
我正在使用 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"]
如果您知道更好的方法,请发表评论或添加答案。谢谢!
我有以下网络服务器:
{-# 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
,但好像不行...
我正在使用 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"]
如果您知道更好的方法,请发表评论或添加答案。谢谢!