1 {-| 2 3 Command-line options for the hledger program, and option-parsing utilities. 4 5 -} 6 7 module Hledger.Cli.Options 8 where 9 import Data.List 10 import Data.List.Split 11 import Data.Maybe 12 import Data.Time.Calendar 13 import Safe 14 import System.Console.CmdArgs 15 import System.Console.CmdArgs.Explicit 16 import System.Console.CmdArgs.Text 17 import System.Directory 18 import System.Environment 19 import Test.HUnit 20 import Text.Parsec 21 import Text.Printf 22 23 import Hledger 24 import Hledger.Cli.Format as Format 25 import Hledger.Cli.Version 26 27 28 progname = "hledger" 29 progversion = progversionstr progname 30 31 -- 1. cmdargs mode and flag definitions, for the main and subcommand modes. 32 -- Flag values are parsed initially to simple RawOpts to permit reuse. 33 34 type RawOpts = [(String,String)] 35 36 defmode :: Mode RawOpts 37 defmode = Mode { 38 modeNames = [] 39 ,modeHelp = "" 40 ,modeHelpSuffix = [] 41 ,modeValue = [] 42 ,modeCheck = Right 43 ,modeReform = const Nothing 44 ,modeGroupFlags = toGroup [] 45 ,modeArgs = ([], Nothing) 46 ,modeGroupModes = toGroup [] 47 } 48 49 mainmode addons = defmode { 50 modeNames = [progname] 51 ,modeHelp = "run the specified hledger command. hledger COMMAND --help for more detail. \nIn general, COMMAND should precede OPTIONS." 52 ,modeHelpSuffix = [""] 53 ,modeGroupFlags = Group { 54 groupUnnamed = helpflags 55 ,groupHidden = [flagNone ["binary-filename"] (setboolopt "binary-filename") "show the download filename for this executable, and exit"] 56 ,groupNamed = [] 57 } 58 ,modeArgs = ([], Just mainargsflag) 59 ,modeGroupModes = Group { 60 groupUnnamed = [ 61 ] 62 ,groupHidden = [ 63 ] 64 ,groupNamed = [ 65 ("Misc commands", [ 66 addmode 67 ,convertmode 68 ,testmode 69 ]) 70 ,("\nReport commands", [ 71 accountsmode 72 ,entriesmode 73 ,postingsmode 74 -- ,transactionsmode 75 ,activitymode 76 ,statsmode 77 ]) 78 ] 79 ++ case addons of [] -> [] 80 cs -> [("\nAdd-on commands found", map addonmode cs)] 81 } 82 } 83 84 addonmode name = defmode { 85 modeNames = [name] 86 ,modeHelp = printf "[-- OPTIONS] run the %s-%s program" progname name 87 ,modeValue=[("command",name)] 88 ,modeGroupFlags = Group { 89 groupUnnamed = [] 90 ,groupHidden = [] 91 ,groupNamed = [(generalflagstitle, generalflags1)] 92 } 93 ,modeArgs = ([], Just addonargsflag) 94 } 95 96 help_postscript = [ 97 -- "DATES can be Y/M/D or smart dates like \"last month\"." 98 -- ,"PATTERNS are regular" 99 -- ,"expressions which filter by account name. Prefix a pattern with desc: to" 100 -- ,"filter by transaction description instead, prefix with not: to negate it." 101 -- ,"When using both, not: comes last." 102 ] 103 104 generalflagstitle = "\nGeneral flags" 105 generalflags1 = fileflags ++ reportflags ++ helpflags 106 generalflags2 = fileflags ++ helpflags 107 generalflags3 = helpflags 108 109 fileflags = [ 110 flagReq ["file","f"] (\s opts -> Right $ setopt "file" s opts) "FILE" "use a different journal file; - means stdin" 111 ,flagReq ["alias"] (\s opts -> Right $ setopt "alias" s opts) "ACCT=ALIAS" "display ACCT's name as ALIAS in reports" 112 ] 113 114 reportflags = [ 115 flagReq ["begin","b"] (\s opts -> Right $ setopt "begin" s opts) "DATE" "report on transactions on or after this date" 116 ,flagReq ["end","e"] (\s opts -> Right $ setopt "end" s opts) "DATE" "report on transactions before this date" 117 ,flagReq ["period","p"] (\s opts -> Right $ setopt "period" s opts) "PERIODEXP" "report on transactions during the specified period and/or with the specified reporting interval" 118 ,flagNone ["daily","D"] (\opts -> setboolopt "daily" opts) "report by day" 119 ,flagNone ["weekly","W"] (\opts -> setboolopt "weekly" opts) "report by week" 120 ,flagNone ["monthly","M"] (\opts -> setboolopt "monthly" opts) "report by month" 121 ,flagNone ["quarterly","Q"] (\opts -> setboolopt "quarterly" opts) "report by quarter" 122 ,flagNone ["yearly","Y"] (\opts -> setboolopt "yearly" opts) "report by year" 123 ,flagNone ["cleared","C"] (\opts -> setboolopt "cleared" opts) "report only on cleared transactions" 124 ,flagNone ["uncleared","U"] (\opts -> setboolopt "uncleared" opts) "report only on uncleared transactions" 125 ,flagNone ["cost","B"] (\opts -> setboolopt "cost" opts) "report cost of commodities" 126 ,flagReq ["depth"] (\s opts -> Right $ setopt "depth" s opts) "N" "hide accounts/transactions deeper than this" 127 ,flagReq ["display","d"] (\s opts -> Right $ setopt "display" s opts) "DISPLAYEXP" "show only transactions matching the expression, which is 'dOP[DATE]' where OP is <, <=, =, >=, >" 128 ,flagNone ["effective"] (\opts -> setboolopt "effective" opts) "use transactions' effective dates, if any" 129 ,flagNone ["empty","E"] (\opts -> setboolopt "empty" opts) "show empty/zero things which are normally elided" 130 ,flagNone ["real","R"] (\opts -> setboolopt "real" opts) "report only on real (non-virtual) transactions" 131 ] 132 133 helpflags = [ 134 flagHelpSimple (setboolopt "help") 135 ,flagNone ["debug"] (setboolopt "debug") "Show extra debug output" 136 ,flagVersion (setboolopt "version") 137 ] 138 139 mainargsflag = flagArg f "" 140 where f s opts = let as = words' s 141 cmd = headDef "" as 142 args = drop (length cmd + 1) s 143 in Right $ setopt "command" cmd $ setopt "args" args opts 144 145 commandargsflag = flagArg (\s opts -> Right $ setopt "args" s opts) "[PATTERNS]" 146 147 addonargsflag = flagArg (\s opts -> Right $ setopt "args" s opts) "[ARGS]" 148 149 commandmode names = defmode {modeNames=names, modeValue=[("command",headDef "" names)]} 150 151 addmode = (commandmode ["add"]) { 152 modeHelp = "prompt for new transactions and append them to the journal" 153 ,modeHelpSuffix = ["Defaults come from previous similar transactions; use query patterns to restrict these."] 154 ,modeArgs = ([], Just commandargsflag) 155 ,modeGroupFlags = Group { 156 groupUnnamed = [ 157 flagNone ["no-new-accounts"] (\opts -> setboolopt "no-new-accounts" opts) "don't allow creating new accounts" 158 ] 159 ,groupHidden = [] 160 ,groupNamed = [(generalflagstitle, generalflags2)] 161 } 162 } 163 164 convertmode = (commandmode ["convert"]) { 165 modeValue = [("command","convert")] 166 ,modeHelp = "show the specified CSV file as hledger journal entries" 167 ,modeArgs = ([], Just $ flagArg (\s opts -> Right $ setopt "args" s opts) "[CSVFILE]") 168 ,modeGroupFlags = Group { 169 groupUnnamed = [ 170 flagReq ["rules-file"] (\s opts -> Right $ setopt "rules-file" s opts) "FILE" "rules file to use (default: CSVFILE.rules)" 171 ] 172 ,groupHidden = [] 173 ,groupNamed = [(generalflagstitle, generalflags3)] 174 } 175 } 176 177 testmode = (commandmode ["test"]) { 178 modeHelp = "run self-tests, or just the ones matching REGEXPS" 179 ,modeArgs = ([], Just $ flagArg (\s opts -> Right $ setopt "args" s opts) "[REGEXPS]") 180 ,modeGroupFlags = Group { 181 groupUnnamed = [] 182 ,groupHidden = [] 183 ,groupNamed = [(generalflagstitle, generalflags3)] 184 } 185 } 186 187 accountsmode = (commandmode ["balance","accounts"]) { 188 modeHelp = "(or accounts) show matched accounts and their balances" 189 ,modeArgs = ([], Just commandargsflag) 190 ,modeGroupFlags = Group { 191 groupUnnamed = [ 192 flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show full account names, unindented" 193 ,flagReq ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "with --flat, omit this many leading account name components" 194 ,flagReq ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format" 195 ,flagNone ["no-elide"] (\opts -> setboolopt "no-elide" opts) "no eliding at all, stronger than --empty" 196 ,flagNone ["no-total"] (\opts -> setboolopt "no-total" opts) "don't show the final total" 197 ] 198 ,groupHidden = [] 199 ,groupNamed = [(generalflagstitle, generalflags1)] 200 } 201 } 202 203 entriesmode = (commandmode ["print","entries"]) { 204 modeHelp = "(or entries) show matched journal entries" 205 ,modeArgs = ([], Just commandargsflag) 206 ,modeGroupFlags = Group { 207 groupUnnamed = [] 208 ,groupHidden = [] 209 ,groupNamed = [(generalflagstitle, generalflags1)] 210 } 211 } 212 213 postingsmode = (commandmode ["register","postings"]) { 214 modeHelp = "(or postings) show matched postings and running total" 215 ,modeArgs = ([], Just commandargsflag) 216 ,modeGroupFlags = Group { 217 groupUnnamed = [] 218 ,groupHidden = [] 219 ,groupNamed = [(generalflagstitle, generalflags1)] 220 } 221 } 222 223 transactionsmode = (commandmode ["transactions"]) { 224 modeHelp = "show matched transactions and balance in some account(s)" 225 ,modeArgs = ([], Just commandargsflag) 226 ,modeGroupFlags = Group { 227 groupUnnamed = [] 228 ,groupHidden = [] 229 ,groupNamed = [(generalflagstitle, generalflags1)] 230 } 231 } 232 233 activitymode = (commandmode ["activity","histogram"]) { 234 modeHelp = "show a barchart of transactions per interval" 235 ,modeHelpSuffix = ["The default interval is daily."] 236 ,modeArgs = ([], Just commandargsflag) 237 ,modeGroupFlags = Group { 238 groupUnnamed = [] 239 ,groupHidden = [] 240 ,groupNamed = [(generalflagstitle, generalflags1)] 241 } 242 } 243 244 statsmode = (commandmode ["stats"]) { 245 modeHelp = "show quick statistics for a journal (or part of it)" 246 ,modeArgs = ([], Just commandargsflag) 247 ,modeGroupFlags = Group { 248 groupUnnamed = [] 249 ,groupHidden = [] 250 ,groupNamed = [(generalflagstitle, generalflags1)] 251 } 252 } 253 254 -- 2. ADT holding options used in this package and above, parsed from RawOpts. 255 -- This represents the command-line options that were provided, with all 256 -- parsing completed, but before adding defaults or derived values (XXX add) 257 258 -- cli options, used in hledger and above 259 data CliOpts = CliOpts { 260 rawopts_ :: RawOpts 261 ,command_ :: String 262 ,file_ :: Maybe FilePath 263 ,alias_ :: [String] 264 ,debug_ :: Bool 265 ,no_new_accounts_ :: Bool -- add 266 ,rules_file_ :: Maybe FilePath -- convert 267 ,reportopts_ :: ReportOpts 268 } deriving (Show) 269 270 defcliopts = CliOpts 271 def 272 def 273 def 274 def 275 def 276 def 277 def 278 def 279 280 instance Default CliOpts where def = defcliopts 281 282 -- | Parse raw option string values to the desired final data types. 283 -- Any relative smart dates will be converted to fixed dates based on 284 -- today's date. Parsing failures will raise an error. 285 toCliOpts :: RawOpts -> IO CliOpts 286 toCliOpts rawopts = do 287 d <- getCurrentDay 288 return defcliopts { 289 rawopts_ = rawopts 290 ,command_ = stringopt "command" rawopts 291 ,file_ = maybestringopt "file" rawopts 292 ,alias_ = listofstringopt "alias" rawopts 293 ,debug_ = boolopt "debug" rawopts 294 ,no_new_accounts_ = boolopt "no-new-accounts" rawopts -- add 295 ,rules_file_ = maybestringopt "rules-file" rawopts -- convert 296 ,reportopts_ = defreportopts { 297 begin_ = maybesmartdateopt d "begin" rawopts 298 ,end_ = maybesmartdateopt d "end" rawopts 299 ,period_ = maybeperiodopt d rawopts 300 ,cleared_ = boolopt "cleared" rawopts 301 ,uncleared_ = boolopt "uncleared" rawopts 302 ,cost_ = boolopt "cost" rawopts 303 ,depth_ = maybeintopt "depth" rawopts 304 ,display_ = maybedisplayopt d rawopts 305 ,effective_ = boolopt "effective" rawopts 306 ,empty_ = boolopt "empty" rawopts 307 ,no_elide_ = boolopt "no-elide" rawopts 308 ,real_ = boolopt "real" rawopts 309 ,flat_ = boolopt "flat" rawopts -- balance 310 ,drop_ = intopt "drop" rawopts -- balance 311 ,no_total_ = boolopt "no-total" rawopts -- balance 312 ,daily_ = boolopt "daily" rawopts 313 ,weekly_ = boolopt "weekly" rawopts 314 ,monthly_ = boolopt "monthly" rawopts 315 ,quarterly_ = boolopt "quarterly" rawopts 316 ,yearly_ = boolopt "yearly" rawopts 317 ,format_ = maybestringopt "format" rawopts 318 ,patterns_ = words'' prefixes $ singleQuoteIfNeeded $ stringopt "args" rawopts 319 } 320 } 321 322 -- | Get all command-line options, specifying any extra commands that are allowed, or fail on parse errors. 323 getHledgerCliOpts :: [String] -> IO CliOpts 324 getHledgerCliOpts addons = do 325 args <- getArgs 326 toCliOpts (decodeRawOpts $ processValue (mainmode addons) $ moveFileOption args) >>= checkCliOpts 327 328 -- utils 329 330 -- | Get the unique suffixes (without hledger-) of hledger-* executables 331 -- found in the current user's PATH, or the empty list if there is any 332 -- problem. 333 getHledgerAddonCommands :: IO [String] 334 getHledgerAddonCommands = map (drop (length progname + 1)) `fmap` getHledgerProgramsInPath 335 336 -- | Get the unique names of hledger-* executables found in the current 337 -- user's PATH, or the empty list if there is any problem. 338 getHledgerProgramsInPath :: IO [String] 339 getHledgerProgramsInPath = do 340 pathdirs <- splitOn ":" `fmap` getEnvSafe "PATH" 341 pathexes <- concat `fmap` mapM getDirectoryContentsSafe pathdirs 342 return $ nub $ sort $ filter (isRight . parsewith hledgerprog) pathexes 343 where 344 hledgerprog = string progname >> char '-' >> many1 (letter <|> char '-') >> eof 345 346 getEnvSafe v = getEnv v `catch` (\_ -> return "") 347 getDirectoryContentsSafe d = getDirectoryContents d `catch` (\_ -> return []) 348 349 -- | Convert possibly encoded option values to regular unicode strings. 350 decodeRawOpts = map (\(name,val) -> (name, fromPlatformString val)) 351 352 -- A workaround related to http://code.google.com/p/ndmitchell/issues/detail?id=457 : 353 -- we'd like to permit options before COMMAND as well as after it. Here we 354 -- make sure at least -f FILE will be accepted in either position. 355 moveFileOption (fopt@('-':'f':_:_):cmd:rest) = cmd:fopt:rest 356 moveFileOption ("-f":fval:cmd:rest) = cmd:"-f":fval:rest 357 moveFileOption as = as 358 359 optserror = error' . (++ " (run with --help for usage)") 360 361 setopt name val = (++ [(name,singleQuoteIfNeeded val)]) 362 363 setboolopt name = (++ [(name,"")]) 364 365 in_ :: String -> RawOpts -> Bool 366 in_ name = isJust . lookup name 367 368 boolopt = in_ 369 370 maybestringopt name = maybe Nothing (Just . stripquotes) . lookup name 371 372 stringopt name = fromMaybe "" . maybestringopt name 373 374 listofstringopt name rawopts = [stripquotes v | (n,v) <- rawopts, n==name] 375 376 maybeintopt :: String -> RawOpts -> Maybe Int 377 maybeintopt name rawopts = 378 let ms = maybestringopt name rawopts in 379 case ms of Nothing -> Nothing 380 Just s -> Just $ readDef (optserror $ "could not parse "++name++" number: "++s) s 381 382 intopt name = fromMaybe 0 . maybeintopt name 383 384 maybesmartdateopt :: Day -> String -> RawOpts -> Maybe Day 385 maybesmartdateopt d name rawopts = 386 case maybestringopt name rawopts of 387 Nothing -> Nothing 388 Just s -> either 389 (\e -> optserror $ "could not parse "++name++" date: "++show e) 390 Just 391 $ fixSmartDateStrEither' d s 392 393 maybedisplayopt :: Day -> RawOpts -> Maybe DisplayExp 394 maybedisplayopt d rawopts = 395 maybe Nothing (Just . regexReplaceBy "\\[.+?\\]" fixbracketeddatestr) $ maybestringopt "display" rawopts 396 where 397 fixbracketeddatestr "" = "" 398 fixbracketeddatestr s = "[" ++ fixSmartDateStr d (init $ tail s) ++ "]" 399 400 maybeperiodopt :: Day -> RawOpts -> Maybe (Interval,DateSpan) 401 maybeperiodopt d rawopts = 402 case maybestringopt "period" rawopts of 403 Nothing -> Nothing 404 Just s -> either 405 (\e -> optserror $ "could not parse period option: "++show e) 406 Just 407 $ parsePeriodExpr d s 408 409 -- | Do final validation of processed opts, raising an error if there is trouble. 410 checkCliOpts :: CliOpts -> IO CliOpts -- or pure.. 411 checkCliOpts opts@CliOpts{reportopts_=ropts} = do 412 case formatFromOpts ropts of 413 Left err -> optserror $ "could not parse format option: "++err 414 Right _ -> return () 415 return opts 416 417 -- | Parse any format option provided, possibly raising an error, or get 418 -- the default value. 419 formatFromOpts :: ReportOpts -> Either String [FormatString] 420 formatFromOpts = maybe (Right defaultBalanceFormatString) parseFormatString . format_ 421 422 -- | Default line format for balance report: "%20(total) %2(depth_spacer)%-(account)" 423 defaultBalanceFormatString :: [FormatString] 424 defaultBalanceFormatString = [ 425 FormatField False (Just 20) Nothing Total 426 , FormatLiteral " " 427 , FormatField True (Just 2) Nothing DepthSpacer 428 , FormatField True Nothing Nothing Format.Account 429 ] 430 431 -- | Get the journal file path from options, an environment variable, or a default 432 journalFilePathFromOpts :: CliOpts -> IO String 433 journalFilePathFromOpts opts = do 434 f <- myJournalPath 435 return $ fromMaybe f $ file_ opts 436 437 aliasesFromOpts :: CliOpts -> [(AccountName,AccountName)] 438 aliasesFromOpts = map parseAlias . alias_ 439 where 440 -- similar to ledgerAlias 441 parseAlias :: String -> (AccountName,AccountName) 442 parseAlias s = (accountNameWithoutPostingType $ strip orig 443 ,accountNameWithoutPostingType $ strip alias') 444 where 445 (orig, alias) = break (=='=') s 446 alias' = case alias of ('=':rest) -> rest 447 _ -> orig 448 449 showModeHelp = showText defaultWrap . helpText HelpFormatDefault 450 451 tests_Hledger_Cli_Options = TestList 452 [ 453 ]