webyesod: --host and --port options set the webserver's base url and tcp port

Hledger/Cli/Commands/WebYesod.hs

@@ -36,45 +36,47 @@ import Paths_hledger (getDataFileName)
 #endif
 
 
-hostname = "localhost"
+defhost = "localhost"
-tcpport  = 5000
+defport = 5000
-
 browserstartdelay = 100000 -- microseconds
-
-homeurl = printf "http://%s:%d" hostname tcpport
 hledgerurl = "http://hledger.org"
 manualurl = hledgerurl++"/MANUAL.html"
 
 web :: [Opt] -> [String] -> Journal -> IO ()
 web opts args j = do
-  unless (Debug `elem` opts) $ forkIO browser >> return ()
+  let host = fromMaybe defhost $ hostFromOpts opts
-  server opts args j
+      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
 
-browser :: IO ()
+browser :: String -> IO ()
-browser = putStrLn "starting web browser" >> threadDelay browserstartdelay >> openBrowserOn homeurl >> return ()
+browser url = putStrLn "starting web browser" >> threadDelay browserstartdelay >> openBrowserOn url >> return ()
 
-server :: [Opt] -> [String] -> Journal -> IO ()
+server :: String -> Int -> [Opt] -> [String] -> Journal -> IO ()
-server opts args j = do
+server url port opts args j = do
-    printf "starting web server on port %d\n" tcpport
+    printf "starting web server at %s\n" url
     fp <- getDataFileName "web"
     let app = HledgerWebApp{
                appOpts=opts
               ,appArgs=args
               ,appJournal=j
               ,appWebdir=fp
+              ,appRoot=url
               }
     withStore "hledger" $ do -- IO ()
      putValue "hledger" "journal" j
-     toWaiApp app >>= basicHandler tcpport
+     toWaiApp app >>= basicHandler port
 
 data HledgerWebApp = HledgerWebApp {
       appOpts::[Opt]
      ,appArgs::[String]
      ,appJournal::Journal
      ,appWebdir::FilePath
+     ,appRoot::String
      }
 
-instance Yesod HledgerWebApp where approot _ = homeurl
+instance Yesod HledgerWebApp where approot = appRoot
 
 mkYesod "HledgerWebApp" [$parseRoutes|
 /             IndexPage        GET

Hledger/Cli/Options.hs

@@ -81,6 +81,10 @@ options = [
  ,Option "M" ["monthly"]      (NoArg  MonthlyOpt)    "register report: show monthly summary"
  ,Option "Q" ["quarterly"]    (NoArg  QuarterlyOpt)  "register report: show quarterly summary"
  ,Option "Y" ["yearly"]       (NoArg  YearlyOpt)     "register report: show yearly summary"
+#if defined(WEB) || defined(WEBYESOD)
+ ,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"
+#endif
  ,Option "h"  ["help"] (NoArg  Help)                  "show this help"
  ,Option "V" ["version"]      (NoArg  Version)       "show version information"
  ,Option "v" ["verbose"]      (NoArg  Verbose)       "show verbose test output"
@@ -115,6 +119,10 @@ data Opt =
     MonthlyOpt |
     QuarterlyOpt |
     YearlyOpt |
+#if defined(WEB) || defined(WEBYESOD)
+    Host    {value::String} |
+    Port    {value::String} |
+#endif
     Help |
     Verbose |
     Version
@@ -216,6 +224,23 @@ displayExprFromOpts opts = listtomaybe $ optValuesForConstructor Display opts
       listtomaybe [] = Nothing
       listtomaybe vs = Just $ last vs
 
+#if defined(WEB) || defined(WEBYESOD)
+-- | Get the value of the (last) host option, if any.
+hostFromOpts :: [Opt] -> Maybe String
+hostFromOpts opts = listtomaybe $ optValuesForConstructor Host opts
+    where
+      listtomaybe [] = Nothing
+      listtomaybe vs = Just $ last vs
+
+-- | Get the value of the (last) port option, if any.
+portFromOpts :: [Opt] -> Maybe Int
+portFromOpts opts = listtomaybeint $ optValuesForConstructor Port opts
+    where
+      listtomaybeint [] = Nothing
+      listtomaybeint vs = Just $ read $ last vs
+
+#endif
+
 -- | Get a maybe boolean representing the last cleared/uncleared option if any.
 clearedValueFromOpts opts | null os = Nothing
                           | last os == Cleared = Just True

MANUAL.markdown

@@ -273,6 +273,8 @@ Here is the command-line help:
      -M       --monthly            register report: show monthly summary
      -Q       --quarterly          register report: show quarterly summary
      -Y       --yearly             register report: show yearly summary
+              --host               web: use hostname HOST rather than localhost
+              --port               web: use tcp port N rather than 5000
      -h       --help               show this help
      -V       --version            show version information
      -v       --verbose            show verbose test output
@@ -405,7 +407,7 @@ balance and add commands.
 Examples:
 
     $ hledger web
-    $ hledger web --debug -f demo.ledger -p thisyear
+    $ hledger web --host this.host.com --port 5010 --debug -f demo.ledger -p thisyear
 
 #### Other commands