From 15c39ac6c917630ad6194e056e65ff6d600ffc52 Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Tue, 20 Sep 2011 15:23:55 +0000
Subject: [PATCH] web: prevent an infinite redirect when custom base url has a
 trailing slash

---
 hledger-web/Hledger/Web/Options.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/hledger-web/Hledger/Web/Options.hs b/hledger-web/Hledger/Web/Options.hs
index a827ec8c3..244d4a098 100644
--- a/hledger-web/Hledger/Web/Options.hs
+++ b/hledger-web/Hledger/Web/Options.hs
@@ -56,9 +56,11 @@ toWebOpts rawopts = do
   let p = fromMaybe defport $ maybeintopt "port" rawopts
   return defwebopts {
               port_ = p
-             ,base_url_ = fromMaybe (defbaseurl p) $ maybestringopt "base-url" rawopts
+             ,base_url_ = maybe (defbaseurl p) stripTrailingSlash $ maybestringopt "base-url" rawopts
              ,cliopts_   = cliopts
              }
+  where
+    stripTrailingSlash = reverse . dropWhile (=='/') . reverse -- yesod don't like it
 
 checkWebOpts :: WebOpts -> IO WebOpts
 checkWebOpts opts = do