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

packagegeddon: make usage and version messages specific to each add-on program

Browse Source 
All this stuff has been split up, except for the moment it's still
necessary to define all option constructors in Hledger.Cli.Options.
This commit is contained in:
Simon Michael 2010-11-26 19:14:09 +00:00
parent 188d936889
commit c6a85c4b88
7 changed files with 232 additions and 166 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
hledger-chart/Hledger/Chart/Main.hs
View File

@ -16,36 +16,59 @@ import Data.Colour.RGBSpace.HSL (hsl)
import Data.Colour.SRGB.Linear (rgb) import Data.Colour.SRGB.Linear (rgb)
import Data.List import Data.List
import Safe (readDef) import Safe (readDef)
import System.Console.GetOpt
#if __GLASGOW_HASKELL__ <= 610 #if __GLASGOW_HASKELL__ <= 610
import Prelude hiding (putStr, putStrLn) import Prelude hiding (putStr, putStrLn)
import System.IO.UTF8 (putStr, putStrLn) import System.IO.UTF8 (putStr, putStrLn)
#endif #endif
import Hledger.Chart
import Hledger.Cli.Commands import Hledger.Cli.Commands
import Hledger.Cli.Options import Hledger.Cli.Options
import Hledger.Cli.Tests import Hledger.Cli.Tests
import Hledger.Cli.Utils (withJournalDo) import Hledger.Cli.Utils (withJournalDo)
import Hledger.Cli.Version (versionmsg, binaryfilename) import Hledger.Cli.Version (progversionstr, binaryfilename)
import Hledger.Data import Hledger.Data
progname_chart = progname_cli ++ "-chart"
defchartoutput = "hledger.png"
defchartitems = 10
defchartsize = "600x400"
options_chart :: [OptDescr Opt]
options_chart = [
Option "o" ["output"] (ReqArg ChartOutput "FILE") ("output filename (default: "++defchartoutput++")")
,Option "" ["items"] (ReqArg ChartItems "N") ("number of accounts to show (default: "++show defchartitems++")")
,Option "" ["size"] (ReqArg ChartSize "WIDTHxHEIGHT") ("image size (default: "++defchartsize++")")
]
usage_preamble_chart =
"Usage: hledger-chart [OPTIONS] [PATTERNS]\n" ++
"\n" ++
"Reads your ~/.journal file, or another specified by $LEDGER or -f, and\n" ++
"generates simple pie chart images.\n" ++
"\n"
usage_options_chart = usageInfo "hledger-chart options:" options_chart ++ "\n"
usage_chart = concat [
usage_preamble_chart
,usage_options_chart
,usage_options_cli
,usage_postscript_cli
]
main :: IO () main :: IO ()
main = do main = do
(opts, cmd, args) <- parseArguments (opts, cmd, args) <- parseArgumentsWith (options_cli++options_chart) usage_chart
run cmd opts args run opts (cmd:args)
where where
run cmd opts args run opts args
| Help `elem` opts = putStr help1 | Help `elem` opts = putStr usage_chart
| HelpOptions `elem` opts = putStr help2 | Version `elem` opts = putStrLn $ progversionstr progname_chart
| HelpAll `elem` opts = putStr $ help1 ++ "\n" ++ help2 | BinaryFilename `elem` opts = putStrLn $ binaryfilename progname_chart
| Version `elem` opts = putStrLn versionmsg | otherwise = withJournalDo opts args "chart" chart
| BinaryFilename `elem` opts = putStrLn binaryfilename
| null cmd = maybe (putStr help1) (withJournalDo opts args cmd) defaultcmd
| cmd `isPrefixOf` "chart" = withJournalDo opts args cmd chart
| otherwise = putStr help1
defaultcmd = Just chart
-- | Generate an image with the pie chart and write it to a file -- | Generate an image with the pie chart and write it to a file
chart :: [Opt] -> [String] -> Journal -> IO () chart :: [Opt] -> [String] -> Journal -> IO ()
@ -54,8 +77,8 @@ chart opts args j = do
let chart = genPie opts (optsToFilterSpec opts args t) j let chart = genPie opts (optsToFilterSpec opts args t) j
renderableToPNGFile (toRenderable chart) w h filename renderableToPNGFile (toRenderable chart) w h filename
where where
filename = getOption opts ChartOutput chartoutput filename = getOption opts ChartOutput defchartoutput
(w,h) = parseSize $ getOption opts ChartSize chartsize (w,h) = parseSize $ getOption opts ChartSize defchartsize
-- | Extract string option value from a list of options or use the default -- | Extract string option value from a list of options or use the default
getOption :: [Opt] -> (String->Opt) -> String -> String getOption :: [Opt] -> (String->Opt) -> String -> String
@ -89,7 +112,7 @@ genPie opts filterspec j = defaultPieLayout { pie_background_ = solidFillStyle $
where where
(topn,rest) = splitAt n $ reverse $ sortBy (comparing snd) t (topn,rest) = splitAt n $ reverse $ sortBy (comparing snd) t
other = ("other", sum $ map snd rest) other = ("other", sum $ map snd rest)
num = readDef (fromIntegral chartitems) (getOption opts ChartItems (show chartitems)) num = readDef (fromIntegral defchartitems) (getOption opts ChartItems (show defchartitems))
hue = if sign > 0 then red else green where (red, green) = (0, 110) hue = if sign > 0 then red else green where (red, green) = (0, 110)
debug s = if Debug `elem` opts then ltrace s else id debug s = if Debug `elem` opts then ltrace s else id

48
hledger-vty/Hledger/Vty/Main.hs
View File

@ -11,34 +11,52 @@ module Hledger.Vty.Main where
import Prelude hiding (putStr, putStrLn) import Prelude hiding (putStr, putStrLn)
import System.IO.UTF8 (putStr, putStrLn) import System.IO.UTF8 (putStr, putStrLn)
#endif #endif
import Safe (headDef)
import Graphics.Vty import Graphics.Vty
import Safe (headDef)
import System.Console.GetOpt
import Hledger.Cli.Balance import Hledger.Cli.Balance
import Hledger.Cli.Options import Hledger.Cli.Options
import Hledger.Cli.Print import Hledger.Cli.Print
import Hledger.Cli.Register import Hledger.Cli.Register
import Hledger.Cli.Utils (withJournalDo) import Hledger.Cli.Utils (withJournalDo)
import Hledger.Cli.Version (versionmsg, binaryfilename) import Hledger.Cli.Version (progversionstr, binaryfilename)
import Hledger.Data import Hledger.Data
progname_vty = progname_cli ++ "-vty"
options_vty :: [OptDescr Opt]
options_vty = [
Option "" ["debug-vty"] (NoArg DebugVty) "run with no terminal output, showing console"
]
usage_preamble_vty =
"Usage: hledger-vty [OPTIONS] [PATTERNS]\n" ++
"\n" ++
"Reads your ~/.journal file, or another specified by $LEDGER or -f, and\n" ++
"starts the full-window curses ui.\n" ++
"\n"
usage_options_vty = usageInfo "hledger-vty options:" options_vty ++ "\n"
usage_vty = concat [
usage_preamble_vty
,usage_options_vty
,usage_options_cli
,usage_postscript_cli
]
main :: IO () main :: IO ()
main = do main = do
(opts, cmd, args) <- parseArguments (opts, cmd, args) <- parseArgumentsWith (options_cli++options_vty) usage_vty
run cmd opts args run opts (cmd:args)
where where
run cmd opts args run opts args
| Help `elem` opts = putStr help1 | Help `elem` opts = putStr usage_vty
| HelpOptions `elem` opts = putStr help2 | Version `elem` opts = putStrLn $ progversionstr progname_vty
| HelpAll `elem` opts = putStr $ help1 ++ "\n" ++ help2 | BinaryFilename `elem` opts = putStrLn $ binaryfilename progname_vty
| Version `elem` opts = putStrLn versionmsg | otherwise = withJournalDo opts args "vty" vty
| BinaryFilename `elem` opts = putStrLn binaryfilename
| null cmd = maybe (putStr help1) (withJournalDo opts args cmd) defaultcmd
| cmd `isPrefixOf` "vty" = withJournalDo opts args cmd vty
| otherwise = putStr help1
defaultcmd = Just vty
helpmsg = "(b)alance, (r)egister, (p)rint, (right) to drill down, (left) to back up, (q)uit" helpmsg = "(b)alance, (r)egister, (p)rint, (right) to drill down, (left) to back up, (q)uit"

50
hledger-web/Hledger/Web/Main.hs
View File

@ -13,37 +13,55 @@ import System.IO.UTF8 (putStr, putStrLn)
#endif #endif
import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent (forkIO, threadDelay)
import Network.Wai.Handler.SimpleServer (run) import Network.Wai.Handler.SimpleServer (run)
import System.Exit (exitFailure) -- , exitWith, ExitCode(ExitSuccess)) -- base 3 compatible import System.Exit (exitFailure)
import System.IO.Storage (withStore, putValue,) import System.IO.Storage (withStore, putValue,)
import Yesod.Content (typeByExt) import Yesod.Content (typeByExt)
import Yesod.Helpers.Static (fileLookupDir) import Yesod.Helpers.Static (fileLookupDir)
import System.Console.GetOpt
import Hledger.Cli.Options import Hledger.Cli.Options
import Hledger.Cli.Utils (withJournalDo, openBrowserOn) import Hledger.Cli.Utils (withJournalDo, openBrowserOn)
import Hledger.Cli.Version (versionmsg) --, binaryfilename) import Hledger.Cli.Version (progversionstr, binaryfilename)
import Hledger.Data import Hledger.Data
import Hledger.Web.App (App(..), withApp) import Hledger.Web.App (App(..), withApp)
import Hledger.Web.Files (createFilesIfMissing) import Hledger.Web.Files (createFilesIfMissing)
import Hledger.Web.Settings (browserstartdelay, defhost, defport, datadir) import Hledger.Web.Settings (browserstartdelay, defhost, defport, datadir)
progname_web = progname_cli ++ "-web"
options_web :: [OptDescr Opt]
options_web = [
Option "" ["base-url"] (ReqArg BaseUrl "URL") "use this base url (default http://localhost:PORT)"
,Option "" ["port"] (ReqArg Port "N") "serve on tcp port N (default 5000)"
]
usage_preamble_web =
"Usage: hledger-web [OPTIONS] [PATTERNS]\n" ++
"\n" ++
"Reads your ~/.journal file, or another specified by $LEDGER or -f, and\n" ++
"starts a web ui server. Also attempts to start a web browser (unless --debug).\n" ++
"\n"
usage_options_web = usageInfo "hledger-web options:" options_web ++ "\n"
usage_web = concat [
usage_preamble_web
,usage_options_web
,usage_options_cli
,usage_postscript_cli
]
main :: IO () main :: IO ()
main = do main = do
(opts, cmd, args) <- parseArguments (opts, cmd, args) <- parseArgumentsWith (options_cli++options_web) usage_web
run cmd opts args run opts (cmd:args)
where where
run cmd opts args run opts args
| Help `elem` opts = putStr help1 | Help `elem` opts = putStr usage_web
| HelpOptions `elem` opts = putStr help2 | Version `elem` opts = putStrLn $ progversionstr progname_web
| HelpAll `elem` opts = putStr $ help1 ++ "\n" ++ help2 | BinaryFilename `elem` opts = putStrLn $ binaryfilename progname_web
| Version `elem` opts = putStrLn versionmsg | otherwise = withJournalDo opts args "web" web
-- \| BinaryFilename `elem` opts = putStrLn binaryfilename
| null cmd = maybe (putStr help1) (withJournalDo opts args cmd) defaultcmd
| cmd `isPrefixOf` "web" = withJournalDo opts args cmd web
-- \| cmd `isPrefixOf` "test" = runtests opts args >> return ()
| otherwise = putStr help1
defaultcmd = Just web
-- | The web command. -- | The web command.
web :: [Opt] -> [String] -> Journal -> IO () web :: [Opt] -> [String] -> Journal -> IO ()

6
hledger/Hledger/Cli/Convert.hs
View File

@ -4,8 +4,8 @@ format, and print it on stdout. See the manual for more details.
-} -}
module Hledger.Cli.Convert where module Hledger.Cli.Convert where
import Hledger.Cli.Options (Opt(Debug)) import Hledger.Cli.Options (Opt(Debug), progname_cli)
import Hledger.Cli.Version (versionstr) import Hledger.Cli.Version (progversionstr)
import Hledger.Data.Types (Journal,AccountName,Transaction(..),Posting(..),PostingType(..)) import Hledger.Data.Types (Journal,AccountName,Transaction(..),Posting(..),PostingType(..))
import Hledger.Data.Utils (strip, spacenonewline, restofline, parseWithCtx, assertParse, assertParseEqual, error') import Hledger.Data.Utils (strip, spacenonewline, restofline, parseWithCtx, assertParse, assertParseEqual, error')
import Hledger.Read.Journal (someamount,ledgeraccountname) import Hledger.Read.Journal (someamount,ledgeraccountname)
@ -116,7 +116,7 @@ rulesFileFor csvfile = replaceExtension csvfile ".rules"
initialRulesFileContent :: String initialRulesFileContent :: String
initialRulesFileContent = initialRulesFileContent =
"# csv conversion rules file generated by hledger "++versionstr++"\n" ++ "# csv conversion rules file generated by "++(progversionstr progname_cli)++"\n" ++
"# Add rules to this file for more accurate conversion, see\n"++ "# Add rules to this file for more accurate conversion, see\n"++
"# http://hledger.org/MANUAL.html#convert\n" ++ "# http://hledger.org/MANUAL.html#convert\n" ++
"\n" ++ "\n" ++

16
hledger/Hledger/Cli/Main.hs
View File

@ -50,20 +50,18 @@ import Hledger.Cli.Commands
import Hledger.Cli.Options import Hledger.Cli.Options
import Hledger.Cli.Tests import Hledger.Cli.Tests
import Hledger.Cli.Utils (withJournalDo) import Hledger.Cli.Utils (withJournalDo)
import Hledger.Cli.Version (versionmsg, binaryfilename) import Hledger.Cli.Version (progversionstr, binaryfilename)
main :: IO () main :: IO ()
main = do main = do
(opts, cmd, args) <- parseArguments (opts, cmd, args) <- parseArgumentsWith options_cli usage_cli
run cmd opts args run cmd opts args
where where
run cmd opts args run cmd opts args
| Help `elem` opts = putStr help1 | Help `elem` opts = putStr usage_cli
| HelpOptions `elem` opts = putStr help2 | Version `elem` opts = putStrLn $ progversionstr progname_cli
| HelpAll `elem` opts = putStr $ help1 ++ "\n" ++ help2 | BinaryFilename `elem` opts = putStrLn $ binaryfilename progname_cli
| Version `elem` opts = putStrLn versionmsg | null cmd = maybe (putStr usage_cli) (withJournalDo opts args cmd) defaultcmd
| BinaryFilename `elem` opts = putStrLn binaryfilename
| null cmd = maybe (putStr help1) (withJournalDo opts args cmd) defaultcmd
| cmd `isPrefixOf` "balance" = withJournalDo opts args cmd balance | cmd `isPrefixOf` "balance" = withJournalDo opts args cmd balance
| cmd `isPrefixOf` "convert" = withJournalDo opts args cmd convert | cmd `isPrefixOf` "convert" = withJournalDo opts args cmd convert
| cmd `isPrefixOf` "print" = withJournalDo opts args cmd print' | cmd `isPrefixOf` "print" = withJournalDo opts args cmd print'
@ -72,6 +70,6 @@ main = do
| cmd `isPrefixOf` "add" = withJournalDo opts args cmd add | cmd `isPrefixOf` "add" = withJournalDo opts args cmd add
| cmd `isPrefixOf` "stats" = withJournalDo opts args cmd stats | cmd `isPrefixOf` "stats" = withJournalDo opts args cmd stats
| cmd `isPrefixOf` "test" = runtests opts args >> return () | cmd `isPrefixOf` "test" = runtests opts args >> return ()
| otherwise = putStr help1 | otherwise = putStr usage_cli
defaultcmd = Nothing defaultcmd = Nothing

151
hledger/Hledger/Cli/Options.hs
View File

@ -5,49 +5,58 @@ Command-line options for the application.
module Hledger.Cli.Options module Hledger.Cli.Options
where where
import Safe (headDef) import Codec.Binary.UTF8.String (decodeString)
import System.Console.GetOpt import System.Console.GetOpt
import System.Environment import System.Environment
import Hledger.Cli.Version (timeprogname)
import Hledger.Read (myJournalPath, myTimelogPath)
import Hledger.Data.Utils import Hledger.Data.Utils
import Hledger.Data.Types import Hledger.Data.Types
import Hledger.Data.Dates import Hledger.Data.Dates
import Codec.Binary.UTF8.String (decodeString) import Hledger.Read (myJournalPath, myTimelogPath)
help1 =
progname_cli = "hledger"
-- | The program name which, if we are invoked as (via symlink or
-- renaming), causes us to default to reading the user's time log instead
-- of their journal.
progname_cli_time = "hours"
usage_preamble_cli =
"Usage: hledger [OPTIONS] COMMAND [PATTERNS]\n" ++ "Usage: hledger [OPTIONS] COMMAND [PATTERNS]\n" ++
" hledger [OPTIONS] convert CSVFILE\n" ++ " hledger [OPTIONS] convert CSVFILE\n" ++
" hledger [OPTIONS] stats\n" ++
"\n" ++ "\n" ++
"hledger reads your ~/.journal file, or another specified with $LEDGER or -f\n" ++ "Reads your ~/.journal file, or another specified by $LEDGER or -f, and\n" ++
"runs the specified command (may be abbreviated):\n" ++
"\n" ++ "\n" ++
"COMMAND is one of (may be abbreviated):\n" ++
" add - prompt for new transactions and add them to the journal\n" ++ " add - prompt for new transactions and add them to the journal\n" ++
" balance - show accounts, with balances\n" ++ " balance - show accounts, with balances\n" ++
" convert - read CSV bank data and display in journal format\n" ++ " convert - show the specified CSV file as a hledger journal\n" ++
" histogram - show a barchart of transactions per day or other interval\n" ++ " histogram - show a barchart of transactions per day or other interval\n" ++
" print - show transactions in journal format\n" ++ " print - show transactions in journal format\n" ++
" register - show transactions as a register with running balance\n" ++ " register - show transactions as a register with running balance\n" ++
" stats - show various statistics for a journal\n" ++ " stats - show various statistics for a journal\n" ++
" test - run self-tests\n" ++ " test - run self-tests\n" ++
"\n" ++ "\n"
"PATTERNS are regular expressions which filter by account name.\n" ++
"Prefix with desc: to filter by transaction description instead.\n" ++
"Prefix with not: to negate a pattern. When using both, not: comes last.\n" ++
"\n" ++
"DATES can be y/m/d or ledger-style smart dates like \"last month\".\n" ++
"\n" ++
"Use --help-options to see OPTIONS, or --help-all/-H.\n" ++
""
help2 = usageInfo "Options:\n" options' usage_options_cli = usageInfo "hledger options:" options_cli
where options' = filter (\(Option _ name _ _) -> not $ (headDef "" name) `elem` hiddenoptions) options
hiddenoptions = ["base-url","port","debug-vty","output","items","size"] usage_postscript_cli =
"\n" ++
"DATES can be y/m/d or smart dates like \"last month\". PATTERNS are regular\n" ++
"expressions which filter by account name. Prefix a pattern with desc: to\n" ++
"filter by transaction description instead, prefix with not: to negate it.\n" ++
"When using both, not: comes last.\n"
usage_cli = concat [
usage_preamble_cli
,usage_options_cli
,usage_postscript_cli
]
-- | Command-line options we accept. -- | Command-line options we accept.
options :: [OptDescr Opt] options_cli :: [OptDescr Opt]
options = [ options_cli = [
Option "f" ["file"] (ReqArg File "FILE") "use a different journal/timelog file; - means stdin" Option "f" ["file"] (ReqArg File "FILE") "use a different journal/timelog file; - means stdin"
,Option "" ["no-new-accounts"] (NoArg NoNewAccts) "don't allow to create new accounts" ,Option "" ["no-new-accounts"] (NoArg NoNewAccts) "don't allow to create new accounts"
,Option "b" ["begin"] (ReqArg Begin "DATE") "report on transactions on or after this date" ,Option "b" ["begin"] (ReqArg Begin "DATE") "report on transactions on or after this date"
@ -75,60 +84,45 @@ options = [
,Option "" ["debug"] (NoArg Debug) "show extra debug output; implies verbose" ,Option "" ["debug"] (NoArg Debug) "show extra debug output; implies verbose"
,Option "" ["binary-filename"] (NoArg BinaryFilename) "show the download filename for this hledger build" ,Option "" ["binary-filename"] (NoArg BinaryFilename) "show the download filename for this hledger build"
,Option "V" ["version"] (NoArg Version) "show version information" ,Option "V" ["version"] (NoArg Version) "show version information"
,Option "h" ["help"] (NoArg Help) "show basic command-line usage" ,Option "h" ["help"] (NoArg Help) "show command-line usage"
,Option "" ["help-options"] (NoArg HelpOptions) "show command-line options"
,Option "H" ["help-all"] (NoArg HelpAll) "show command-line usage and options"
-- hidden options needed for add-ons, for now
,Option "" ["base-url"] (ReqArg BaseUrl "URL") "web: use this base url (default http://localhost:PORT)"
,Option "" ["port"] (ReqArg Port "N") "web: serve on tcp port N (default 5000)"
,Option "" ["debug-vty"] (NoArg DebugVty) "vty: run with no terminal output, showing console"
,Option "o" ["output"] (ReqArg ChartOutput "FILE") ("chart: output filename (default: "++chartoutput++")")
,Option "" ["items"] (ReqArg ChartItems "N") ("chart: number of accounts to show (default: "++show chartitems++")")
,Option "" ["size"] (ReqArg ChartSize "WIDTHxHEIGHT") ("chart: image size (default: "++chartsize++")")
] ]
-- - " vty - run a simple curses-style UI" ++
-- - " web - run a simple web-based UI" ++
-- - " chart - generate balances pie charts" ++
chartoutput = "hledger.png"
chartitems = 10
chartsize = "600x400"
-- | An option value from a command-line flag. -- | An option value from a command-line flag.
data Opt = data Opt =
File {value::String} | File {value::String}
NoNewAccts | | NoNewAccts
Begin {value::String} | | Begin {value::String}
End {value::String} | | End {value::String}
Period {value::String} | | Period {value::String}
Cleared | | Cleared
UnCleared | | UnCleared
CostBasis | | CostBasis
Depth {value::String} | | Depth {value::String}
Display {value::String} | | Display {value::String}
Effective | | Effective
Empty | | Empty
Real | | Real
Flat | | Flat
Drop {value::String} | | Drop {value::String}
NoTotal | | NoTotal
SubTotal | | SubTotal
DailyOpt | | DailyOpt
WeeklyOpt | | WeeklyOpt
MonthlyOpt | | MonthlyOpt
QuarterlyOpt | | QuarterlyOpt
YearlyOpt | | YearlyOpt
Help | | Help
HelpOptions | | Verbose
HelpAll | | Version
Verbose |
Version
| BinaryFilename | BinaryFilename
| Debug | Debug
-- -- XXX add-on options, must be defined here for now
-- vty
| DebugVty | DebugVty
| BaseUrl {value::String} -- web
| Port {value::String} | BaseUrl {value::String}
| Port {value::String}
-- chart
| ChartOutput {value::String} | ChartOutput {value::String}
| ChartItems {value::String} | ChartItems {value::String}
| ChartSize {value::String} | ChartSize {value::String}
@ -147,11 +141,14 @@ optValuesForConstructor f opts = concatMap get opts
optValuesForConstructors fs opts = concatMap get opts optValuesForConstructors fs opts = concatMap get opts
where get o = [v | any (\f -> f v == o) fs] where v = value o where get o = [v | any (\f -> f v == o) fs] where v = value o
-- | Parse the command-line arguments into options, command name, and -- | Parse the command-line arguments into options, command name (first
-- command arguments. Any dates in the options are converted to explicit -- argument), and command arguments (rest of arguments), using the
-- YYYY/MM/DD format based on the current time. -- specified options. Any smart dates in the options are converted to
parseArguments :: IO ([Opt], String, [String]) -- explicit YYYY/MM/DD format based on the current time. If parsing fails,
parseArguments = do -- raise an error, displaying the problem along with the specified usage
-- string.
parseArgumentsWith :: [OptDescr Opt] -> String -> IO ([Opt], String, [String])
parseArgumentsWith options usage = do
args <- liftM (map decodeString) getArgs args <- liftM (map decodeString) getArgs
let (os,as,es) = getOpt Permute options args let (os,as,es) = getOpt Permute options args
os' <- fixOptDates os os' <- fixOptDates os
@ -159,7 +156,7 @@ parseArguments = do
case (as,es) of case (as,es) of
(cmd:args,[]) -> return (os'',cmd,args) (cmd:args,[]) -> return (os'',cmd,args)
([],[]) -> return (os'',"",[]) ([],[]) -> return (os'',"",[])
(_,errs) -> ioError (userError' (concat errs ++ help1)) (_,errs) -> ioError (userError' (concat errs ++ usage))
-- | Convert any fuzzy dates within these option values to explicit ones, -- | Convert any fuzzy dates within these option values to explicit ones,
-- based on today's date. -- based on today's date.
@ -257,7 +254,7 @@ clearedValueFromOpts opts | null os = Nothing
usingTimeProgramName :: IO Bool usingTimeProgramName :: IO Bool
usingTimeProgramName = do usingTimeProgramName = do
progname <- getProgName progname <- getProgName
return $ map toLower progname == timeprogname return $ map toLower progname == progname_cli_time
-- | Get the journal file path from options, an environment variable, or a default -- | Get the journal file path from options, an environment variable, or a default
journalFilePathFromOpts :: [Opt] -> IO String journalFilePathFromOpts :: [Opt] -> IO String

68
hledger/Hledger/Cli/Version.hs
View File

@ -4,12 +4,19 @@ Version-related utilities. See the Makefile for details of our version
numbering policy. numbering policy.
-} -}
module Hledger.Cli.Version module Hledger.Cli.Version (
version
,progversionstr
,binaryfilename
)
where where
import System.Info (os, arch) import System.Info (os, arch)
import Hledger.Data.Utils import Hledger.Data.Utils
-- version and PATCHLEVEL are set by the makefile
-- version and PATCHLEVEL are set by the make process
version = "0.13.0" version = "0.13.0"
#ifdef PATCHLEVEL #ifdef PATCHLEVEL
@ -18,15 +25,41 @@ patchlevel = "." ++ show PATCHLEVEL -- must be numeric !
patchlevel = "" patchlevel = ""
#endif #endif
progname = "hledger"
timeprogname = "hours"
buildversion = version ++ patchlevel :: String buildversion = version ++ patchlevel :: String
binaryfilename = prettify $ splitAtElement '.' buildversion :: String -- | Given a program name, return a human-readable version string. For
-- development builds, at least non-cabal builds, the patch level (ie the
-- number of patches applied since last release tag) will also be
-- included.
progversionstr :: String -> String
progversionstr progname = progname ++ "-" ++ versionstr ++ configmsg
where
versionstr = prettify $ splitAtElement '.' buildversion
where
prettify (major:minor:bugfix:patches:[]) =
printf "%s.%s%s%s" major minor bugfix' patches'
where
bugfix'
| bugfix `elem` ["0"{-,"98","99"-}] = ""
| otherwise = '.' : bugfix
patches'
| patches/="0" = "+"++patches
| otherwise = ""
prettify s = intercalate "." s
configmsg | null buildflags = ""
| otherwise = " with " ++ intercalate ", " buildflags
buildflags = []
-- | Given a program name, return a precise platform-specific executable
-- name suitable for naming downloadable binaries. Can raise an error if
-- the version and patch level was not defined correctly at build time.
binaryfilename :: String -> String
binaryfilename progname = prettify $ splitAtElement '.' buildversion
where where
prettify (major:minor:bugfix:patches:[]) = prettify (major:minor:bugfix:patches:[]) =
printf "hledger-%s.%s%s%s-%s-%s%s" major minor bugfix' patches' os' arch suffix printf "%s-%s.%s%s%s-%s-%s%s" progname major minor bugfix' patches' os' arch suffix
where where
bugfix' bugfix'
| bugfix `elem` ["0"{-,"98","99"-}] = "" | bugfix `elem` ["0"{-,"98","99"-}] = ""
@ -43,24 +76,3 @@ binaryfilename = prettify $ splitAtElement '.' buildversion :: String
prettify (major:[]) = prettify [major,"0","0","0"] prettify (major:[]) = prettify [major,"0","0","0"]
prettify [] = error' "VERSION is empty, please fix" prettify [] = error' "VERSION is empty, please fix"
prettify _ = error' "VERSION has too many components, please fix" prettify _ = error' "VERSION has too many components, please fix"
versionstr = prettify $ splitAtElement '.' buildversion :: String
where
prettify (major:minor:bugfix:patches:[]) =
printf "%s.%s%s%s" major minor bugfix' patches'
where
bugfix'
| bugfix `elem` ["0"{-,"98","99"-}] = ""
| otherwise = '.' : bugfix
patches'
| patches/="0" = "+"++patches
| otherwise = ""
prettify s = intercalate "." s
versionmsg = progname ++ "-" ++ versionstr ++ configmsg :: String
where configmsg
| null configflags = " with no extras"
| otherwise = " with " ++ intercalate ", " configflags
configflags = tail [""
]