getApprootText

yesod-core/ChangeLog.md

@@ -1,3 +1,7 @@
+## 1.4.17
+
+* Add `getApprootText`
+
 ## 1.4.16
 
 * Add `guessApproot` and `guessApprootOr`

yesod-core/Yesod/Core.hs

@@ -74,6 +74,7 @@ module Yesod.Core
       -- * Approot
     , guessApproot
     , guessApprootOr
+    , getApprootText
       -- * Misc
     , yesodVersion
     , yesodRender

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
+        Nothing -> getApprootText fallback master req
-                       ApprootRelative  -> ""
-                       ApprootStatic t  -> t
-                       ApprootMaster f  -> f master
-                       ApprootRequest f -> f 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

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 <michael@snoyman.com>