From 692773326a0b162fa656ff574f191b1439789bc1 Mon Sep 17 00:00:00 2001
From: Paul Rouse <pgr@doynton.org>
Date: Tue, 13 Oct 2015 15:00:02 +0100
Subject: [PATCH 1/2] Add guessApprootOr function

---
 yesod-core/ChangeLog.md              |  2 +-
 yesod-core/Yesod/Core.hs             |  1 +
 yesod-core/Yesod/Core/Class/Yesod.hs | 15 +++++++++++++--
 3 files changed, 15 insertions(+), 3 deletions(-)

diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md
index 88ab727f..d84a662c 100644
--- a/yesod-core/ChangeLog.md
+++ b/yesod-core/ChangeLog.md
@@ -1,6 +1,6 @@
 ## 1.4.16
 
-* Add `guessApproot`
+* Add `guessApproot` and `guessApprootOr`
 
 ## 1.4.15
 
diff --git a/yesod-core/Yesod/Core.hs b/yesod-core/Yesod/Core.hs
index b3a3cf7d..c6a327d6 100644
--- a/yesod-core/Yesod/Core.hs
+++ b/yesod-core/Yesod/Core.hs
@@ -73,6 +73,7 @@ module Yesod.Core
     , defaultLayoutSub
       -- * Approot
     , guessApproot
+    , guessApprootOr
       -- * Misc
     , yesodVersion
     , yesodRender
diff --git a/yesod-core/Yesod/Core/Class/Yesod.hs b/yesod-core/Yesod/Core/Class/Yesod.hs
index 47f4fb49..30226f12 100644
--- a/yesod-core/Yesod/Core/Class/Yesod.hs
+++ b/yesod-core/Yesod/Core/Class/Yesod.hs
@@ -835,9 +835,20 @@ fileLocationToString loc = (loc_package loc) ++ ':' : (loc_module loc) ++
 --
 -- Since 1.4.16
 guessApproot :: Approot site
-guessApproot = ApprootRequest $ \_master req ->
+guessApproot = guessApprootOr ApprootRelative
+
+-- | Guess the approot based on request headers, with fall back to the
+-- specified 'AppRoot'.
+--
+-- Since 1.4.16
+guessApprootOr :: Approot site -> Approot site
+guessApprootOr fallback = ApprootRequest $ \_master req ->
     case W.requestHeaderHost req of
-        Nothing -> ""
+        Nothing -> case fallback of
+                       ApprootRelative  -> ""
+                       ApprootStatic t  -> t
+                       ApprootMaster f  -> f _master
+                       ApprootRequest f -> f _master req
         Just host ->
             (if Network.Wai.Request.appearsSecure req
                 then "https://"

From e4503ded60932c6d4c82dd806a57b6fc9656b82e Mon Sep 17 00:00:00 2001
From: Paul Rouse <pgr@doynton.org>
Date: Tue, 13 Oct 2015 15:22:30 +0100
Subject: [PATCH 2/2] Remove unnecessary underscores in guessApprootOr

---
 yesod-core/Yesod/Core/Class/Yesod.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/yesod-core/Yesod/Core/Class/Yesod.hs b/yesod-core/Yesod/Core/Class/Yesod.hs
index 30226f12..6c4a582b 100644
--- a/yesod-core/Yesod/Core/Class/Yesod.hs
+++ b/yesod-core/Yesod/Core/Class/Yesod.hs
@@ -842,13 +842,13 @@ guessApproot = guessApprootOr ApprootRelative
 --
 -- Since 1.4.16
 guessApprootOr :: Approot site -> Approot site
-guessApprootOr fallback = ApprootRequest $ \_master req ->
+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
+                       ApprootMaster f  -> f master
+                       ApprootRequest f -> f master req
         Just host ->
             (if Network.Wai.Request.appearsSecure req
                 then "https://"