1 {-# OPTIONS_GHC -cpp #-} 2 {-| 3 Command-line options for the application. 4 -} 5 6 module Options 7 where 8 import System 9 import System.Console.GetOpt 10 import System.Environment 11 import Text.Printf 12 import Data.Char (toLower) 13 import Ledger.IO (IOArgs, 14 ledgerenvvar,ledgerdefaultpath,myLedgerPath, 15 timelogenvvar,timelogdefaultpath,myTimelogPath) 16 import Ledger.Parse 17 import Ledger.Utils 18 import Ledger.Types 19 import Ledger.Dates 20 import Codec.Binary.UTF8.String (decodeString) 21 import Control.Monad (liftM) 22 23 progname = "hledger" 24 timeprogname = "hours" 25 26 usagehdr = ( 27 "Usage: hledger [OPTIONS] [COMMAND [PATTERNS]]\n" ++ 28 " hours [OPTIONS] [COMMAND [PATTERNS]]\n" ++ 29 " hledger convert CSVFILE ACCOUNTNAME RULESFILE\n" ++ 30 "\n" ++ 31 "hledger uses your ~/.ledger or $LEDGER file (or another specified with -f),\n" ++ 32 "while hours uses your ~/.timelog or $TIMELOG file.\n" ++ 33 "\n" ++ 34 "COMMAND is one of (may be abbreviated):\n" ++ 35 " add - prompt for new transactions and add them to the ledger\n" ++ 36 " balance - show accounts, with balances\n" ++ 37 " convert - convert CSV data to ledger format and print on stdout\n" ++ 38 " histogram - show transaction counts per day or other interval\n" ++ 39 " print - show transactions in ledger format\n" ++ 40 " register - show transactions as a register with running balance\n" ++ 41 " stats - show various statistics for a ledger\n" ++ 42 #ifdef VTY 43 " ui - run a simple curses-based text ui\n" ++ 44 #endif 45 #ifdef HAPPS 46 " web - run a simple web ui\n" ++ 47 #endif 48 " test - run self-tests\n" ++ 49 "\n" ++ 50 "PATTERNS are regular expressions which filter by account name.\n" ++ 51 "Prefix with desc: to filter by transaction description instead.\n" ++ 52 "Prefix with not: to negate a pattern. When using both, not: comes last.\n" ++ 53 "\n" ++ 54 "DATES can be y/m/d or ledger-style smart dates like \"last month\".\n" ++ 55 "\n" ++ 56 "Options:" 57 ) 58 usageftr = "" 59 usage = usageInfo usagehdr options ++ usageftr 60 61 -- | Command-line options we accept. 62 options :: [OptDescr Opt] 63 options = [ 64 Option ['f'] ["file"] (ReqArg File "FILE") "use a different ledger/timelog file; - means stdin" 65 ,Option ['b'] ["begin"] (ReqArg Begin "DATE") "report on transactions on or after this date" 66 ,Option ['e'] ["end"] (ReqArg End "DATE") "report on transactions before this date" 67 ,Option ['p'] ["period"] (ReqArg Period "EXPR") ("report on transactions during the specified period\n" ++ 68 "and/or with the specified reporting interval\n") 69 ,Option ['C'] ["cleared"] (NoArg Cleared) "report only on cleared transactions" 70 ,Option ['U'] ["uncleared"] (NoArg UnCleared) "report only on uncleared transactions" 71 ,Option ['B'] ["cost","basis"] (NoArg CostBasis) "report cost of commodities" 72 ,Option [] ["depth"] (ReqArg Depth "N") "hide accounts/transactions deeper than this" 73 ,Option ['d'] ["display"] (ReqArg Display "EXPR") ("show only transactions matching EXPR (where\n" ++ 74 "EXPR is 'dOP[DATE]' and OP is <, <=, =, >=, >)") 75 ,Option ['E'] ["empty"] (NoArg Empty) "show empty/zero things which are normally elided" 76 ,Option ['R'] ["real"] (NoArg Real) "report only on real (non-virtual) transactions" 77 ,Option [] ["no-total"] (NoArg NoTotal) "balance report: hide the final total" 78 -- ,Option ['s'] ["subtotal"] (NoArg SubTotal) "balance report: show subaccounts" 79 ,Option ['W'] ["weekly"] (NoArg WeeklyOpt) "register report: show weekly summary" 80 ,Option ['M'] ["monthly"] (NoArg MonthlyOpt) "register report: show monthly summary" 81 ,Option ['Q'] ["quarterly"] (NoArg QuarterlyOpt) "register report: show quarterly summary" 82 ,Option ['Y'] ["yearly"] (NoArg YearlyOpt) "register report: show yearly summary" 83 ,Option ['h'] ["help"] (NoArg Help) "show this help" 84 ,Option ['V'] ["version"] (NoArg Version) "show version information" 85 ,Option ['v'] ["verbose"] (NoArg Verbose) "show verbose test output" 86 ,Option [] ["debug"] (NoArg Debug) "show some debug output" 87 ,Option [] ["debug-no-ui"] (NoArg DebugNoUI) "run ui commands with no output" 88 ] 89 90 -- | An option value from a command-line flag. 91 data Opt = 92 File {value::String} | 93 Begin {value::String} | 94 End {value::String} | 95 Period {value::String} | 96 Cleared | 97 UnCleared | 98 CostBasis | 99 Depth {value::String} | 100 Display {value::String} | 101 Empty | 102 Real | 103 NoTotal | 104 SubTotal | 105 WeeklyOpt | 106 MonthlyOpt | 107 QuarterlyOpt | 108 YearlyOpt | 109 Help | 110 Verbose | 111 Version 112 | Debug 113 | DebugNoUI 114 deriving (Show,Eq) 115 116 -- these make me nervous 117 optsWithConstructor f opts = concatMap get opts 118 where get o = if f v == o then [o] else [] where v = value o 119 120 optsWithConstructors fs opts = concatMap get opts 121 where get o = if any (\f -> f == o) fs then [o] else [] 122 123 optValuesForConstructor f opts = concatMap get opts 124 where get o = if f v == o then [v] else [] where v = value o 125 126 optValuesForConstructors fs opts = concatMap get opts 127 where get o = if any (\f -> f v == o) fs then [v] else [] where v = value o 128 129 -- | Parse the command-line arguments into options, command name, and 130 -- command arguments. Any dates in the options are converted to explicit 131 -- YYYY/MM/DD format based on the current time. 132 parseArguments :: IO ([Opt], String, [String]) 133 parseArguments = do 134 args <- liftM (map decodeString) getArgs 135 let (os,as,es) = getOpt Permute options args 136 -- istimequery <- usingTimeProgramName 137 -- let os' = if istimequery then (Period "today"):os else os 138 os'' <- fixOptDates os 139 case (as,es) of 140 (cmd:args,[]) -> return (os'',cmd,args) 141 ([],[]) -> return (os'',"",[]) 142 (_,errs) -> ioError (userError (concat errs ++ usage)) 143 144 -- | Convert any fuzzy dates within these option values to explicit ones, 145 -- based on today's date. 146 fixOptDates :: [Opt] -> IO [Opt] 147 fixOptDates opts = do 148 d <- getCurrentDay 149 return $ map (fixopt d) opts 150 where 151 fixopt d (Begin s) = Begin $ fixSmartDateStr d s 152 fixopt d (End s) = End $ fixSmartDateStr d s 153 fixopt d (Display s) = -- hacky 154 Display $ gsubRegexPRBy "\\[.+?\\]" fixbracketeddatestr s 155 where fixbracketeddatestr s = "[" ++ (fixSmartDateStr d $ init $ tail s) ++ "]" 156 fixopt _ o = o 157 158 -- | Figure out the overall date span we should report on, based on any 159 -- begin/end/period options provided. If there is a period option, the 160 -- others are ignored. 161 dateSpanFromOpts :: Day -> [Opt] -> DateSpan 162 dateSpanFromOpts refdate opts 163 | not $ null popts = snd $ parsePeriodExpr refdate $ last popts 164 | otherwise = DateSpan lastb laste 165 where 166 popts = optValuesForConstructor Period opts 167 bopts = optValuesForConstructor Begin opts 168 eopts = optValuesForConstructor End opts 169 lastb = listtomaybeday bopts 170 laste = listtomaybeday eopts 171 listtomaybeday vs = if null vs then Nothing else Just $ parse $ last vs 172 where parse = parsedate . fixSmartDateStr refdate 173 174 -- | Figure out the reporting interval, if any, specified by the options. 175 -- If there is a period option, the others are ignored. 176 intervalFromOpts :: [Opt] -> Interval 177 intervalFromOpts opts 178 | not $ null popts = fst $ parsePeriodExpr refdate $ last popts 179 | null otheropts = NoInterval 180 | otherwise = case last otheropts of 181 WeeklyOpt -> Weekly 182 MonthlyOpt -> Monthly 183 QuarterlyOpt -> Quarterly 184 YearlyOpt -> Yearly 185 where 186 popts = optValuesForConstructor Period opts 187 otheropts = filter (`elem` [WeeklyOpt,MonthlyOpt,QuarterlyOpt,YearlyOpt]) opts 188 -- doesn't affect the interval, but parsePeriodExpr needs something 189 refdate = parsedate "0001/01/01" 190 191 -- | Get the value of the (last) depth option, if any, otherwise a large number. 192 depthFromOpts :: [Opt] -> Int 193 depthFromOpts opts = fromMaybe 9999 $ listtomaybeint $ optValuesForConstructor Depth opts 194 where 195 listtomaybeint [] = Nothing 196 listtomaybeint vs = Just $ read $ last vs 197 198 -- | Get the value of the (last) display option, if any. 199 displayFromOpts :: [Opt] -> Maybe String 200 displayFromOpts opts = listtomaybe $ optValuesForConstructor Display opts 201 where 202 listtomaybe [] = Nothing 203 listtomaybe vs = Just $ last vs 204 205 -- | Get a maybe boolean representing the last cleared/uncleared option if any. 206 clearedValueFromOpts opts | null os = Nothing 207 | last os == Cleared = Just True 208 | otherwise = Just False 209 where os = optsWithConstructors [Cleared,UnCleared] opts 210 211 -- | Was the program invoked via the \"hours\" alias ? 212 usingTimeProgramName :: IO Bool 213 usingTimeProgramName = do 214 progname <- getProgName 215 return $ map toLower progname == timeprogname 216 217 -- | Get the ledger file path from options, an environment variable, or a default 218 ledgerFilePathFromOpts :: [Opt] -> IO String 219 ledgerFilePathFromOpts opts = do 220 istimequery <- usingTimeProgramName 221 f <- if istimequery then myTimelogPath else myLedgerPath 222 return $ last $ f:(optValuesForConstructor File opts) 223 224 -- | Gather filter pattern arguments into a list of account patterns and a 225 -- list of description patterns. We interpret pattern arguments as 226 -- follows: those prefixed with "desc:" are description patterns, all 227 -- others are account patterns; also patterns prefixed with "not:" are 228 -- negated. not: should come after desc: if both are used. 229 parsePatternArgs :: [String] -> ([String],[String]) 230 parsePatternArgs args = (as, ds') 231 where 232 descprefix = "desc:" 233 (ds, as) = partition (descprefix `isPrefixOf`) args 234 ds' = map (drop (length descprefix)) ds 235 236 -- | Convert application options to more generic types for the library. 237 optsToIOArgs :: [Opt] -> [String] -> LocalTime -> IOArgs 238 optsToIOArgs opts args t = (dateSpanFromOpts (localDay t) opts 239 ,clearedValueFromOpts opts 240 ,Real `elem` opts 241 ,CostBasis `elem` opts 242 ,apats 243 ,dpats 244 ) where (apats,dpats) = parsePatternArgs args 245