diff --git a/Hledger/Cli/Commands/WebYesod.hs b/Hledger/Cli/Commands/WebYesod.hs index 1af8cc925..971f0c9c4 100644 --- a/Hledger/Cli/Commands/WebYesod.hs +++ b/Hledger/Cli/Commands/WebYesod.hs @@ -36,45 +36,47 @@ import Paths_hledger (getDataFileName) #endif -hostname = "localhost" -tcpport = 5000 - +defhost = "localhost" +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 () - server opts args j + let host = fromMaybe defhost $ hostFromOpts 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 -browser :: IO () -browser = putStrLn "starting web browser" >> threadDelay browserstartdelay >> openBrowserOn homeurl >> return () +browser :: String -> IO () +browser url = putStrLn "starting web browser" >> threadDelay browserstartdelay >> openBrowserOn url >> return () -server :: [Opt] -> [String] -> Journal -> IO () -server opts args j = do - printf "starting web server on port %d\n" tcpport +server :: String -> Int -> [Opt] -> [String] -> Journal -> IO () +server url port opts args j = do + 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 diff --git a/Hledger/Cli/Options.hs b/Hledger/Cli/Options.hs index 654c93302..1e5493d3b 100644 --- a/Hledger/Cli/Options.hs +++ b/Hledger/Cli/Options.hs @@ -81,7 +81,11 @@ 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" - ,Option "h" ["help"] (NoArg Help) "show this help" +#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" ,Option "" ["binary-filename"] (NoArg BinaryFilename) "show the download filename for this hledger build" @@ -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 diff --git a/MANUAL.markdown b/MANUAL.markdown index d333f6eef..3555a1fb4 100644 --- a/MANUAL.markdown +++ b/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