diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md index f049b8f6..26ec4e45 100644 --- a/yesod-core/ChangeLog.md +++ b/yesod-core/ChangeLog.md @@ -1,3 +1,7 @@ +## 1.4.17 + +* Add `getApprootText` + ## 1.4.16 * Add `guessApproot` and `guessApprootOr` diff --git a/yesod-core/Yesod/Core.hs b/yesod-core/Yesod/Core.hs index c6a327d6..a63eba8b 100644 --- a/yesod-core/Yesod/Core.hs +++ b/yesod-core/Yesod/Core.hs @@ -74,6 +74,7 @@ module Yesod.Core -- * Approot , guessApproot , guessApprootOr + , getApprootText -- * Misc , yesodVersion , yesodRender diff --git a/yesod-core/Yesod/Core/Class/Yesod.hs b/yesod-core/Yesod/Core/Class/Yesod.hs index 6c4a582b..a56ff0fe 100644 --- a/yesod-core/Yesod/Core/Class/Yesod.hs +++ b/yesod-core/Yesod/Core/Class/Yesod.hs @@ -844,13 +844,20 @@ guessApproot = guessApprootOr ApprootRelative guessApprootOr :: Approot site -> Approot site guessApprootOr fallback = ApprootRequest $ \master req -> case W.requestHeaderHost req of - Nothing -> case fallback of - ApprootRelative -> "" - ApprootStatic t -> t - ApprootMaster f -> f master - ApprootRequest f -> f master req + Nothing -> getApprootText fallback master req Just host -> (if Network.Wai.Request.appearsSecure req then "https://" else "http://") `T.append` TE.decodeUtf8With TEE.lenientDecode host + +-- | Get the textual application root from an 'Approot' value. +-- +-- Since 1.4.17 +getApprootText :: Approot site -> site -> W.Request -> Text +getApprootText ar site req = + case ar of + ApprootRelative -> "" + ApprootStatic t -> t + ApprootMaster f -> f site + ApprootRequest f -> f site req diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index 924e7c17..eef37f49 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.4.16 +version: 1.4.17 license: MIT license-file: LICENSE author: Michael Snoyman