slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

web: modify the default base url when a custom port is specified

Browse Source
This commit is contained in:
Simon Michael 2011-09-19 03:25:12 +00:00
parent 3e3475bd76
commit 85b2307e78
2 changed files with 7 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
hledger-web/Hledger/Web/Options.hs
View File

@ -5,7 +5,6 @@
module Hledger.Web.Options module Hledger.Web.Options
where where
import Data.Maybe import Data.Maybe
import Data.Text (unpack)
import System.Console.CmdArgs import System.Console.CmdArgs
import System.Console.CmdArgs.Explicit import System.Console.CmdArgs.Explicit
@ -17,8 +16,7 @@ import Hledger.Web.Settings
progname = Hledger.Cli.progname ++ "-web" progname = Hledger.Cli.progname ++ "-web"
progversion = progversionstr progname progversion = progversionstr progname
defbaseurl = unpack defapproot defbaseurl' = (reverse $ drop 4 $ reverse $ defbaseurl defport) ++ "PORT"
defbaseurl' = (reverse $ drop 4 $ reverse defbaseurl) ++ "PORT"
webflags = [ webflags = [
flagReq ["base-url"] (\s opts -> Right $ setopt "base-url" s opts) "URL" ("set the base url (default: "++defbaseurl'++")") flagReq ["base-url"] (\s opts -> Right $ setopt "base-url" s opts) "URL" ("set the base url (default: "++defbaseurl'++")")
@ -55,9 +53,10 @@ defwebopts = WebOpts
toWebOpts :: RawOpts -> IO WebOpts toWebOpts :: RawOpts -> IO WebOpts
toWebOpts rawopts = do toWebOpts rawopts = do
cliopts <- toCliOpts rawopts cliopts <- toCliOpts rawopts
let p = fromMaybe defport $ maybeintopt "port" rawopts
return defwebopts { return defwebopts {
base_url_ = fromMaybe defbaseurl $ maybestringopt "base-url" rawopts port_ = p
,port_ = fromMaybe defport $ maybeintopt "port" rawopts ,base_url_ = fromMaybe (defbaseurl p) $ maybestringopt "base-url" rawopts
,cliopts_ = cliopts ,cliopts_ = cliopts
} }

10
hledger-web/Hledger/Web/Settings.hs
View File

@ -18,9 +18,8 @@ module Hledger.Web.Settings
, AppEnvironment(..) , AppEnvironment(..)
, AppConfig(..) , AppConfig(..)
, defhost
, defport , defport
, defapproot , defbaseurl
, hledgerorgurl , hledgerorgurl
, manualurl , manualurl
, datadir , datadir
@ -51,11 +50,8 @@ manualurl = hledgerorgurl++"/MANUAL.html"
defport :: Int defport :: Int
defport = 5000 defport = 5000
defhost :: String defbaseurl :: Int -> String
defhost = "localhost" defbaseurl port = printf "http://localhost:%d" port
defapproot :: Text
defapproot = pack $ printf "http://%s:%d" defhost defport
data AppEnvironment = Test data AppEnvironment = Test