web: --server flag re-enables long-running, request-logging mode; output cleanups

MANUAL.md

@@ -764,15 +764,19 @@ register view, and also basic data entry and editing.
 
 web-specific options:
 
+    --server           log requests, don't exit on inactivity
     --port=N           serve on tcp port N (default 5000)
     --base-url=URL     use this base url (default http://localhost:PORT/PATH)
 
-If you want to visit the web UI from other machines, you'll need
+By default, the web command starts a transient local web app and 
+launches a web browser window to view it.
+To run it as a long-running web app, with requests logged, use `--server`.
+Typically in this case you'll also want to use use
 `--base-url` to specify the protocol/hostname/port/path to use in
 hyperlinks. This also lets you conform to a custom url scheme when
 running hledger-web behind a reverse proxy as part of a larger
-site. Note that PORT in the base url need not be the same as the
+site. You may also need `--port`, eg if you are running multiple hledger-web instances.
-`--port` argument.
+Note `--port`'s argument need not be the same as the PORT in the base url.
 
 Warning: unlike other hledger commands, `web` can alter existing journal
 data, via the edit form.  A numbered backup of the file will be saved on
@@ -790,7 +794,7 @@ Examples:
 
     $ hledger-web
     $ hledger-web -E -B --depth 2 -f some.journal
-    $ hledger-web --port 5010 --base-url http://some.vhost.com --debug
+    $ hledger-web --server --port 5010 --base-url http://some.vhost.com --debug
 
 #### interest
 

hledger-web/Application.hs

@@ -10,7 +10,7 @@ import Import
 import Yesod.Default.Config
 import Yesod.Default.Main
 import Yesod.Default.Handlers
-import Network.Wai.Middleware.RequestLogger (logStdoutDev) -- , logStdout
+import Network.Wai.Middleware.RequestLogger (logStdoutDev, logStdout)
 import Network.HTTP.Conduit (newManager, def)
 
 -- Import all relevant handler modules here.
@@ -21,7 +21,7 @@ import Handler.JournalEditR
 import Handler.JournalEntriesR
 import Handler.RegisterR
 
-import Hledger.Web.Options (defwebopts)
+import Hledger.Web.Options (WebOpts(..), defwebopts)
 import Hledger.Data (Journal, nulljournal)
 import Hledger.Read (readJournalFile)
 import Hledger.Utils (error')
@@ -36,15 +36,16 @@ mkYesodDispatch "App" resourcesApp
 -- performs initialization and creates a WAI application. This is also the
 -- place to put your migrate statements to have automatic database
 -- migrations handled by Yesod.
-makeApplication :: Journal -> AppConfig DefaultEnv Extra -> IO Application
+makeApplication :: WebOpts -> Journal -> AppConfig DefaultEnv Extra -> IO Application
-makeApplication j conf = do
+makeApplication opts j conf = do
     foundation <- makeFoundation conf
     writeIORef (appJournal foundation) j
     app <- toWaiAppPlain foundation
     return $ logWare app
   where
-    logWare   = if development then logStdoutDev
+    logWare | development  = logStdoutDev
-                               else id -- logStdout
+            | server_ opts = logStdout
+            | otherwise    = id
 
 makeFoundation :: AppConfig DefaultEnv Extra -> IO App
 makeFoundation conf = do
@@ -59,7 +60,7 @@ getApplicationDev :: IO (Int, Application)
 getApplicationDev = do
   f <- journalFilePathFromOpts defcliopts
   j <- either error' id `fmap` readJournalFile Nothing Nothing f
-  defaultDevelApp loader (makeApplication j)
+  defaultDevelApp loader (makeApplication defwebopts j)
   where
     loader = loadConfig (configSettings Development)
         { csParseExtra = parseExtra

hledger-web/Hledger/Web/Main.hs

@@ -60,19 +60,19 @@ web opts j = do
   let j' = filterJournalTransactions (queryFromOpts d $ reportopts_ $ cliopts_ opts) j
       p = port_ opts
       u = base_url_ opts
-  _ <- printf "Starting http server on port %d with base url %s\n" p u
+  _ <- printf "Starting web app on port %d with base url %s\n" p u
-  app <- makeApplication j' AppConfig{appEnv = Development
+  app <- makeApplication opts j' AppConfig{appEnv = Development
                                           ,appPort = p
                                           ,appRoot = pack u
                                           ,appHost = HostIPv4
                                           ,appExtra = Extra "" Nothing
                                           }
-  if False
+  if server_ opts
    then
     runSettings defaultSettings{settingsPort=p} app
    else do
     putStrLn "Launching web browser" >> hFlush stdout
     forkIO $ runUrlPort p "" app
-    putStrLn "Press ENTER to quit (or close browser windows for 2 minutes)" >> hFlush stdout
+    putStrLn "Press ENTER, or close browser windows for 2 minutes, to quit web app" >> hFlush stdout
     getLine >> exitSuccess
     

hledger-web/Hledger/Web/Options.hs

@@ -28,7 +28,8 @@ defbaseurlexample = (reverse $ drop 4 $ reverse $ defbaseurl defport) ++ "PORT"
 
 webflags :: [Flag [([Char], [Char])]]
 webflags = [
-  flagReq ["base-url"]  (\s opts -> Right $ setopt "base-url" s opts) "URL" ("set the base url (default: "++defbaseurlexample++")")
+  flagNone ["server"]  (setboolopt "server") ("log requests, don't auto-exit")
+ ,flagReq ["base-url"]  (\s opts -> Right $ setopt "base-url" s opts) "URL" ("set the base url (default: "++defbaseurlexample++")")
  ,flagReq ["port"]  (\s opts -> Right $ setopt "port" s opts) "PORT" ("listen on this tcp port (default: "++show defport++")")
  ]
  
@@ -48,7 +49,8 @@ webmode =  (mode "hledger-web" [("command","web")]
 
 -- hledger-web options, used in hledger-web and above
 data WebOpts = WebOpts {
-     base_url_ :: String
+     server_   :: Bool
+    ,base_url_ :: String
     ,port_     :: Int
     ,cliopts_  :: CliOpts
  } deriving (Show)
@@ -58,6 +60,7 @@ defwebopts = WebOpts
     def
     def
     def
+    def
 
 -- instance Default WebOpts where def = defwebopts
 
@@ -67,6 +70,7 @@ toWebOpts rawopts = do
   let p = fromMaybe defport $ maybeintopt "port" rawopts
   return defwebopts {
               port_ = p
+             ,server_ = boolopt "server" rawopts
              ,base_url_ = maybe (defbaseurl p) stripTrailingSlash $ maybestringopt "base-url" rawopts
              ,cliopts_   = cliopts
              }