From 3865759bbd81d737a4bc278f653bc72b17b26f9e Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Thu, 8 Jul 2010 18:47:32 +0000
Subject: [PATCH] webyesod: drop --host, add --base-url option for base url and
 tcp port independence

---
 Hledger/Cli/Commands/Web.hs | 18 +++++++++---------
 Hledger/Cli/Options.hs      | 12 ++++++------
 2 files changed, 15 insertions(+), 15 deletions(-)

diff --git a/Hledger/Cli/Commands/Web.hs b/Hledger/Cli/Commands/Web.hs
index 7596c937b..71645d964 100644
--- a/Hledger/Cli/Commands/Web.hs
+++ b/Hledger/Cli/Commands/Web.hs
@@ -31,35 +31,35 @@ import Paths_hledger (getDataFileName)
 
 defhost = "localhost"
 defport = 5000
+defbaseurl = printf "http://%s:%d" defhost defport :: String
 browserstartdelay = 100000 -- microseconds
 hledgerurl = "http://hledger.org"
 manualurl = hledgerurl++"/MANUAL.html"
 
 web :: [Opt] -> [String] -> Journal -> IO ()
 web opts args j = do
-  let host = fromMaybe defhost $ hostFromOpts opts
+  let baseurl = fromMaybe defbaseurl $ baseUrlFromOpts opts
       port = fromMaybe defport $ portFromOpts opts
-      url = printf "http://%s:%d" host port :: String
-  unless (Debug `elem` opts) $ forkIO (browser url) >> return ()
-  server url port opts args j
+  unless (Debug `elem` opts) $ forkIO (browser baseurl) >> return ()
+  server baseurl port opts args j
 
 browser :: String -> IO ()
-browser url = do
+browser baseurl = do
   putStrLn "starting web browser"
   threadDelay browserstartdelay
-  openBrowserOn url
+  openBrowserOn baseurl
   return ()
 
 server :: String -> Int -> [Opt] -> [String] -> Journal -> IO ()
-server url port opts args j = do
-    printf "starting web server at %s\n" url
+server baseurl port opts args j = do
+    printf "starting web server on port %d with base url %s\n" port baseurl
     fp <- getDataFileName "web"
     let app = HledgerWebApp{
                appOpts=opts
               ,appArgs=args
               ,appJournal=j
               ,appWebdir=fp
-              ,appRoot=url
+              ,appRoot=baseurl
               }
     withStore "hledger" $ do
      putValue "hledger" "journal" j
diff --git a/Hledger/Cli/Options.hs b/Hledger/Cli/Options.hs
index 062552f70..3d0295ae0 100644
--- a/Hledger/Cli/Options.hs
+++ b/Hledger/Cli/Options.hs
@@ -82,8 +82,8 @@ options = [
  ,Option "Q" ["quarterly"]    (NoArg  QuarterlyOpt)  "register report: show quarterly summary"
  ,Option "Y" ["yearly"]       (NoArg  YearlyOpt)     "register report: show yearly summary"
 #ifdef WEB
- ,Option ""  ["host"] (ReqArg Host "HOST")           "web: use hostname HOST rather than localhost"
- ,Option ""  ["port"] (ReqArg Port "N")              "web: use tcp port N rather than 5000"
+ ,Option ""  ["base-url"]     (ReqArg BaseUrl "URL") "web: use this base url (default http://localhost:PORT)"
+ ,Option ""  ["port"]         (ReqArg Port "N")      "web: serve on tcp port N (default 5000)"
 #endif
  ,Option "h"  ["help"] (NoArg  Help)                  "show this help"
  ,Option "V" ["version"]      (NoArg  Version)       "show version information"
@@ -120,7 +120,7 @@ data Opt =
     QuarterlyOpt |
     YearlyOpt |
 #ifdef WEB
-    Host    {value::String} |
+    BaseUrl {value::String} |
     Port    {value::String} |
 #endif
     Help |
@@ -225,9 +225,9 @@ displayExprFromOpts opts = listtomaybe $ optValuesForConstructor Display opts
       listtomaybe vs = Just $ last vs
 
 #ifdef WEB
--- | Get the value of the (last) host option, if any.
-hostFromOpts :: [Opt] -> Maybe String
-hostFromOpts opts = listtomaybe $ optValuesForConstructor Host opts
+-- | Get the value of the (last) baseurl option, if any.
+baseUrlFromOpts :: [Opt] -> Maybe String
+baseUrlFromOpts opts = listtomaybe $ optValuesForConstructor BaseUrl opts
     where
       listtomaybe [] = Nothing
       listtomaybe vs = Just $ last vs