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

This commit is contained in:
Simon Michael 2013-05-01 07:23:59 -07:00
parent 0a47715b17
commit c9b6dd8819
4 changed files with 31 additions and 22 deletions

View File

@ -764,15 +764,19 @@ register view, and also basic data entry and editing.
web-specific options: web-specific options:
--server log requests, don't exit on inactivity
--port=N serve on tcp port N (default 5000) --port=N serve on tcp port N (default 5000)
--base-url=URL use this base url (default http://localhost:PORT/PATH) --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 `--base-url` to specify the protocol/hostname/port/path to use in
hyperlinks. This also lets you conform to a custom url scheme when hyperlinks. This also lets you conform to a custom url scheme when
running hledger-web behind a reverse proxy as part of a larger 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 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 data, via the edit form. A numbered backup of the file will be saved on
@ -790,7 +794,7 @@ Examples:
$ hledger-web $ hledger-web
$ hledger-web -E -B --depth 2 -f some.journal $ 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 #### interest

View File

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

View File

@ -60,19 +60,19 @@ web opts j = do
let j' = filterJournalTransactions (queryFromOpts d $ reportopts_ $ cliopts_ opts) j let j' = filterJournalTransactions (queryFromOpts d $ reportopts_ $ cliopts_ opts) j
p = port_ opts p = port_ opts
u = base_url_ 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 ,appPort = p
,appRoot = pack u ,appRoot = pack u
,appHost = HostIPv4 ,appHost = HostIPv4
,appExtra = Extra "" Nothing ,appExtra = Extra "" Nothing
} }
if False if server_ opts
then then
runSettings defaultSettings{settingsPort=p} app runSettings defaultSettings{settingsPort=p} app
else do else do
putStrLn "Launching web browser" >> hFlush stdout putStrLn "Launching web browser" >> hFlush stdout
forkIO $ runUrlPort p "" app 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 getLine >> exitSuccess

View File

@ -28,7 +28,8 @@ defbaseurlexample = (reverse $ drop 4 $ reverse $ defbaseurl defport) ++ "PORT"
webflags :: [Flag [([Char], [Char])]] webflags :: [Flag [([Char], [Char])]]
webflags = [ 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++")") ,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 -- hledger-web options, used in hledger-web and above
data WebOpts = WebOpts { data WebOpts = WebOpts {
base_url_ :: String server_ :: Bool
,base_url_ :: String
,port_ :: Int ,port_ :: Int
,cliopts_ :: CliOpts ,cliopts_ :: CliOpts
} deriving (Show) } deriving (Show)
@ -58,6 +60,7 @@ defwebopts = WebOpts
def def
def def
def def
def
-- instance Default WebOpts where def = defwebopts -- instance Default WebOpts where def = defwebopts
@ -67,6 +70,7 @@ toWebOpts rawopts = do
let p = fromMaybe defport $ maybeintopt "port" rawopts let p = fromMaybe defport $ maybeintopt "port" rawopts
return defwebopts { return defwebopts {
port_ = p port_ = p
,server_ = boolopt "server" rawopts
,base_url_ = maybe (defbaseurl p) stripTrailingSlash $ maybestringopt "base-url" rawopts ,base_url_ = maybe (defbaseurl p) stripTrailingSlash $ maybestringopt "base-url" rawopts
,cliopts_ = cliopts ,cliopts_ = cliopts
} }