simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-09-20 02:37:12 +03:00
Code Issues Projects Releases Wiki Activity

hledger now detects and runs hledger-* add-ons found in path; many options cleanups

Browse Source
This commit is contained in:
Simon Michael 2011-08-22 14:55:39 +00:00
parent 98509d4bbc
commit 464d8d4bcb
8 changed files with 93 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -18,7 +18,7 @@ import Data.Maybe
import Data.Ord
import Data.Tree
import Graphics.Rendering.Chart
import System.Exit (exitFailure)
import System.Exit
import Text.Printf
import Hledger
@ -38,7 +38,8 @@ runWith :: ChartOpts -> IO ()
runWith opts = run opts
where
run opts
| "help" `in_` (rawopts_ $ cliopts_ opts) = printModeHelpAndExit chartmode
| "help" `in_` (rawopts_ $ cliopts_ opts) = putStr (showModeHelp chartmode) >> exitSuccess
| "version" `in_` (rawopts_ $ cliopts_ opts) = putStrLn progversion >> exitSuccess
| "binary-filename" `in_` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname)
| otherwise = withJournalDo' opts chart

9
hledger-chart/Hledger/Chart/Options.hs
View File

@ -26,8 +26,13 @@ chartflags = [
chartmode = (mode "hledger-chart" [("command","chart")]
"generate a pie chart image for the top account balances (of one sign only)"
commandargsflag (chartflags++generalflags1)){
modeHelpSuffix=[
commandargsflag []){
modeGroupFlags = Group {
groupUnnamed = chartflags
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)]
}
,modeHelpSuffix=[
-- "Reads your ~/.hledger.journal file, or another specified by $LEDGER_FILE or -f, and starts the full-window curses ui."
]
}

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

@ -13,6 +13,7 @@ import Data.Maybe
import Data.Time.Calendar
import Graphics.Vty
import Safe
import System.Exit
import Text.Printf
import Hledger
@ -32,7 +33,8 @@ runWith :: VtyOpts -> IO ()
runWith opts = run opts
where
run opts
| "help" `in_` (rawopts_ $ cliopts_ opts) = printModeHelpAndExit vtymode
| "help" `in_` (rawopts_ $ cliopts_ opts) = putStr (showModeHelp vtymode) >> exitSuccess
| "version" `in_` (rawopts_ $ cliopts_ opts) = putStrLn progversion >> exitSuccess
| "binary-filename" `in_` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname)
| otherwise = withJournalDo' opts vty

9
hledger-vty/Hledger/Vty/Options.hs
View File

@ -19,8 +19,13 @@ vtyflags = [
vtymode = (mode "hledger-vty" [("command","vty")]
"browse accounts, postings and entries in a full-window curses interface"
commandargsflag (vtyflags++generalflags1)){
modeHelpSuffix=[
commandargsflag []){
modeGroupFlags = Group {
groupUnnamed = vtyflags
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)]
}
,modeHelpSuffix=[
-- "Reads your ~/.hledger.journal file, or another specified by $LEDGER_FILE or -f, and starts the full-window curses ui."
]
}

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

@ -27,8 +27,13 @@ webflags = [
webmode = (mode "hledger-web" [("command","web")]
"start serving the hledger web interface"
commandargsflag (webflags++generalflags1)){
modeHelpSuffix=[
commandargsflag []){
modeGroupFlags = Group {
groupUnnamed = webflags
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)]
}
,modeHelpSuffix=[
-- "Reads your ~/.hledger.journal file, or another specified by $LEDGER_FILE or -f, and starts the full-window curses ui."
]
}

5
hledger-web/hledger-web.hs
View File

@ -17,7 +17,7 @@ import Network.Wai.Handler.Warp (run)
#else
import Network.Wai.Middleware.Debug (debug)
#endif
import System.Exit (exitFailure)
import System.Exit
import System.IO.Storage (withStore, putValue)
import Text.Printf
import Yesod.Helpers.Static
@ -40,7 +40,8 @@ runWith :: WebOpts -> IO ()
runWith opts = run opts
where
run opts
| "help" `in_` (rawopts_ $ cliopts_ opts) = printModeHelpAndExit webmode
| "help" `in_` (rawopts_ $ cliopts_ opts) = putStr (showModeHelp webmode) >> exitSuccess
| "version" `in_` (rawopts_ $ cliopts_ opts) = putStrLn progversion >> exitSuccess
| "binary-filename" `in_` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname)
| otherwise = withJournalDo' opts web

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

@ -41,6 +41,10 @@ module Hledger.Cli.Main where
import Control.Monad
import Data.List
import Safe
import System.Environment
import System.Exit
import System.Process
import Text.Printf
import Hledger.Cli.Add
@ -54,15 +58,15 @@ import Hledger.Cli.Options
import Hledger.Cli.Tests
import Hledger.Cli.Utils
import Hledger.Cli.Version
import Hledger.Utils
main :: IO ()
main = do
opts <- getHledgerOpts
args <- getArgs
addons <- getHledgerAddonCommands
opts <- getHledgerCliOpts addons
when (debug_ opts) $ printf "%s\n" progversion >> printf "opts: %s\n" (show opts)
runWith opts
runWith :: CliOpts -> IO ()
runWith opts = run' opts
run' opts addons args
where
cmd = command_ opts
run' opts
@ -70,7 +74,7 @@ runWith opts = run' opts
| any (cmd `isPrefixOf`) ["accounts","balance"] = showModeHelpOr accountsmode $ withJournalDo opts balance
| any (cmd `isPrefixOf`) ["activity","histogram"] = showModeHelpOr activitymode $ withJournalDo opts histogram
| cmd `isPrefixOf` "add" = showModeHelpOr addmode $ withJournalDo opts add
| cmd `isPrefixOf` "convert" = showModeHelpOr convertmode $ convert opts
| cmd `isPrefixOf` "convert" = showModeHelpOr convertmode $ withJournalDo opts convert
| any (cmd `isPrefixOf`) ["entries","print"] = showModeHelpOr entriesmode $ withJournalDo opts print'
| any (cmd `isPrefixOf`) ["postings","register"] = showModeHelpOr postingsmode $ withJournalDo opts register
| cmd `isPrefixOf` "stats" = showModeHelpOr statsmode $ withJournalDo opts stats

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

@ -6,16 +6,20 @@ Command-line options for the hledger program, and option-parsing utilities.
module Hledger.Cli.Options
where
-- import Data.List
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Time.Calendar
import Safe
import System.Console.CmdArgs
import System.Console.CmdArgs.Explicit
import System.Console.CmdArgs.Text
import System.Directory
import System.Environment
import System.Exit
import Test.HUnit
import Text.Parsec
import Text.Printf
import Hledger.Cli.Format as Format
import Hledger.Cli.Reports
@ -46,21 +50,20 @@ defmode = Mode {
,modeGroupModes = toGroup []
}
mainmode = defmode {
mainmode addons = defmode {
modeNames = [progname]
,modeHelp = "run the specified hledger command. hledger COMMAND --help for more detail. When mixing general and command-specific flags, put them all after COMMAND."
,modeHelpSuffix = help_postscript
,modeHelp = "run the specified hledger command. hledger COMMAND --help for more detail. \nIn general, COMMAND should precede OPTIONS."
,modeHelpSuffix = [""]
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)]
groupUnnamed = helpflags
,groupHidden = [flagNone ["binary-filename"] (setboolopt "binary-filename") "show the download filename for this executable, and exit"]
,groupNamed = []
}
,modeArgs = Just mainargsflag
,modeGroupModes = Group {
groupUnnamed = [
]
,groupHidden = [
binaryfilenamemode
]
,groupNamed = [
("Misc commands", [
@ -77,9 +80,23 @@ mainmode = defmode {
,statsmode
])
]
++ case addons of [] -> []
cs -> [("\nAdd-on commands found", map addonmode cs)]
}
}
addonmode name = defmode {
modeNames = [name]
,modeHelp = printf "[-- OPTIONS] run the %s-%s program" progname name
,modeValue=[("command",name)]
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)]
}
,modeArgs = Just addonargsflag
}
help_postscript = [
-- "DATES can be Y/M/D or smart dates like \"last month\"."
-- ,"PATTERNS are regular"
@ -131,6 +148,8 @@ mainargsflag = flagArg f ""
commandargsflag = flagArg (\s opts -> Right $ setopt "args" s opts) "[PATTERNS]"
addonargsflag = flagArg (\s opts -> Right $ setopt "args" s opts) "[ARGS]"
commandmode names = defmode {modeNames=names, modeValue=[("command",headDef "" names)]}
addmode = (commandmode ["add"]) {
@ -236,16 +255,6 @@ statsmode = (commandmode ["stats"]) {
}
}
binaryfilenamemode = (commandmode ["binaryfilename"]) {
modeHelp = "show the download filename for this hledger build, and exit"
,modeArgs = Nothing
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags3)]
}
}
-- 2. ADT holding options used in this package and above, parsed from RawOpts.
-- This represents the command-line options that were provided, with all
-- parsing completed, but before adding defaults or derived values (XXX add)
@ -314,23 +323,33 @@ toCliOpts rawopts = do
}
}
-- workaround for http://code.google.com/p/ndmitchell/issues/detail?id=457
-- just handles commonest cases
moveFlagsAfterCommand (fflagandval@('-':'f':_:_):cmd:rest) = cmd:fflagandval:rest
moveFlagsAfterCommand ("-f":fval:cmd:rest) = cmd:"-f":fval:rest
moveFlagsAfterCommand as = as
-- | Get all command-line options, specifying any extra commands that are allowed, or fail on parse errors.
getHledgerCliOpts :: [String] -> IO CliOpts
getHledgerCliOpts addons = do
args <- getArgs
toCliOpts (decodeRawOpts $ processValue (mainmode addons) $ tempMoveFlagsAfterCommand args) >>= checkCliOpts
-- utils
getHledgerAddonCommands :: IO [String]
getHledgerAddonCommands = map (drop (length progname + 1)) `fmap` getHledgerProgramsInPath
getHledgerProgramsInPath :: IO [String]
getHledgerProgramsInPath = do
pathdirs <- splitOn ":" `fmap` getEnv "PATH"
pathexes <- concat `fmap` mapM getDirectoryContents pathdirs
return $ nub $ sort $ filter (isRight . parsewith hledgerprog) pathexes
where
hledgerprog = string progname >> char '-' >> many1 (letter <|> char '-') >> eof
-- | Convert possibly encoded option values to regular unicode strings.
decodeRawOpts = map (\(name,val) -> (name, fromPlatformString val))
-- | Get all command-line options, failing on any parse errors.
getHledgerOpts :: IO CliOpts
-- getHledgerOpts = processArgs mainmode >>= return . decodeRawOpts >>= toOpts >>= checkOpts
getHledgerOpts = do
args <- getArgs
toCliOpts (decodeRawOpts $ processValue mainmode $ moveFlagsAfterCommand args) >>= checkCliOpts
-- utils
-- workaround for http://code.google.com/p/ndmitchell/issues/detail?id=457
-- just handles commonest case, -f option before command
tempMoveFlagsAfterCommand (fflagandval@('-':'f':_:_):cmd:rest) = cmd:fflagandval:rest
tempMoveFlagsAfterCommand ("-f":fval:cmd:rest) = cmd:"-f":fval:rest
tempMoveFlagsAfterCommand as = as
optserror = error' . (++ " (run with --help for usage)")
@ -422,8 +441,9 @@ aliasesFromOpts = map parseAlias . alias_
alias' = case alias of ('=':rest) -> rest
_ -> orig
printModeHelpAndExit mode = putStrLn progversion >> putStr help >> exitSuccess
where help = showText defaultWrap $ helpText HelpFormatDefault mode
printModeHelpAndExit mode = putStr (showModeHelp mode) >> exitSuccess
showModeHelp = showText defaultWrap . helpText HelpFormatDefault
printVersionAndExit = putStrLn progversion >> exitSuccess