diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,6 +1,90 @@ User-visible changes in hledger and hledger-lib. +0.27 (unreleased) + +Account aliases: + +- Regular expression account aliases are now fast enough that you can + use lots of them without slowing things down. They now take + O(aliases x accounts) time, instead of O(aliases x transactions); + also, regular expressions are no longer recompiled unnecessarily. + +Documentation: + +- The hledger packages now have man pages, based on the current user + manual, thanks to the mighty pandoc (#282). + +Journal format: + +- Dates must now begin with a digit (not /, eg). + +- The comment directive longer requires an end comment, and will + extend to the end of the file(s) without it. + +Command-line interface: + +- Output (balance reports, register reports, print output etc.) + containing wide characters, eg chinese/japanese/korean characters, + should now align correctly, when viewed in apps and fonts that show + wide characters as double width (#242). + +- The argument for --depth or depth: must now be positive. + +add: + +- Journal entries are now written with all amounts explicit, to avoid + losing price info (#283). + +- Fixed a bug which sometimes (when the same letter pair was repeated) + caused it not to pick the most similar past transaction for defaults. + +balance: + +- There is now a -V/--value flag to report current market value (as in Ledger). + It converts all reported amounts using their "default market price". + "Market price" is the new name for "historical prices", defined with the P directive. + The default market price for a commodity is the most recent one found in the journal on or before the report end date. + + Unlike Ledger, hledger's -V uses only the market prices recorded + with P directives; it does not use the "transaction prices" + recorded as part of posting amounts (which are used by -B/--cost). + Also, using both -B and -V at the same time is supported. + +- Fixed a bug in amount normalization which caused amount styles + (commodity symbol placement, decimal point character, etc.) to be + lost in certain cases (#230, #276). + +- The balance command's --format option can now adjust the rendering + style of multi-commodity amounts, if you begin the format string + with one of: + + %_ - renders amounts on multiple lines, bottom-aligned (the default) + %^ - renders amounts on multiple lines, top-aligned + %, - renders amounts on one line, comma-separated + +- The balance report's final total (and the line above it) now adapt + themselves to a custom --format. + +print: + +- The --match option prints the journal entry that best matches a + description (ie whose description field is most similar to the value + given, and if there are several equally similar, the most recent). + This was originally an add-on I used to guess account names for + ledger-autosync. It's nice for quickly looking up a recent + transaction from a guessed or partial description. + +- print now always right-aligns the amounts in an entry, even when + they are wider than 12 characters. (If there is a price, it's + considered part of the amount for right-alignment.) + +register: + +- Amount columns now resize automatically, using more space if it's + needed and available. + + 0.26 (2015/7/12) Account aliases: @@ -416,4 +500,4 @@ - allow text 1.1, drop data-pprint to build with GHC 7.8.x -0.22.1 (2014/1/6) and older: see http://hledger.org/release-notes or doc/CHANGES.md. +0.22.1 (2014/1/6) and older: see http://hledger.org/release-notes or doc/release-notes.md. diff --git a/Hledger/Cli.hs b/Hledger/Cli.hs --- a/Hledger/Cli.hs +++ b/Hledger/Cli.hs @@ -18,7 +18,7 @@ module Hledger.Cli.Print, module Hledger.Cli.Register, module Hledger.Cli.Stats, - module Hledger.Cli.Options, + module Hledger.Cli.CliOptions, module Hledger.Cli.Utils, module Hledger.Cli.Version, tests_Hledger_Cli, @@ -41,7 +41,7 @@ import Hledger.Cli.Print import Hledger.Cli.Register import Hledger.Cli.Stats -import Hledger.Cli.Options +import Hledger.Cli.CliOptions import Hledger.Cli.Utils import Hledger.Cli.Version @@ -51,12 +51,12 @@ [ tests_Hledger -- ,tests_Hledger_Cli_Add - -- ,tests_Hledger_Cli_Balance + ,tests_Hledger_Cli_Balance ,tests_Hledger_Cli_Balancesheet ,tests_Hledger_Cli_Cashflow -- ,tests_Hledger_Cli_Histogram ,tests_Hledger_Cli_Incomestatement - ,tests_Hledger_Cli_Options + ,tests_Hledger_Cli_CliOptions -- ,tests_Hledger_Cli_Print ,tests_Hledger_Cli_Register -- ,tests_Hledger_Cli_Stats @@ -343,6 +343,7 @@ journal7 = nulljournal {jtxns = [ txnTieKnot Transaction { + tindex=0, tsourcepos=nullsourcepos, tdate=parsedate "2007/01/01", tdate2=Nothing, @@ -359,6 +360,7 @@ } , txnTieKnot Transaction { + tindex=0, tsourcepos=nullsourcepos, tdate=parsedate "2007/02/01", tdate2=Nothing, @@ -375,6 +377,7 @@ } , txnTieKnot Transaction { + tindex=0, tsourcepos=nullsourcepos, tdate=parsedate "2007/01/02", tdate2=Nothing, @@ -391,6 +394,7 @@ } , txnTieKnot Transaction { + tindex=0, tsourcepos=nullsourcepos, tdate=parsedate "2007/01/03", tdate2=Nothing, @@ -407,6 +411,7 @@ } , txnTieKnot Transaction { + tindex=0, tsourcepos=nullsourcepos, tdate=parsedate "2007/01/03", tdate2=Nothing, @@ -423,6 +428,7 @@ } , txnTieKnot Transaction { + tindex=0, tsourcepos=nullsourcepos, tdate=parsedate "2007/01/03", tdate2=Nothing, diff --git a/Hledger/Cli/Accounts.hs b/Hledger/Cli/Accounts.hs --- a/Hledger/Cli/Accounts.hs +++ b/Hledger/Cli/Accounts.hs @@ -23,7 +23,7 @@ import Hledger import Prelude hiding (putStrLn) import Hledger.Utils.UTF8IOCompat (putStrLn) -import Hledger.Cli.Options +import Hledger.Cli.CliOptions -- | Command line options for this command. diff --git a/Hledger/Cli/Add.hs b/Hledger/Cli/Add.hs --- a/Hledger/Cli/Add.hs +++ b/Hledger/Cli/Add.hs @@ -15,6 +15,7 @@ import Control.Monad.Trans (liftIO) import Data.Char (toUpper, toLower) import Data.List.Compat +import qualified Data.Set as S import Data.Maybe import Data.Time.Calendar (Day) import Data.Typeable (Typeable) @@ -29,7 +30,7 @@ import Text.Printf import Hledger -import Hledger.Cli.Options +import Hledger.Cli.CliOptions import Hledger.Cli.Register (postingsReportAsText) @@ -351,7 +352,8 @@ journalAddTransaction :: Journal -> CliOpts -> Transaction -> IO Journal journalAddTransaction j@Journal{jtxns=ts} opts t = do let f = journalFilePath j - appendToJournalFileOrStdout f $ showTransaction t + appendToJournalFileOrStdout f $ showTransactionUnelided t + -- unelided shows all amounts explicitly, in case there's a price, cf #283 when (debug_ opts > 0) $ do putStrLn $ printf "\nAdded transaction to %s:" f putStrLn =<< registerFromString (show t) @@ -384,8 +386,9 @@ capitalize "" = "" capitalize (c:cs) = toUpper c : cs --- Find the most similar and recent transactions matching the given transaction description and report query. --- Transactions are listed with their "relevancy" score, most relevant first. +-- | Find the most similar and recent transactions matching the given +-- transaction description and report query. Transactions are listed +-- with their "relevancy" score, most relevant first. transactionsSimilarTo :: Journal -> Query -> String -> [(Double,Transaction)] transactionsSimilarTo j q desc = sortBy compareRelevanceAndRecency @@ -396,27 +399,33 @@ ts = filter (q `matchesTransaction`) $ jtxns j threshold = 0 -compareDescriptions :: [Char] -> [Char] -> Double +-- | Return a similarity measure, from 0 to 1, for two transaction +-- descriptions. This is like compareStrings, but first strips out +-- any numbers, to improve accuracy eg when there are bank transaction +-- ids from imported data. +compareDescriptions :: String -> String -> Double compareDescriptions s t = compareStrings s' t' where s' = simplify s t' = simplify t simplify = filter (not . (`elem` "0123456789")) --- | Return a similarity measure, from 0 to 1, for two strings. --- This is Simon White's letter pairs algorithm from --- http://www.catalysoft.com/articles/StrikeAMatch.html --- with a modification for short strings. +-- | Return a similarity measure, from 0 to 1, for two strings. This +-- was based on Simon White's string similarity algorithm +-- (http://www.catalysoft.com/articles/StrikeAMatch.html), later found +-- to be https://en.wikipedia.org/wiki/S%C3%B8rensen%E2%80%93Dice_coefficient, +-- modified to handle short strings better. +-- Todo: check out http://nlp.fi.muni.cz/raslan/2008/raslan08.pdf#page=14 . compareStrings :: String -> String -> Double compareStrings "" "" = 1 compareStrings (_:[]) "" = 0 compareStrings "" (_:[]) = 0 compareStrings (a:[]) (b:[]) = if toUpper a == toUpper b then 1 else 0 -compareStrings s1 s2 = 2.0 * fromIntegral i / fromIntegral u +compareStrings s1 s2 = 2 * commonpairs / totalpairs where - i = length $ intersect pairs1 pairs2 - u = length pairs1 + length pairs2 - pairs1 = wordLetterPairs $ uppercase s1 - pairs2 = wordLetterPairs $ uppercase s2 + pairs1 = S.fromList $ wordLetterPairs $ uppercase s1 + pairs2 = S.fromList $ wordLetterPairs $ uppercase s2 + commonpairs = fromIntegral $ S.size $ S.intersection pairs1 pairs2 + totalpairs = fromIntegral $ S.size pairs1 + S.size pairs2 wordLetterPairs = concatMap letterPairs . words diff --git a/Hledger/Cli/Balance.hs b/Hledger/Cli/Balance.hs --- a/Hledger/Cli/Balance.hs +++ b/Hledger/Cli/Balance.hs @@ -236,22 +236,24 @@ balancemode ,balance ,balanceReportAsText + ,balanceReportItemAsText ,periodBalanceReportAsText ,cumulativeBalanceReportAsText ,historicalBalanceReportAsText ,tests_Hledger_Cli_Balance ) where +import Data.List (intercalate) +import Data.Maybe (fromMaybe, isJust) import System.Console.CmdArgs.Explicit as C import Text.CSV import Test.HUnit import Text.Printf (printf) import Text.Tabular as T -import Text.Tabular.AsciiArt +import Text.Tabular.AsciiWide import Hledger -import Hledger.Data.OutputFormat -import Hledger.Cli.Options +import Hledger.Cli.CliOptions import Hledger.Cli.Utils @@ -263,13 +265,14 @@ flagNone ["tree"] (\opts -> setboolopt "tree" opts) "show accounts as a tree (default in simple reports)" ,flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show accounts as a list (default in multicolumn mode)" ,flagReq ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "flat mode: omit N leading account name parts" - ,flagReq ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "tree mode: use this custom line format" + ,flagReq ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "singlecolumn mode: use this custom line format" ,flagNone ["no-elide"] (\opts -> setboolopt "no-elide" opts) "tree mode: don't squash boring parent accounts" ,flagNone ["historical","H"] (\opts -> setboolopt "historical" opts) "multicolumn mode: show historical ending balances" ,flagNone ["cumulative"] (\opts -> setboolopt "cumulative" opts) "multicolumn mode: show accumulated ending balances" ,flagNone ["average","A"] (\opts -> setboolopt "average" opts) "multicolumn mode: show a row average column" ,flagNone ["row-total","T"] (\opts -> setboolopt "row-total" opts) "multicolumn mode: show a row total column" ,flagNone ["no-total","N"] (\opts -> setboolopt "no-total" opts) "don't show the final total row" + ,flagNone ["value","V"] (setboolopt "value") "show amounts as their current market value in their default valuation commodity" ] ++ outputflags ,groupHidden = [] @@ -288,25 +291,38 @@ let format = outputFormatFromOpts opts interval = intervalFromOpts ropts baltype = balancetype_ ropts + valuedate = fromMaybe d $ queryEndDate False $ queryFromOpts d ropts case interval of NoInterval -> do let report = balanceReport ropts (queryFromOpts d ropts) j + convert | value_ ropts = balanceReportValue j valuedate + | otherwise = id render = case format of "csv" -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r _ -> balanceReportAsText - writeOutput opts $ render ropts report + writeOutput opts $ render ropts $ convert report _ -> do let report = multiBalanceReport ropts (queryFromOpts d ropts) j + convert | value_ ropts = multiBalanceReportValue j valuedate + | otherwise = id render = case format of "csv" -> \ropts r -> (++ "\n") $ printCSV $ multiBalanceReportAsCsv ropts r _ -> case baltype of PeriodBalance -> periodBalanceReportAsText CumulativeBalance -> cumulativeBalanceReportAsText HistoricalBalance -> historicalBalanceReportAsText - writeOutput opts $ render ropts report + writeOutput opts $ render ropts $ convert report -- single-column balance reports +-- | Find the best commodity to convert to when asked to show the +-- market value of this commodity on the given date. That is, the one +-- in which it has most recently been market-priced, ie the commodity +-- mentioned in the most recent applicable historical price directive +-- before this date. +-- defaultValuationCommodity :: Journal -> Day -> Commodity -> Maybe Commodity +-- defaultValuationCommodity j d c = mpamount <$> commodityValue j d c + -- | Render a single-column balance report as CSV. balanceReportAsCsv :: ReportOpts -> BalanceReport -> CSV balanceReportAsCsv opts (items, total) = @@ -321,15 +337,26 @@ balanceReportAsText :: ReportOpts -> BalanceReport -> String balanceReportAsText opts ((items, total)) = unlines $ concat lines ++ t where - lines = case lineFormatFromOpts opts of - Right f -> map (balanceReportItemAsText opts f) items - Left err -> [[err]] + fmt = lineFormatFromOpts opts + lines = case fmt of + Right fmt -> map (balanceReportItemAsText opts fmt) items + Left err -> [[err]] t = if no_total_ opts then [] - else ["--------------------" - -- TODO: This must use the format somehow - ,padleft 20 $ showMixedAmountWithoutPrice total - ] + else + case fmt of + Right fmt -> + let + -- abuse renderBalanceReportItem to render the total with similar format + acctcolwidth = maximum' [length fullname | ((fullname, _, _), _) <- items] + totallines = map rstrip $ renderBalanceReportItem fmt (replicate (acctcolwidth+1) ' ', 0, total) + -- with a custom format, extend the line to the full report width; + -- otherwise show the usual 20-char line for compatibility + overlinewidth | isJust (format_ opts) = maximum' $ map length $ concat lines + | otherwise = defaultTotalFieldWidth + overline = replicate overlinewidth '-' + in overline : totallines + Left _ -> [] tests_balanceReportAsText = [ "balanceReportAsText" ~: do @@ -356,41 +383,59 @@ EUR -1 b USD -1 ; Account 'b' has two amounts. The account name is printed on the last line. -} --- | Render one balance report line item as plain text suitable for console output. -balanceReportItemAsText :: ReportOpts -> [OutputFormat] -> BalanceReportItem -> [String] -balanceReportItemAsText opts format ((_, accountName, depth), Mixed amounts) = - -- 'amounts' could contain several quantities of the same commodity with different price. - -- In order to combine them into single value (which is expected) we take the first price and - -- use it for the whole mixed amount. This could be suboptimal. XXX - let Mixed normAmounts = normaliseMixedAmountSquashPricesForDisplay (Mixed amounts) in - case normAmounts of - [] -> [] - [a] -> [formatBalanceReportItem opts (Just accountName) depth a format] - (as) -> multiline as - where - multiline :: [Amount] -> [String] - multiline [] = [] - multiline [a] = [formatBalanceReportItem opts (Just accountName) depth a format] - multiline (a:as) = (formatBalanceReportItem opts Nothing depth a format) : multiline as +-- | Render one balance report line item as plain text suitable for console output (or +-- whatever string format is specified). Note, prices will not be rendered, and +-- differently-priced quantities of the same commodity will appear merged. +-- The output will be one or more lines depending on the format and number of commodities. +balanceReportItemAsText :: ReportOpts -> StringFormat -> BalanceReportItem -> [String] +balanceReportItemAsText opts fmt ((_, accountName, depth), amt) = + renderBalanceReportItem fmt ( + maybeAccountNameDrop opts accountName, + depth, + normaliseMixedAmountSquashPricesForDisplay amt + ) -formatBalanceReportItem :: ReportOpts -> Maybe AccountName -> Int -> Amount -> [OutputFormat] -> String -formatBalanceReportItem _ _ _ _ [] = "" -formatBalanceReportItem opts accountName depth amount (fmt:fmts) = - s ++ (formatBalanceReportItem opts accountName depth amount fmts) +-- | Render a balance report item using the given StringFormat, generating one or more lines of text. +renderBalanceReportItem :: StringFormat -> (AccountName, Int, MixedAmount) -> [String] +renderBalanceReportItem fmt (acctname, depth, total) = + lines $ + case fmt of + OneLine comps -> concatOneLine $ render1 comps + TopAligned comps -> concatBottomPadded $ render comps + BottomAligned comps -> concatTopPadded $ render comps where - s = case fmt of - FormatLiteral l -> l - FormatField ljust min max field -> formatField opts accountName depth amount ljust min max field + render1 = map (renderComponent1 (acctname, depth, total)) + render = map (renderComponent (acctname, depth, total)) -formatField :: ReportOpts -> Maybe AccountName -> Int -> Amount -> Bool -> Maybe Int -> Maybe Int -> HledgerFormatField -> String -formatField opts accountName depth total ljust min max field = case field of - AccountField -> formatValue ljust min max $ maybe "" (maybeAccountNameDrop opts) accountName - DepthSpacerField -> case min of - Just m -> formatValue ljust Nothing max $ replicate (depth * m) ' ' - Nothing -> formatValue ljust Nothing max $ replicate depth ' ' - TotalField -> formatValue ljust min max $ showAmountWithoutPrice total - _ -> "" +defaultTotalFieldWidth = 20 +-- | Render one StringFormat component for a balance report item. +renderComponent :: (AccountName, Int, MixedAmount) -> StringFormatComponent -> String +renderComponent _ (FormatLiteral s) = s +renderComponent (acctname, depth, total) (FormatField ljust min max field) = case field of + DepthSpacerField -> formatString ljust Nothing max $ replicate d ' ' + where d = case min of + Just m -> depth * m + Nothing -> depth + AccountField -> formatString ljust min max acctname + TotalField -> fitStringMulti min max True False $ showMixedAmountWithoutPrice total + _ -> "" + +-- | Render one StringFormat component for a balance report item. +-- This variant is for use with OneLine string formats; it squashes +-- any multi-line rendered values onto one line, comma-and-space separated, +-- while still complying with the width spec. +renderComponent1 :: (AccountName, Int, MixedAmount) -> StringFormatComponent -> String +renderComponent1 _ (FormatLiteral s) = s +renderComponent1 (acctname, depth, total) (FormatField ljust min max field) = case field of + AccountField -> formatString ljust min max ((intercalate ", " . lines) (indented acctname)) + where + -- better to indent the account name here rather than use a DepthField component + -- so that it complies with width spec. Uses a fixed indent step size. + indented = ((replicate (depth*2) ' ')++) + TotalField -> fitStringMulti min max True False $ ((intercalate ", " . map strip . lines) (showMixedAmountWithoutPrice total)) + _ -> "" + -- multi-column balance reports -- | Render a multi-column balance report as CSV. @@ -425,7 +470,7 @@ render id (" "++) showMixedAmountOneLineWithoutPrice $ addtotalrow $ Table - (T.Group NoLine $ map (Header . padright acctswidth) accts) + (T.Group NoLine $ map (Header . padRightWide acctswidth) accts) (T.Group NoLine $ map Header colheadings) (map rowvals items') where @@ -439,7 +484,7 @@ renderacct ((a,a',i),_,_,_) | tree_ opts = replicate ((i-1)*2) ' ' ++ a' | otherwise = maybeAccountNameDrop opts a - acctswidth = maximum $ map length $ accts + acctswidth = maximum' $ map strWidth accts rowvals (_,as,rowtot,rowavg) = as ++ (if row_total_ opts then [rowtot] else []) ++ (if average_ opts then [rowavg] else []) @@ -459,7 +504,7 @@ render id (" "++) showMixedAmountOneLineWithoutPrice $ addtotalrow $ Table - (T.Group NoLine $ map (Header . padright acctswidth) accts) + (T.Group NoLine $ map (Header . padRightWide acctswidth) accts) (T.Group NoLine $ map Header colheadings) (map rowvals items) where @@ -471,7 +516,7 @@ renderacct ((a,a',i),_,_,_) | tree_ opts = replicate ((i-1)*2) ' ' ++ a' | otherwise = maybeAccountNameDrop opts a - acctswidth = maximum $ map length $ accts + acctswidth = maximum' $ map strWidth accts rowvals (_,as,rowtot,rowavg) = as ++ (if row_total_ opts then [rowtot] else []) ++ (if average_ opts then [rowavg] else []) @@ -491,7 +536,7 @@ render id (" "++) showMixedAmountOneLineWithoutPrice $ addtotalrow $ Table - (T.Group NoLine $ map (Header . padright acctswidth) accts) + (T.Group NoLine $ map (Header . padRightWide acctswidth) accts) (T.Group NoLine $ map Header colheadings) (map rowvals items) where @@ -503,7 +548,7 @@ renderacct ((a,a',i),_,_,_) | tree_ opts = replicate ((i-1)*2) ' ' ++ a' | otherwise = maybeAccountNameDrop opts a - acctswidth = maximum $ map length $ accts + acctswidth = maximum' $ map strWidth accts rowvals (_,as,rowtot,rowavg) = as ++ (if row_total_ opts then [rowtot] else []) ++ (if average_ opts then [rowavg] else []) diff --git a/Hledger/Cli/Balancesheet.hs b/Hledger/Cli/Balancesheet.hs --- a/Hledger/Cli/Balancesheet.hs +++ b/Hledger/Cli/Balancesheet.hs @@ -17,7 +17,7 @@ import Text.Shakespeare.Text import Hledger -import Hledger.Cli.Options +import Hledger.Cli.CliOptions import Hledger.Cli.Balance diff --git a/Hledger/Cli/Cashflow.hs b/Hledger/Cli/Cashflow.hs --- a/Hledger/Cli/Cashflow.hs +++ b/Hledger/Cli/Cashflow.hs @@ -20,7 +20,7 @@ import Text.Shakespeare.Text import Hledger -import Hledger.Cli.Options +import Hledger.Cli.CliOptions import Hledger.Cli.Balance diff --git a/Hledger/Cli/CliOptions.hs b/Hledger/Cli/CliOptions.hs new file mode 100644 --- /dev/null +++ b/Hledger/Cli/CliOptions.hs @@ -0,0 +1,590 @@ +{-# LANGUAGE CPP, ScopedTypeVariables, DeriveDataTypeable, FlexibleContexts #-} +{-| + +Common cmdargs modes and flags, a command-line options type, and +related utilities used by hledger commands. + +-} + +module Hledger.Cli.CliOptions ( + + -- * cmdargs flags & modes + helpflags, + detailedversionflag, + inputflags, + reportflags, + outputflags, + generalflagsgroup1, + generalflagsgroup2, + generalflagsgroup3, + defMode, + defCommandMode, + defAddonCommandMode, + argsFlag, + showModeHelp, + withAliases, + + -- * CLI options + CliOpts(..), + defcliopts, + getCliOpts, + decodeRawOpts, + rawOptsToCliOpts, + checkCliOpts, + outputFormats, + defaultOutputFormat, + defaultBalanceLineFormat, + + -- possibly these should move into argsToCliOpts + -- * CLI option accessors + -- | These do the extra processing required for some options. + aliasesFromOpts, + journalFilePathFromOpts, + rulesFilePathFromOpts, + outputFileFromOpts, + outputFormatFromOpts, + defaultWidth, + widthFromOpts, + -- | For register: + registerWidthsFromOpts, + maybeAccountNameDrop, + -- | For balance: + lineFormatFromOpts, + + -- * Other utils + hledgerAddons, + + -- * Tests + tests_Hledger_Cli_CliOptions + +) +where + +import Prelude () +import Prelude.Compat +import qualified Control.Exception as C +import Control.Monad (when) +#if !MIN_VERSION_base(4,8,0) +import Data.Functor.Compat ((<$>)) +#endif +import Data.List.Compat +import Data.List.Split (splitOneOf) +import Data.Maybe +import Safe +import System.Console.CmdArgs +import System.Console.CmdArgs.Explicit +import System.Console.CmdArgs.Text +#ifndef mingw32_HOST_OS +import System.Console.Terminfo +#endif +import System.Directory +import System.Environment +import System.Exit (exitSuccess) +import System.FilePath +import Test.HUnit +import Text.Parsec + +import Hledger +import Hledger.Cli.Version + + +-- common cmdargs flags + +-- | Common help flags: --help, --debug, --version... +helpflags :: [Flag RawOpts] +helpflags = [ + flagNone ["help","h"] (setboolopt "help") "show general help or (after command) command help" + -- ,flagNone ["browse-args"] (setboolopt "browse-args") "use a web UI to select options and build up a command line" + ,flagReq ["debug"] (\s opts -> Right $ setopt "debug" s opts) "N" "show debug output if N is 1-9 (default: 0)" + ,flagNone ["version"] (setboolopt "version") "show version information" + ] + +-- | A hidden flag, just for the hledger executable. +detailedversionflag :: Flag RawOpts +detailedversionflag = flagNone ["version+"] (setboolopt "version+") "show version information with extra detail" + +-- | Common input-related flags: --file, --rules-file, --alias... +inputflags :: [Flag RawOpts] +inputflags = [ + flagReq ["file","f"] (\s opts -> Right $ setopt "file" s opts) "FILE" "use a different input file. For stdin, use -" + ,flagReq ["rules-file"] (\s opts -> Right $ setopt "rules-file" s opts) "RFILE" "CSV conversion rules file (default: FILE.rules)" + ,flagReq ["alias"] (\s opts -> Right $ setopt "alias" s opts) "OLD=NEW" "display accounts named OLD as NEW" + ,flagNone ["ignore-assertions"] (setboolopt "ignore-assertions") "ignore any balance assertions in the journal" + ] + +-- | Common report-related flags: --period, --cost, etc. +reportflags :: [Flag RawOpts] +reportflags = [ + flagReq ["begin","b"] (\s opts -> Right $ setopt "begin" s opts) "DATE" "include postings/txns on or after this date" + ,flagReq ["end","e"] (\s opts -> Right $ setopt "end" s opts) "DATE" "include postings/txns before this date" + ,flagNone ["daily","D"] (setboolopt "daily") "multiperiod/multicolumn report by day" + ,flagNone ["weekly","W"] (setboolopt "weekly") "multiperiod/multicolumn report by week" + ,flagNone ["monthly","M"] (setboolopt "monthly") "multiperiod/multicolumn report by month" + ,flagNone ["quarterly","Q"] (setboolopt "quarterly") "multiperiod/multicolumn report by quarter" + ,flagNone ["yearly","Y"] (setboolopt "yearly") "multiperiod/multicolumn report by year" + ,flagReq ["period","p"] (\s opts -> Right $ setopt "period" s opts) "PERIODEXP" "set start date, end date, and/or reporting interval all at once (overrides the flags above)" + ,flagNone ["date2","aux-date"] (setboolopt "date2") "use postings/txns' secondary dates instead" + + ,flagNone ["cleared","C"] (setboolopt "cleared") "include only cleared postings/txns" + ,flagNone ["pending"] (setboolopt "pending") "include only pending postings/txns" + ,flagNone ["uncleared","U"] (setboolopt "uncleared") "include only uncleared (and pending) postings/txns" + ,flagNone ["real","R"] (setboolopt "real") "include only non-virtual postings" + ,flagReq ["depth"] (\s opts -> Right $ setopt "depth" s opts) "N" "hide accounts/postings deeper than N" + ,flagNone ["empty","E"] (setboolopt "empty") "show empty/zero things which are normally omitted" + ,flagNone ["cost","B"] (setboolopt "cost") "show amounts in their cost price's commodity" + ] + +-- | Common output-related flags: --output-file, --output-format... +outputflags = [ + flagReq ["output-file","o"] (\s opts -> Right $ setopt "output-file" s opts) "FILE[.FMT]" "write output to FILE instead of stdout. A recognised FMT suffix influences the format." + ,flagReq ["output-format","O"] (\s opts -> Right $ setopt "output-format" s opts) "FMT" "select the output format. Supported formats: txt, csv." + ] + +argsFlag :: FlagHelp -> Arg RawOpts +argsFlag desc = flagArg (\s opts -> Right $ setopt "args" s opts) desc + +generalflagstitle :: String +generalflagstitle = "\nGeneral flags" + +generalflagsgroup1, generalflagsgroup2, generalflagsgroup3 :: (String, [Flag RawOpts]) +generalflagsgroup1 = (generalflagstitle, inputflags ++ reportflags ++ helpflags) +generalflagsgroup2 = (generalflagstitle, inputflags ++ helpflags) +generalflagsgroup3 = (generalflagstitle, helpflags) + +-- cmdargs mode constructors + +-- | A basic mode template. +defMode :: Mode RawOpts +defMode = Mode { + modeNames = [] + ,modeHelp = "" + ,modeHelpSuffix = [] + ,modeValue = [] + ,modeCheck = Right + ,modeReform = const Nothing + ,modeExpandAt = True + ,modeGroupFlags = Group { + groupNamed = [] + ,groupUnnamed = [ + flagNone ["help","h","?"] (setboolopt "help") "Show command help." + ] + ,groupHidden = [] + } + ,modeArgs = ([], Nothing) + ,modeGroupModes = toGroup [] + } + +-- | A basic subcommand mode with the given command name(s). +defCommandMode :: [Name] -> Mode RawOpts +defCommandMode names = defMode { + modeNames=names + ,modeValue=[("command", headDef "" names)] + ,modeArgs = ([], Just $ argsFlag "[PATTERNS]") + } + +-- | A basic subcommand mode suitable for an add-on command. +defAddonCommandMode :: Name -> Mode RawOpts +defAddonCommandMode addon = defMode { + modeNames = [addon] + ,modeHelp = fromMaybe "" $ lookup (stripAddonExtension addon) standardAddonsHelp + ,modeValue=[("command",addon)] + ,modeGroupFlags = Group { + groupUnnamed = [] + ,groupHidden = [] + ,groupNamed = [generalflagsgroup1] + } + ,modeArgs = ([], Just $ argsFlag "[ARGS]") + } + +-- | Built-in descriptions for some of the known external addons, +-- since we don't currently have any way to ask them. +standardAddonsHelp :: [(String,String)] +standardAddonsHelp = [ + ("chart", "generate simple balance pie charts") + ,("interest", "generate interest transaction entries") + ,("irr", "calculate internal rate of return") + ,("vty", "start the curses-style interface") + ,("web", "start the web interface") + ,("accounts", "list account names") + ,("balance-csv", "output a balance report as CSV") + ,("equity", "show a transaction entry zeroing all accounts") + ,("print-unique", "print only transactions with unique descriptions") + ,("register-csv", "output a register report as CSV") + ,("rewrite", "add specified postings to matched transaction entries") + ,("addon", "dummy add-on command for testing") + ,("addon2", "dummy add-on command for testing") + ,("addon3", "dummy add-on command for testing") + ,("addon4", "dummy add-on command for testing") + ,("addon5", "dummy add-on command for testing") + ,("addon6", "dummy add-on command for testing") + ,("addon7", "dummy add-on command for testing") + ,("addon8", "dummy add-on command for testing") + ,("addon9", "dummy add-on command for testing") + ] + +-- | Get a mode's help message as a nicely wrapped string. +showModeHelp :: Mode a -> String +showModeHelp = (showText defaultWrap :: [Text] -> String) . + (helpText [] HelpFormatDefault :: Mode a -> [Text]) + +-- | Add command aliases to the command's help string. +withAliases :: String -> [String] -> String +s `withAliases` [] = s +s `withAliases` as = s ++ " (" ++ intercalate ", " as ++ ")" +-- s `withAliases` (a:[]) = s ++ " (alias: " ++ a ++ ")" +-- s `withAliases` as = s ++ " (aliases: " ++ intercalate ", " as ++ ")" + + +-- help_postscript = [ +-- -- "DATES can be Y/M/D or smart dates like \"last month\"." +-- -- ,"PATTERNS are regular" +-- -- ,"expressions which filter by account name. Prefix a pattern with desc: to" +-- -- ,"filter by transaction description instead, prefix with not: to negate it." +-- -- ,"When using both, not: comes last." +-- ] + + +-- CliOpts + +-- | Command line options, used in the @hledger@ package and above. +-- This is the \"opts\" used throughout hledger CLI code. +-- representing the options that arguments that were provided at +-- startup on the command-line. +data CliOpts = CliOpts { + rawopts_ :: RawOpts + ,command_ :: String + ,file_ :: [FilePath] + ,rules_file_ :: Maybe FilePath + ,output_file_ :: Maybe FilePath + ,output_format_ :: Maybe String + ,alias_ :: [String] + ,ignore_assertions_ :: Bool + ,debug_ :: Int -- ^ debug level, set by @--debug[=N]@. See also 'Hledger.Utils.debugLevel'. + ,no_new_accounts_ :: Bool -- add + ,width_ :: Maybe String -- ^ the --width value provided, if any + ,available_width_ :: Int -- ^ estimated usable screen width, based on + -- 1. the COLUMNS env var, if set + -- 2. the width reported by the terminal, if supported + -- 3. the default (80) + ,reportopts_ :: ReportOpts + } deriving (Show, Data, Typeable) + +instance Default CliOpts where def = defcliopts + +defcliopts :: CliOpts +defcliopts = CliOpts + def + def + def + def + def + def + def + def + def + def + def + defaultWidth + def + +-- | Convert possibly encoded option values to regular unicode strings. +decodeRawOpts :: RawOpts -> RawOpts +decodeRawOpts = map (\(name',val) -> (name', fromSystemString val)) + +-- | Default width for hledger console output, when not otherwise specified. +defaultWidth :: Int +defaultWidth = 80 + +-- | Parse raw option string values to the desired final data types. +-- Any relative smart dates will be converted to fixed dates based on +-- today's date. Parsing failures will raise an error. +-- Also records the terminal width, if supported. +rawOptsToCliOpts :: RawOpts -> IO CliOpts +rawOptsToCliOpts rawopts = checkCliOpts <$> do + ropts <- rawOptsToReportOpts rawopts + mcolumns <- readMay <$> getEnvSafe "COLUMNS" + mtermwidth <- +#ifdef mingw32_HOST_OS + return Nothing +#else + setupTermFromEnv >>= return . flip getCapability termColumns + -- XXX Throws a SetupTermError if the terminfo database could not be read, should catch +#endif + let availablewidth = head $ catMaybes [mcolumns, mtermwidth, Just defaultWidth] + return defcliopts { + rawopts_ = rawopts + ,command_ = stringopt "command" rawopts + ,file_ = map stripquotes $ listofstringopt "file" rawopts + ,rules_file_ = maybestringopt "rules-file" rawopts + ,output_file_ = maybestringopt "output-file" rawopts + ,output_format_ = maybestringopt "output-format" rawopts + ,alias_ = map stripquotes $ listofstringopt "alias" rawopts + ,debug_ = intopt "debug" rawopts + ,ignore_assertions_ = boolopt "ignore-assertions" rawopts + ,no_new_accounts_ = boolopt "no-new-accounts" rawopts -- add + ,width_ = maybestringopt "width" rawopts + ,available_width_ = availablewidth + ,reportopts_ = ropts + } + +-- | Do final validation of processed opts, raising an error if there is trouble. +checkCliOpts :: CliOpts -> CliOpts +checkCliOpts opts = + either optserror (const opts) $ do + -- XXX move to checkReportOpts or move _format to CliOpts + case lineFormatFromOpts $ reportopts_ opts of + Left err -> Left $ "could not parse format option: "++err + Right _ -> Right () + -- XXX check registerWidthsFromOpts opts + +-- Currently only used by some extras/ scripts: +-- | Parse hledger CLI options from the command line using the given +-- cmdargs mode, and either return them or, if a help flag is present, +-- print the mode help and exit the program. +getCliOpts :: Mode RawOpts -> IO CliOpts +getCliOpts mode' = do + args' <- getArgs + let rawopts = decodeRawOpts $ processValue mode' args' + opts <- rawOptsToCliOpts rawopts + debugArgs args' opts + -- if any (`elem` args) ["--help","-h","-?"] + when ("help" `inRawOpts` rawopts_ opts) $ + putStr (showModeHelp mode') >> exitSuccess + return opts + where + -- | Print debug info about arguments and options if --debug is present. + debugArgs :: [String] -> CliOpts -> IO () + debugArgs args' opts = + when ("--debug" `elem` args') $ do + progname' <- getProgName + putStrLn $ "running: " ++ progname' + putStrLn $ "raw args: " ++ show args' + putStrLn $ "processed opts:\n" ++ show opts + d <- getCurrentDay + putStrLn $ "search query: " ++ show (queryFromOpts d $ reportopts_ opts) + +-- CliOpts accessors + +-- | Get the account name aliases from options, if any. +aliasesFromOpts :: CliOpts -> [AccountAlias] +aliasesFromOpts = map (\a -> fromparse $ runParser accountaliasp () ("--alias "++quoteIfNeeded a) a) + . alias_ + +-- | Get the (tilde-expanded, absolute) journal file path from +-- 1. options, 2. an environment variable, or 3. the default. +-- Actually, returns one or more file paths. There will be more +-- than one if multiple -f options were provided. +journalFilePathFromOpts :: CliOpts -> IO [String] +journalFilePathFromOpts opts = do + f <- defaultJournalPath + d <- getCurrentDirectory + mapM (expandPath d) $ ifEmpty (file_ opts) [f] + where + ifEmpty [] d = d + ifEmpty l _ = l + +-- | Get the expanded, absolute output file path from options, +-- or the default (-, meaning stdout). +outputFileFromOpts :: CliOpts -> IO FilePath +outputFileFromOpts opts = do + d <- getCurrentDirectory + case output_file_ opts of + Just p -> expandPath d p + Nothing -> return "-" + +defaultOutputFormat = "txt" + +outputFormats = + [defaultOutputFormat] ++ + ["csv" + ] + +-- | Get the output format from the --output-format option, +-- otherwise from a recognised file extension in the --output-file option, +-- otherwise the default (txt). +outputFormatFromOpts :: CliOpts -> String +outputFormatFromOpts opts = + case output_format_ opts of + Just f -> f + Nothing -> + case filePathExtension <$> output_file_ opts of + Just ext | ext `elem` outputFormats -> ext + _ -> defaultOutputFormat + +-- -- | Get the file name without its last extension, from a file path. +-- filePathBaseFileName :: FilePath -> String +-- filePathBaseFileName = fst . splitExtension . snd . splitFileName + +-- | Get the last file extension, without the dot, from a file path. +-- May return the null string. +filePathExtension :: FilePath -> String +filePathExtension = dropWhile (=='.') . snd . splitExtension . snd . splitFileName + +-- | Get the (tilde-expanded) rules file path from options, if any. +rulesFilePathFromOpts :: CliOpts -> IO (Maybe FilePath) +rulesFilePathFromOpts opts = do + d <- getCurrentDirectory + maybe (return Nothing) (fmap Just . expandPath d) $ rules_file_ opts + +-- | Get the width in characters to use for console output. +-- This comes from the --width option, or the COLUMNS environment +-- variable, or (on posix platforms) the current terminal width, or 80. +-- Will raise a parse error for a malformed --width argument. +widthFromOpts :: CliOpts -> Int +widthFromOpts CliOpts{width_=Nothing, available_width_=w} = w +widthFromOpts CliOpts{width_=Just s} = + case runParser (read `fmap` many1 digit <* eof) () "(unknown)" s of + Left e -> optserror $ "could not parse width option: "++show e + Right w -> w + +-- for register: + +-- | Get the width in characters to use for the register command's console output, +-- and also the description column width if specified (following the main width, comma-separated). +-- The widths will be as follows: +-- @ +-- no --width flag - overall width is the available width (COLUMNS, or posix terminal width, or 80); description width is unspecified (auto) +-- --width W - overall width is W, description width is auto +-- --width W,D - overall width is W, description width is D +-- @ +-- Will raise a parse error for a malformed --width argument. +registerWidthsFromOpts :: CliOpts -> (Int, Maybe Int) +registerWidthsFromOpts CliOpts{width_=Nothing, available_width_=w} = (w, Nothing) +registerWidthsFromOpts CliOpts{width_=Just s} = + case runParser registerwidthp () "(unknown)" s of + Left e -> optserror $ "could not parse width option: "++show e + Right ws -> ws + where + registerwidthp :: Stream [Char] m t => ParsecT [Char] st m (Int, Maybe Int) + registerwidthp = do + totalwidth <- read `fmap` many1 digit + descwidth <- optionMaybe (char ',' >> read `fmap` many1 digit) + eof + return (totalwidth, descwidth) + +-- | Drop leading components of accounts names as specified by --drop, but only in --flat mode. +maybeAccountNameDrop :: ReportOpts -> AccountName -> AccountName +maybeAccountNameDrop opts a | tree_ opts = a + | otherwise = accountNameDrop (drop_ opts) a + +-- for balance, currently: + +-- | Parse the format option if provided, possibly returning an error, +-- otherwise get the default value. +lineFormatFromOpts :: ReportOpts -> Either String StringFormat +lineFormatFromOpts = maybe (Right defaultBalanceLineFormat) parseStringFormat . format_ + +-- | Default line format for balance report: "%20(total) %2(depth_spacer)%-(account)" +defaultBalanceLineFormat :: StringFormat +defaultBalanceLineFormat = BottomAligned [ + FormatField False (Just 20) Nothing TotalField + , FormatLiteral " " + , FormatField True (Just 2) Nothing DepthSpacerField + , FormatField True Nothing Nothing AccountField + ] + +-- Other utils + +-- | Get the sorted unique precise names and display names of hledger +-- add-ons found in the current user's PATH. The precise names are the +-- add-on's filename with the "hledger-" prefix removed. The display +-- names have the file extension removed also, except when it's needed +-- for disambiguation. +-- +-- -- Also when there are exactly two similar names, one with the .hs or +-- -- .lhs extension and the other with the .exe extension or no +-- -- extension - presumably source and compiled versions of a haskell +-- -- script - we exclude the source version. +-- +-- This function can return add-on names which shadow built-in command +-- names, but hledger will ignore these. +-- +hledgerAddons :: IO ([String],[String]) +hledgerAddons = do + exes <- hledgerExecutablesInPath + let precisenames = -- concatMap dropRedundant $ + -- groupBy (\a b -> dropExtension a == dropExtension b) $ + map stripprefix exes + let displaynames = concatMap stripext $ + groupBy (\a b -> dropExtension a == dropExtension b) precisenames + return (precisenames, displaynames) + where + stripprefix = drop (length progname + 1) + -- dropRedundant [f,f2] | takeExtension f `elem` ["",".exe"] && takeExtension f2 `elem` [".hs",".lhs"] = [f] + -- dropRedundant fs = fs + stripext [f] = [dropExtension f] + stripext fs = fs + +-- | Get the sorted unique filenames of all hledger-* executables in +-- the current user's PATH. Currently these are: files in any of the +-- PATH directories, named hledger-*, with either no extension (and no +-- periods in the name) or one of the addonExtensions. Limitations: +-- we do not currently check that the file is really a file (not eg a +-- directory) or whether it has execute permission. +hledgerExecutablesInPath :: IO [String] +hledgerExecutablesInPath = do + pathdirs <- splitOneOf "[:;]" `fmap` getEnvSafe "PATH" + pathfiles <- concat `fmap` mapM getDirectoryContentsSafe pathdirs + return $ nub $ sort $ filter isHledgerExeName pathfiles + -- XXX should exclude directories and files without execute permission. + -- These will do a stat for each hledger-*, probably ok. + -- But they need paths, not just filenames + -- hledgerexes <- filterM doesFileExist hledgernamed + -- hledgerexes' <- filterM isExecutable hledgerexes + -- return hledgerexes + +-- isExecutable f = getPermissions f >>= (return . executable) + +isHledgerExeName :: String -> Bool +isHledgerExeName = isRight . parsewith hledgerexenamep + where + hledgerexenamep = do + _ <- string progname + _ <- char '-' + _ <- many1 (noneOf ".") + optional (string "." >> choice' (map string addonExtensions)) + eof + +stripAddonExtension :: String -> String +stripAddonExtension = regexReplace re "" where re = "\\.(" ++ intercalate "|" addonExtensions ++ ")$" + +addonExtensions :: [String] +addonExtensions = + ["bat" + ,"com" + ,"exe" + ,"hs" + ,"lhs" + ,"pl" + ,"py" + ,"rb" + ,"rkt" + ,"sh" + -- ,"" + ] + +getEnvSafe :: String -> IO String +getEnvSafe v = getEnv v `C.catch` (\(_::C.IOException) -> return "") -- XXX should catch only isDoesNotExistError e + +getDirectoryContentsSafe :: FilePath -> IO [String] +getDirectoryContentsSafe d = + (filter (not . (`elem` [".",".."])) `fmap` getDirectoryContents d) `C.catch` (\(_::C.IOException) -> return []) + +-- not used: +-- -- | Print debug info about arguments and options if --debug is present. +-- debugArgs :: [String] -> CliOpts -> IO () +-- debugArgs args opts = +-- when ("--debug" `elem` args) $ do +-- progname <- getProgName +-- putStrLn $ "running: " ++ progname +-- putStrLn $ "raw args: " ++ show args +-- putStrLn $ "processed opts:\n" ++ show opts +-- d <- getCurrentDay +-- putStrLn $ "search query: " ++ (show $ queryFromOpts d $ reportopts_ opts) + +-- tests + +tests_Hledger_Cli_CliOptions :: Test +tests_Hledger_Cli_CliOptions = TestList + [ + ] diff --git a/Hledger/Cli/Histogram.hs b/Hledger/Cli/Histogram.hs --- a/Hledger/Cli/Histogram.hs +++ b/Hledger/Cli/Histogram.hs @@ -14,7 +14,7 @@ import Text.Printf import Hledger -import Hledger.Cli.Options +import Hledger.Cli.CliOptions import Prelude hiding (putStr) import Hledger.Utils.UTF8IOCompat (putStr) diff --git a/Hledger/Cli/Incomestatement.hs b/Hledger/Cli/Incomestatement.hs --- a/Hledger/Cli/Incomestatement.hs +++ b/Hledger/Cli/Incomestatement.hs @@ -17,7 +17,7 @@ import Text.Shakespeare.Text import Hledger -import Hledger.Cli.Options +import Hledger.Cli.CliOptions import Hledger.Cli.Balance diff --git a/Hledger/Cli/Main.hs b/Hledger/Cli/Main.hs --- a/Hledger/Cli/Main.hs +++ b/Hledger/Cli/Main.hs @@ -60,7 +60,7 @@ import Hledger.Cli.Print import Hledger.Cli.Register import Hledger.Cli.Stats -import Hledger.Cli.Options +import Hledger.Cli.CliOptions import Hledger.Cli.Tests import Hledger.Cli.Utils import Hledger.Cli.Version @@ -144,7 +144,7 @@ args' = moveFlagsAfterCommand args cmdargsopts = processValue (mainmode addons) args' cmdargsopts' = decodeRawOpts cmdargsopts - rawOptsToCliOpts cmdargsopts' >>= checkCliOpts + rawOptsToCliOpts cmdargsopts' -- | A hacky workaround for cmdargs not accepting flags before the -- subcommand name: try to detect and move such flags after the @@ -186,7 +186,7 @@ -- on the raw command-line arguments, cmdarg's interpretation of -- same, and hledger-* executables in the user's PATH. A somewhat -- complex mishmash of cmdargs and custom processing, hence all the - -- debugging support and tests. See also Hledger.Cli.Options and + -- debugging support and tests. See also Hledger.Cli.CliOptions and -- command-line.test. -- some preliminary (imperfect) argument parsing to supplement cmdargs diff --git a/Hledger/Cli/Options.hs b/Hledger/Cli/Options.hs deleted file mode 100644 --- a/Hledger/Cli/Options.hs +++ /dev/null @@ -1,586 +0,0 @@ -{-# LANGUAGE CPP, ScopedTypeVariables, DeriveDataTypeable, FlexibleContexts #-} -{-| - -Common cmdargs modes and flags, a command-line options type, and -related utilities used by hledger commands. - --} - -module Hledger.Cli.Options ( - - -- * cmdargs flags & modes - helpflags, - detailedversionflag, - inputflags, - reportflags, - outputflags, - generalflagsgroup1, - generalflagsgroup2, - generalflagsgroup3, - defMode, - defCommandMode, - defAddonCommandMode, - argsFlag, - showModeHelp, - withAliases, - - -- * CLI options - CliOpts(..), - defcliopts, - getCliOpts, - decodeRawOpts, - rawOptsToCliOpts, - checkCliOpts, - outputFormats, - defaultOutputFormat, - - -- possibly these should move into argsToCliOpts - -- * CLI option accessors - -- | These do the extra processing required for some options. - aliasesFromOpts, - journalFilePathFromOpts, - rulesFilePathFromOpts, - outputFileFromOpts, - outputFormatFromOpts, - defaultWidth, - widthFromOpts, - -- | For register: - registerWidthsFromOpts, - maybeAccountNameDrop, - -- | For balance: - lineFormatFromOpts, - - -- * Other utils - hledgerAddons, - - -- * Tests - tests_Hledger_Cli_Options - -) -where - -import Prelude () -import Prelude.Compat -import qualified Control.Exception as C -import Control.Monad (when) -import Data.List.Compat -import Data.List.Split (splitOneOf) -import Data.Maybe -import Safe -import System.Console.CmdArgs -import System.Console.CmdArgs.Explicit -import System.Console.CmdArgs.Text -#ifndef mingw32_HOST_OS -import System.Console.Terminfo -#endif -import System.Directory -import System.Environment -import System.Exit (exitSuccess) -import System.FilePath -import Test.HUnit -import Text.Parsec - -import Hledger -import Hledger.Data.OutputFormat as OutputFormat -import Hledger.Cli.Version - - --- common cmdargs flags - --- | Common help flags: --help, --debug, --version... -helpflags :: [Flag RawOpts] -helpflags = [ - flagNone ["help","h"] (setboolopt "help") "show general help or (after command) command help" - -- ,flagNone ["browse-args"] (setboolopt "browse-args") "use a web UI to select options and build up a command line" - ,flagReq ["debug"] (\s opts -> Right $ setopt "debug" s opts) "N" "show debug output if N is 1-9 (default: 0)" - ,flagNone ["version"] (setboolopt "version") "show version information" - ] - --- | A hidden flag, just for the hledger executable. -detailedversionflag :: Flag RawOpts -detailedversionflag = flagNone ["version+"] (setboolopt "version+") "show version information with extra detail" - --- | Common input-related flags: --file, --rules-file, --alias... -inputflags :: [Flag RawOpts] -inputflags = [ - flagReq ["file","f"] (\s opts -> Right $ setopt "file" s opts) "FILE" "use a different input file. For stdin, use -" - ,flagReq ["rules-file"] (\s opts -> Right $ setopt "rules-file" s opts) "RFILE" "CSV conversion rules file (default: FILE.rules)" - ,flagReq ["alias"] (\s opts -> Right $ setopt "alias" s opts) "OLD=NEW" "display accounts named OLD as NEW" - ,flagNone ["ignore-assertions"] (setboolopt "ignore-assertions") "ignore any balance assertions in the journal" - ] - --- | Common report-related flags: --period, --cost, etc. -reportflags :: [Flag RawOpts] -reportflags = [ - flagReq ["begin","b"] (\s opts -> Right $ setopt "begin" s opts) "DATE" "include postings/txns on or after this date" - ,flagReq ["end","e"] (\s opts -> Right $ setopt "end" s opts) "DATE" "include postings/txns before this date" - ,flagNone ["daily","D"] (setboolopt "daily") "multiperiod/multicolumn report by day" - ,flagNone ["weekly","W"] (setboolopt "weekly") "multiperiod/multicolumn report by week" - ,flagNone ["monthly","M"] (setboolopt "monthly") "multiperiod/multicolumn report by month" - ,flagNone ["quarterly","Q"] (setboolopt "quarterly") "multiperiod/multicolumn report by quarter" - ,flagNone ["yearly","Y"] (setboolopt "yearly") "multiperiod/multicolumn report by year" - ,flagReq ["period","p"] (\s opts -> Right $ setopt "period" s opts) "PERIODEXP" "set start date, end date, and/or reporting interval all at once (overrides the flags above)" - ,flagNone ["date2","aux-date"] (setboolopt "date2") "use postings/txns' secondary dates instead" - - ,flagNone ["cleared","C"] (setboolopt "cleared") "include only cleared postings/txns" - ,flagNone ["pending"] (setboolopt "pending") "include only pending postings/txns" - ,flagNone ["uncleared","U"] (setboolopt "uncleared") "include only uncleared (and pending) postings/txns" - ,flagNone ["real","R"] (setboolopt "real") "include only non-virtual postings" - ,flagReq ["depth"] (\s opts -> Right $ setopt "depth" s opts) "N" "hide accounts/postings deeper than N" - ,flagNone ["empty","E"] (setboolopt "empty") "show empty/zero things which are normally omitted" - ,flagNone ["cost","B"] (setboolopt "cost") "show amounts in their cost price's commodity" - ] - --- | Common output-related flags: --output-file, --output-format... -outputflags = [ - flagReq ["output-file","o"] (\s opts -> Right $ setopt "output-file" s opts) "FILE[.FMT]" "write output to FILE instead of stdout. A recognised FMT suffix influences the format." - ,flagReq ["output-format","O"] (\s opts -> Right $ setopt "output-format" s opts) "FMT" "select the output format. Supported formats: txt, csv." - ] - -argsFlag :: FlagHelp -> Arg RawOpts -argsFlag desc = flagArg (\s opts -> Right $ setopt "args" s opts) desc - -generalflagstitle :: String -generalflagstitle = "\nGeneral flags" - -generalflagsgroup1, generalflagsgroup2, generalflagsgroup3 :: (String, [Flag RawOpts]) -generalflagsgroup1 = (generalflagstitle, inputflags ++ reportflags ++ helpflags) -generalflagsgroup2 = (generalflagstitle, inputflags ++ helpflags) -generalflagsgroup3 = (generalflagstitle, helpflags) - --- cmdargs mode constructors - --- | A basic mode template. -defMode :: Mode RawOpts -defMode = Mode { - modeNames = [] - ,modeHelp = "" - ,modeHelpSuffix = [] - ,modeValue = [] - ,modeCheck = Right - ,modeReform = const Nothing - ,modeExpandAt = True - ,modeGroupFlags = Group { - groupNamed = [] - ,groupUnnamed = [ - flagNone ["help","h","?"] (setboolopt "help") "Show command help." - ] - ,groupHidden = [] - } - ,modeArgs = ([], Nothing) - ,modeGroupModes = toGroup [] - } - --- | A basic subcommand mode with the given command name(s). -defCommandMode :: [Name] -> Mode RawOpts -defCommandMode names = defMode { - modeNames=names - ,modeValue=[("command", headDef "" names)] - ,modeArgs = ([], Just $ argsFlag "[PATTERNS]") - } - --- | A basic subcommand mode suitable for an add-on command. -defAddonCommandMode :: Name -> Mode RawOpts -defAddonCommandMode addon = defMode { - modeNames = [addon] - ,modeHelp = fromMaybe "" $ lookup (stripAddonExtension addon) standardAddonsHelp - ,modeValue=[("command",addon)] - ,modeGroupFlags = Group { - groupUnnamed = [] - ,groupHidden = [] - ,groupNamed = [generalflagsgroup1] - } - ,modeArgs = ([], Just $ argsFlag "[ARGS]") - } - --- | Built-in descriptions for some of the known external addons, --- since we don't currently have any way to ask them. -standardAddonsHelp :: [(String,String)] -standardAddonsHelp = [ - ("chart", "generate simple balance pie charts") - ,("interest", "generate interest transaction entries") - ,("irr", "calculate internal rate of return") - ,("vty", "start the curses-style interface") - ,("web", "start the web interface") - ,("accounts", "list account names") - ,("balance-csv", "output a balance report as CSV") - ,("equity", "show a transaction entry zeroing all accounts") - ,("print-unique", "print only transactions with unique descriptions") - ,("register-csv", "output a register report as CSV") - ,("rewrite", "add specified postings to matched transaction entries") - ,("addon", "dummy add-on command for testing") - ,("addon2", "dummy add-on command for testing") - ,("addon3", "dummy add-on command for testing") - ,("addon4", "dummy add-on command for testing") - ,("addon5", "dummy add-on command for testing") - ,("addon6", "dummy add-on command for testing") - ,("addon7", "dummy add-on command for testing") - ,("addon8", "dummy add-on command for testing") - ,("addon9", "dummy add-on command for testing") - ] - --- | Get a mode's help message as a nicely wrapped string. -showModeHelp :: Mode a -> String -showModeHelp = (showText defaultWrap :: [Text] -> String) . - (helpText [] HelpFormatDefault :: Mode a -> [Text]) - --- | Add command aliases to the command's help string. -withAliases :: String -> [String] -> String -s `withAliases` [] = s -s `withAliases` as = s ++ " (" ++ intercalate ", " as ++ ")" --- s `withAliases` (a:[]) = s ++ " (alias: " ++ a ++ ")" --- s `withAliases` as = s ++ " (aliases: " ++ intercalate ", " as ++ ")" - - --- help_postscript = [ --- -- "DATES can be Y/M/D or smart dates like \"last month\"." --- -- ,"PATTERNS are regular" --- -- ,"expressions which filter by account name. Prefix a pattern with desc: to" --- -- ,"filter by transaction description instead, prefix with not: to negate it." --- -- ,"When using both, not: comes last." --- ] - - --- CliOpts - --- | Command line options, used in the @hledger@ package and above. --- This is the \"opts\" used throughout hledger CLI code. --- representing the options that arguments that were provided at --- startup on the command-line. -data CliOpts = CliOpts { - rawopts_ :: RawOpts - ,command_ :: String - ,file_ :: [FilePath] - ,rules_file_ :: Maybe FilePath - ,output_file_ :: Maybe FilePath - ,output_format_ :: Maybe String - ,alias_ :: [String] - ,ignore_assertions_ :: Bool - ,debug_ :: Int -- ^ debug level, set by @--debug[=N]@. See also 'Hledger.Utils.debugLevel'. - ,no_new_accounts_ :: Bool -- add - ,width_ :: Maybe String -- ^ the --width value provided, if any - ,available_width_ :: Int -- ^ estimated usable screen width, based on - -- 1. the COLUMNS env var, if set - -- 2. the width reported by the terminal, if supported - -- 3. the default (80) - ,reportopts_ :: ReportOpts - } deriving (Show, Data, Typeable) - -instance Default CliOpts where def = defcliopts - -defcliopts :: CliOpts -defcliopts = CliOpts - def - def - def - def - def - def - def - def - def - def - def - defaultWidth - def - --- | Convert possibly encoded option values to regular unicode strings. -decodeRawOpts :: RawOpts -> RawOpts -decodeRawOpts = map (\(name',val) -> (name', fromSystemString val)) - --- | Default width for hledger console output, when not otherwise specified. -defaultWidth :: Int -defaultWidth = 80 - --- | Parse raw option string values to the desired final data types. --- Any relative smart dates will be converted to fixed dates based on --- today's date. Parsing failures will raise an error. --- Also records the terminal width, if supported. -rawOptsToCliOpts :: RawOpts -> IO CliOpts -rawOptsToCliOpts rawopts = do - ropts <- rawOptsToReportOpts rawopts - mcolumns <- readMay <$> getEnvSafe "COLUMNS" - mtermwidth <- -#ifdef mingw32_HOST_OS - return Nothing -#else - setupTermFromEnv >>= return . flip getCapability termColumns - -- XXX Throws a SetupTermError if the terminfo database could not be read, should catch -#endif - let availablewidth = head $ catMaybes [mcolumns, mtermwidth, Just defaultWidth] - return defcliopts { - rawopts_ = rawopts - ,command_ = stringopt "command" rawopts - ,file_ = map stripquotes $ listofstringopt "file" rawopts - ,rules_file_ = maybestringopt "rules-file" rawopts - ,output_file_ = maybestringopt "output-file" rawopts - ,output_format_ = maybestringopt "output-format" rawopts - ,alias_ = map stripquotes $ listofstringopt "alias" rawopts - ,debug_ = intopt "debug" rawopts - ,ignore_assertions_ = boolopt "ignore-assertions" rawopts - ,no_new_accounts_ = boolopt "no-new-accounts" rawopts -- add - ,width_ = maybestringopt "width" rawopts - ,available_width_ = availablewidth - ,reportopts_ = ropts - } - --- | Do final validation of processed opts, raising an error if there is trouble. -checkCliOpts :: CliOpts -> IO CliOpts -- or pure.. -checkCliOpts opts@CliOpts{reportopts_=ropts} = do - case lineFormatFromOpts ropts of - Left err -> optserror $ "could not parse format option: "++err - Right _ -> return () - -- XXX check registerWidthsFromOpts opts - return opts - --- Currently only used by some extras/ scripts: --- | Parse hledger CLI options from the command line using the given --- cmdargs mode, and either return them or, if a help flag is present, --- print the mode help and exit the program. -getCliOpts :: Mode RawOpts -> IO CliOpts -getCliOpts mode' = do - args' <- getArgs - let rawopts = decodeRawOpts $ processValue mode' args' - opts <- rawOptsToCliOpts rawopts >>= checkCliOpts - debugArgs args' opts - -- if any (`elem` args) ["--help","-h","-?"] - when ("help" `inRawOpts` rawopts_ opts) $ - putStr (showModeHelp mode') >> exitSuccess - return opts - where - -- | Print debug info about arguments and options if --debug is present. - debugArgs :: [String] -> CliOpts -> IO () - debugArgs args' opts = - when ("--debug" `elem` args') $ do - progname' <- getProgName - putStrLn $ "running: " ++ progname' - putStrLn $ "raw args: " ++ show args' - putStrLn $ "processed opts:\n" ++ show opts - d <- getCurrentDay - putStrLn $ "search query: " ++ show (queryFromOpts d $ reportopts_ opts) - --- CliOpts accessors - --- | Get the account name aliases from options, if any. -aliasesFromOpts :: CliOpts -> [AccountAlias] -aliasesFromOpts = map (\a -> fromparse $ runParser accountaliasp () ("--alias "++quoteIfNeeded a) a) - . alias_ - --- | Get the (tilde-expanded, absolute) journal file path from --- 1. options, 2. an environment variable, or 3. the default. --- Actually, returns one or more file paths. There will be more --- than one if multiple -f options were provided. -journalFilePathFromOpts :: CliOpts -> IO [String] -journalFilePathFromOpts opts = do - f <- defaultJournalPath - d <- getCurrentDirectory - mapM (expandPath d) $ ifEmpty (file_ opts) [f] - where - ifEmpty [] d = d - ifEmpty l _ = l - --- | Get the expanded, absolute output file path from options, --- or the default (-, meaning stdout). -outputFileFromOpts :: CliOpts -> IO FilePath -outputFileFromOpts opts = do - d <- getCurrentDirectory - case output_file_ opts of - Just p -> expandPath d p - Nothing -> return "-" - -defaultOutputFormat = "txt" - -outputFormats = - [defaultOutputFormat] ++ - ["csv" - ] - --- | Get the output format from the --output-format option, --- otherwise from a recognised file extension in the --output-file option, --- otherwise the default (txt). -outputFormatFromOpts :: CliOpts -> String -outputFormatFromOpts opts = - case output_format_ opts of - Just f -> f - Nothing -> - case filePathExtension <$> output_file_ opts of - Just ext | ext `elem` outputFormats -> ext - _ -> defaultOutputFormat - --- -- | Get the file name without its last extension, from a file path. --- filePathBaseFileName :: FilePath -> String --- filePathBaseFileName = fst . splitExtension . snd . splitFileName - --- | Get the last file extension, without the dot, from a file path. --- May return the null string. -filePathExtension :: FilePath -> String -filePathExtension = dropWhile (=='.') . snd . splitExtension . snd . splitFileName - --- | Get the (tilde-expanded) rules file path from options, if any. -rulesFilePathFromOpts :: CliOpts -> IO (Maybe FilePath) -rulesFilePathFromOpts opts = do - d <- getCurrentDirectory - maybe (return Nothing) (fmap Just . expandPath d) $ rules_file_ opts - --- | Get the width in characters to use for console output. --- This comes from the --width option, or the COLUMNS environment --- variable, or (on posix platforms) the current terminal width, or 80. --- Will raise a parse error for a malformed --width argument. -widthFromOpts :: CliOpts -> Int -widthFromOpts CliOpts{width_=Nothing, available_width_=w} = w -widthFromOpts CliOpts{width_=Just s} = - case runParser (read `fmap` many1 digit <* eof) () "(unknown)" s of - Left e -> optserror $ "could not parse width option: "++show e - Right w -> w - --- for register: - --- | Get the width in characters to use for the register command's console output, --- and also the description column width if specified (following the main width, comma-separated). --- The widths will be as follows: --- @ --- no --width flag - overall width is the available width (COLUMNS, or posix terminal width, or 80); description width is unspecified (auto) --- --width W - overall width is W, description width is auto --- --width W,D - overall width is W, description width is D --- @ --- Will raise a parse error for a malformed --width argument. -registerWidthsFromOpts :: CliOpts -> (Int, Maybe Int) -registerWidthsFromOpts CliOpts{width_=Nothing, available_width_=w} = (w, Nothing) -registerWidthsFromOpts CliOpts{width_=Just s} = - case runParser registerwidthp () "(unknown)" s of - Left e -> optserror $ "could not parse width option: "++show e - Right ws -> ws - where - registerwidthp :: Stream [Char] m t => ParsecT [Char] st m (Int, Maybe Int) - registerwidthp = do - totalwidth <- read `fmap` many1 digit - descwidth <- optionMaybe (char ',' >> read `fmap` many1 digit) - eof - return (totalwidth, descwidth) - --- | Drop leading components of accounts names as specified by --drop, but only in --flat mode. -maybeAccountNameDrop :: ReportOpts -> AccountName -> AccountName -maybeAccountNameDrop opts a | tree_ opts = a - | otherwise = accountNameDrop (drop_ opts) a - --- for balance, currently: - --- | Parse the format option if provided, possibly returning an error, --- otherwise get the default value. -lineFormatFromOpts :: ReportOpts -> Either String [OutputFormat] -lineFormatFromOpts = maybe (Right defaultBalanceLineFormat) parseStringFormat . format_ - --- | Default line format for balance report: "%20(total) %2(depth_spacer)%-(account)" -defaultBalanceLineFormat :: [OutputFormat] -defaultBalanceLineFormat = [ - FormatField False (Just 20) Nothing TotalField - , FormatLiteral " " - , FormatField True (Just 2) Nothing DepthSpacerField - , FormatField True Nothing Nothing AccountField - ] - --- Other utils - --- | Get the sorted unique precise names and display names of hledger --- add-ons found in the current user's PATH. The precise names are the --- add-on's filename with the "hledger-" prefix removed. The display --- names have the file extension removed also, except when it's needed --- for disambiguation. --- --- -- Also when there are exactly two similar names, one with the .hs or --- -- .lhs extension and the other with the .exe extension or no --- -- extension - presumably source and compiled versions of a haskell --- -- script - we exclude the source version. --- --- This function can return add-on names which shadow built-in command --- names, but hledger will ignore these. --- -hledgerAddons :: IO ([String],[String]) -hledgerAddons = do - exes <- hledgerExecutablesInPath - let precisenames = -- concatMap dropRedundant $ - -- groupBy (\a b -> dropExtension a == dropExtension b) $ - map stripprefix exes - let displaynames = concatMap stripext $ - groupBy (\a b -> dropExtension a == dropExtension b) precisenames - return (precisenames, displaynames) - where - stripprefix = drop (length progname + 1) - -- dropRedundant [f,f2] | takeExtension f `elem` ["",".exe"] && takeExtension f2 `elem` [".hs",".lhs"] = [f] - -- dropRedundant fs = fs - stripext [f] = [dropExtension f] - stripext fs = fs - --- | Get the sorted unique filenames of all hledger-* executables in --- the current user's PATH. Currently these are: files in any of the --- PATH directories, named hledger-*, with either no extension (and no --- periods in the name) or one of the addonExtensions. Limitations: --- we do not currently check that the file is really a file (not eg a --- directory) or whether it has execute permission. -hledgerExecutablesInPath :: IO [String] -hledgerExecutablesInPath = do - pathdirs <- splitOneOf "[:;]" `fmap` getEnvSafe "PATH" - pathfiles <- concat `fmap` mapM getDirectoryContentsSafe pathdirs - return $ nub $ sort $ filter isHledgerExeName pathfiles - -- XXX should exclude directories and files without execute permission. - -- These will do a stat for each hledger-*, probably ok. - -- But they need paths, not just filenames - -- hledgerexes <- filterM doesFileExist hledgernamed - -- hledgerexes' <- filterM isExecutable hledgerexes - -- return hledgerexes - --- isExecutable f = getPermissions f >>= (return . executable) - -isHledgerExeName :: String -> Bool -isHledgerExeName = isRight . parsewith hledgerexenamep - where - hledgerexenamep = do - _ <- string progname - _ <- char '-' - _ <- many1 (noneOf ".") - optional (string "." >> choice' (map string addonExtensions)) - eof - -stripAddonExtension :: String -> String -stripAddonExtension = regexReplace re "" where re = "\\.(" ++ intercalate "|" addonExtensions ++ ")$" - -addonExtensions :: [String] -addonExtensions = - ["bat" - ,"com" - ,"exe" - ,"hs" - ,"lhs" - ,"pl" - ,"py" - ,"rb" - ,"rkt" - ,"sh" - -- ,"" - ] - -getEnvSafe :: String -> IO String -getEnvSafe v = getEnv v `C.catch` (\(_::C.IOException) -> return "") -- XXX should catch only isDoesNotExistError e - -getDirectoryContentsSafe :: FilePath -> IO [String] -getDirectoryContentsSafe d = - (filter (not . (`elem` [".",".."])) `fmap` getDirectoryContents d) `C.catch` (\(_::C.IOException) -> return []) - --- not used: --- -- | Print debug info about arguments and options if --debug is present. --- debugArgs :: [String] -> CliOpts -> IO () --- debugArgs args opts = --- when ("--debug" `elem` args) $ do --- progname <- getProgName --- putStrLn $ "running: " ++ progname --- putStrLn $ "raw args: " ++ show args --- putStrLn $ "processed opts:\n" ++ show opts --- d <- getCurrentDay --- putStrLn $ "search query: " ++ (show $ queryFromOpts d $ reportopts_ opts) - --- tests - -tests_Hledger_Cli_Options :: Test -tests_Hledger_Cli_Options = TestList - [ - ] diff --git a/Hledger/Cli/Print.hs b/Hledger/Cli/Print.hs --- a/Hledger/Cli/Print.hs +++ b/Hledger/Cli/Print.hs @@ -7,6 +7,7 @@ module Hledger.Cli.Print ( printmode ,print' + ,entriesReportAsText ,tests_Hledger_Cli_Print ) where @@ -17,14 +18,22 @@ import Text.CSV import Hledger -import Hledger.Cli.Options +import Hledger.Cli.CliOptions import Hledger.Cli.Utils +import Hledger.Cli.Add ( transactionsSimilarTo ) printmode = (defCommandMode $ ["print"] ++ aliases) { modeHelp = "show transaction entries" `withAliases` aliases ,modeGroupFlags = Group { - groupUnnamed = outputflags + groupUnnamed = [ + let matcharg = "STR" + in + flagReq ["match","m"] (\s opts -> Right $ setopt "match" s opts) matcharg + ("show the transaction whose description is most similar to "++matcharg + ++ ", and is most recent") + ] + ++ outputflags ,groupHidden = [] ,groupNamed = [generalflagsgroup1] } @@ -33,7 +42,13 @@ -- | Print journal transactions in standard format. print' :: CliOpts -> Journal -> IO () -print' opts@CliOpts{reportopts_=ropts} j = do +print' opts j = do + case maybestringopt "match" $ rawopts_ opts of + Nothing -> printEntries opts j + Just desc -> printMatch opts j desc + +printEntries :: CliOpts -> Journal -> IO () +printEntries opts@CliOpts{reportopts_=ropts} j = do d <- getCurrentDay let q = queryFromOpts d ropts fmt = outputFormatFromOpts opts @@ -119,6 +134,29 @@ status = show $ pstatus p account = showAccountName Nothing (ptype p) (paccount p) comment = chomp $ strip $ pcomment p + +-- --match + +-- | Print the transaction most closely and recently matching a description +-- (and the query, if any). +printMatch :: CliOpts -> Journal -> String -> IO () +printMatch CliOpts{reportopts_=ropts} j desc = do + d <- getCurrentDay + let q = queryFromOpts d ropts + case similarTransaction' j q desc of + Nothing -> putStrLn "no matches found." + Just t -> putStr $ showTransactionUnelided t + + where + -- Identify the closest recent match for this description in past transactions. + similarTransaction' :: Journal -> Query -> String -> Maybe Transaction + similarTransaction' j q desc + | null historymatches = Nothing + | otherwise = Just $ snd $ head historymatches + where + historymatches = transactionsSimilarTo j q desc + +-- tests tests_Hledger_Cli_Print = TestList [] -- tests_showTransactions diff --git a/Hledger/Cli/Register.hs b/Hledger/Cli/Register.hs --- a/Hledger/Cli/Register.hs +++ b/Hledger/Cli/Register.hs @@ -9,6 +9,7 @@ registermode ,register ,postingsReportAsText + ,postingsReportItemAsText -- ,showPostingWithBalanceForVty ,tests_Hledger_Cli_Register ) where @@ -18,10 +19,9 @@ import System.Console.CmdArgs.Explicit import Text.CSV import Test.HUnit -import Text.Printf import Hledger -import Hledger.Cli.Options +import Hledger.Cli.CliOptions import Hledger.Cli.Utils @@ -81,7 +81,12 @@ -- | Render a register report as plain text suitable for console output. postingsReportAsText :: CliOpts -> PostingsReport -> String -postingsReportAsText opts = unlines . map (postingsReportItemAsText opts) . snd +postingsReportAsText opts (_,items) = unlines $ map (postingsReportItemAsText opts amtwidth balwidth) items + where + amtwidth = maximum $ 12 : map (strWidth . showMixedAmount . itemamt) items + balwidth = maximum $ 12 : map (strWidth . showMixedAmount . itembal) items + itemamt (_,_,_,Posting{pamount=a},_) = a + itembal (_,_,_,_,a) = a tests_postingsReportAsText = [ "postingsReportAsText" ~: do @@ -112,24 +117,52 @@ -- -- date and description are shown for the first posting of a transaction only. -- -postingsReportItemAsText :: CliOpts -> PostingsReportItem -> String -postingsReportItemAsText opts (mdate, menddate, mdesc, p, b) = +-- Returns a string which can be multi-line, eg if the running balance +-- has multiple commodities. Does not yet support formatting control +-- like balance reports. +-- +postingsReportItemAsText :: CliOpts -> Int -> Int -> PostingsReportItem -> String +postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, menddate, mdesc, p, b) = + -- use elide*Width to be wide-char-aware + -- trace (show (totalwidth, datewidth, descwidth, acctwidth, amtwidth, balwidth)) $ intercalate "\n" $ - [printf ("%-"++datew++"s %-"++descw++"s %-"++acctw++"s %"++amtw++"s %"++balw++"s") - date desc acct amtfirstline balfirstline] + [concat [fitString (Just datewidth) (Just datewidth) True True date + ," " + ,fitString (Just descwidth) (Just descwidth) True True desc + ," " + ,fitString (Just acctwidth) (Just acctwidth) True True acct + ," " + ,fitString (Just amtwidth) (Just amtwidth) True False amtfirstline + ," " + ,fitString (Just balwidth) (Just balwidth) True False balfirstline + ]] ++ - [printf (spacer ++ "%"++amtw++"s %"++balw++"s") a b | (a,b) <- zip amtrest balrest ] - + [concat [spacer + ,fitString (Just amtwidth) (Just amtwidth) True False a + ," " + ,fitString (Just balwidth) (Just balwidth) True False b + ] + | (a,b) <- zip amtrest balrest + ] where -- calculate widths (totalwidth,mdescwidth) = registerWidthsFromOpts opts - amtwidth = 12 - balwidth = 12 (datewidth, date) = case (mdate,menddate) of (Just _, Just _) -> (21, showDateSpan (DateSpan mdate menddate)) (Nothing, Just _) -> (21, "") (Just d, Nothing) -> (10, showDate d) _ -> (10, "") + (amtwidth, balwidth) + | shortfall <= 0 = (preferredamtwidth, preferredbalwidth) + | otherwise = (adjustedamtwidth, adjustedbalwidth) + where + mincolwidth = 2 -- columns always show at least an ellipsis + maxamtswidth = max 0 (totalwidth - (datewidth + 1 + mincolwidth + 2 + mincolwidth + 2 + 2)) + shortfall = (preferredamtwidth + preferredbalwidth) - maxamtswidth + amtwidthproportion = fromIntegral preferredamtwidth / fromIntegral (preferredamtwidth + preferredbalwidth) + adjustedamtwidth = round $ amtwidthproportion * fromIntegral maxamtswidth + adjustedbalwidth = maxamtswidth - adjustedamtwidth + remaining = totalwidth - (datewidth + 1 + 2 + amtwidth + 2 + balwidth) (descwidth, acctwidth) | hasinterval = (0, remaining - 2) @@ -137,16 +170,16 @@ where hasinterval = isJust menddate w = fromMaybe ((remaining - 2) `div` 2) mdescwidth - [datew,descw,acctw,amtw,balw] = map show [datewidth,descwidth,acctwidth,amtwidth,balwidth] -- gather content - desc = maybe "" (take descwidth . elideRight descwidth) mdesc + desc = fromMaybe "" mdesc acct = parenthesise $ elideAccountName awidth $ paccount p where - (parenthesise, awidth) = case ptype p of - BalancedVirtualPosting -> (\s -> "["++s++"]", acctwidth-2) - VirtualPosting -> (\s -> "("++s++")", acctwidth-2) - _ -> (id,acctwidth) + (parenthesise, awidth) = + case ptype p of + BalancedVirtualPosting -> (\s -> "["++s++"]", acctwidth-2) + VirtualPosting -> (\s -> "("++s++")", acctwidth-2) + _ -> (id,acctwidth) amt = showMixedAmountWithoutPrice $ pamount p bal = showMixedAmountWithoutPrice b -- alternate behaviour, show null amounts as 0 instead of blank @@ -158,9 +191,6 @@ (amtfirstline:amtrest) = take numlines $ amtlines ++ repeat "" -- posting amount is top-aligned (balfirstline:balrest) = take numlines $ replicate (numlines - ballen) "" ++ ballines -- balance amount is bottom-aligned spacer = replicate (totalwidth - (amtwidth + 2 + balwidth)) ' ' - --- XXX --- showPostingWithBalanceForVty showtxninfo p b = postingsReportItemAsText defreportopts $ mkpostingsReportItem showtxninfo p b tests_Hledger_Cli_Register :: Test tests_Hledger_Cli_Register = TestList diff --git a/Hledger/Cli/Stats.hs b/Hledger/Cli/Stats.hs --- a/Hledger/Cli/Stats.hs +++ b/Hledger/Cli/Stats.hs @@ -21,7 +21,7 @@ import qualified Data.Map as Map import Hledger -import Hledger.Cli.Options +import Hledger.Cli.CliOptions import Prelude hiding (putStr) import Hledger.Cli.Utils (writeOutput) diff --git a/Hledger/Cli/Utils.hs b/Hledger/Cli/Utils.hs --- a/Hledger/Cli/Utils.hs +++ b/Hledger/Cli/Utils.hs @@ -53,7 +53,7 @@ import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) #endif -import Hledger.Cli.Options +import Hledger.Cli.CliOptions import Hledger.Data import Hledger.Read import Hledger.Utils diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,40 @@ +# hledger + +## lightweight, portable, dependable accounting tools + +hledger is a computer program for easily tracking money, time, or other commodities, +on unix, mac and windows (and web-capable mobile devices, to some extent). + +It is first a command-line tool, but there are also curses-style and +web interfaces, and a Haskell library +(http://hackage.haskell.org/package/hledger-lib) for building your own +programs and scripts (hledger is written in Haskell). hledger was +inspired by and is largely compatible with Ledger. hledger is free +software available under the GNU General Public License v3+. + +hledger aims to help both computer experts and regular folks +to gain clarity and control in their finances and time management, +but currently it is a bit more suited to techies. +I use it every day to: + +- track spending and income +- see time reports by day/week/month/project +- get accurate numbers for client billing and tax filing +- track invoices + +Though limited in features, hledger is lightweight, usable and reliable. +For some, it is a simpler, less distracting, more future-proof alternative to Quicken or GnuCash. + +For more, see http://hledger.org. + +[![license](https://img.shields.io/badge/license-GPLv3+-brightgreen.svg)](http://www.gnu.org/licenses/gpl.html) +[![hackage release](https://img.shields.io/hackage/v/hledger.svg?label=current+release)](http://hackage.haskell.org/package/hledger) + + + + +[![travis build status](https://img.shields.io/travis/simonmichael/hledger.svg)](https://travis-ci.org/simonmichael/hledger) +[![hackage upper bounds](https://img.shields.io/hackage-deps/v/hledger.svg?label=hackage+bounds)](http://packdeps.haskellers.com/feed?needle=hledger) +[![github issues](https://img.shields.io/github/issues/simonmichael/hledger.svg)](http://bugs.hledger.org) +[![bountysource](https://api.bountysource.com/badge/team?team_id=75979&style=bounties_received)](https://github.com/simonmichael/hledger/issues?q=label:bounty) + diff --git a/Text/Tabular/AsciiWide.hs b/Text/Tabular/AsciiWide.hs new file mode 100644 --- /dev/null +++ b/Text/Tabular/AsciiWide.hs @@ -0,0 +1,75 @@ +-- | Text.Tabular.AsciiArt from tabular-0.2.2.7, modified to treat +-- wide characters as double width. + +module Text.Tabular.AsciiWide where + +import Data.List (intersperse, transpose) +import Text.Tabular +import Hledger.Utils.String + +-- | for simplicity, we assume that each cell is rendered +-- on a single line +render :: (rh -> String) + -> (ch -> String) + -> (a -> String) + -> Table rh ch a + -> String +render fr fc f (Table rh ch cells) = + unlines $ [ bar SingleLine -- +--------------------------------------+ + , renderColumns sizes ch2 + , bar DoubleLine -- +======================================+ + ] ++ + (renderRs $ fmap renderR $ zipHeader [] cells $ fmap fr rh) ++ + [ bar SingleLine ] -- +--------------------------------------+ + where + bar = concat . renderHLine sizes ch2 + -- ch2 and cell2 include the row and column labels + ch2 = Group DoubleLine [Header "", fmap fc ch] + cells2 = headerContents ch2 + : zipWith (\h cs -> h : map f cs) rhStrings cells + -- + renderR (cs,h) = renderColumns sizes $ Group DoubleLine + [ Header h + , fmap fst $ zipHeader "" (map f cs) ch] + rhStrings = map fr $ headerContents rh + -- maximum width for each column + sizes = map (maximum . map strWidth) . transpose $ cells2 + renderRs (Header s) = [s] + renderRs (Group p hs) = concat . intersperse sep . map renderRs $ hs + where sep = renderHLine sizes ch2 p + +-- | We stop rendering on the shortest list! +renderColumns :: [Int] -- ^ max width for each column + -> Header String + -> String +renderColumns is h = "| " ++ coreLine ++ " |" + where + coreLine = concatMap helper $ flattenHeader $ zipHeader 0 is h + helper = either hsep (uncurry padLeftWide) + hsep :: Properties -> String + hsep NoLine = " " + hsep SingleLine = " | " + hsep DoubleLine = " || " + +renderHLine :: [Int] -- ^ width specifications + -> Header String + -> Properties + -> [String] +renderHLine _ _ NoLine = [] +renderHLine w h SingleLine = [renderHLine' w '-' h] +renderHLine w h DoubleLine = [renderHLine' w '=' h] + +renderHLine' :: [Int] -> Char -> Header String -> String +renderHLine' is sep h = [ '+', sep ] ++ coreLine ++ [sep, '+'] + where + coreLine = concatMap helper $ flattenHeader $ zipHeader 0 is h + helper = either vsep dashes + dashes (i,_) = replicate i sep + vsep NoLine = [sep] + vsep SingleLine = sep : "+" ++ [sep] + vsep DoubleLine = sep : "++" ++ [sep] + +-- padLeft :: Int -> String -> String +-- padLeft l s = padding ++ s +-- where padding = replicate (l - length s) ' ' + diff --git a/bench/SimpleBench.hs b/bench/SimpleBench.hs new file mode 100644 --- /dev/null +++ b/bench/SimpleBench.hs @@ -0,0 +1,178 @@ +-- a quick librarification of tools/simplebench.hs for cabal benchmarking + +-- #!/usr/bin/env runhaskell +{- +bench.hs - simple benchmarking of command-line programs. +Requires html and tabular. +Simon Michael 2008-2015 + +Example: + +$ simplebench.hs --help +... +$ cat - >bench.tests +-f sample.ledger -s balance +-f ~/.ledger -s balance +$ simplebench.hs -v hledger "ledger --no-cache" ledger +Using bench.tests +Running 2 tests 2 times in . with 3 executables at 2008-11-26 18:52:15.776357 UTC: +1: hledger -f sample.ledger -s balance [0.02s] +2: hledger -f sample.ledger -s balance [0.01s] +1: ledger --no-cache -f sample.ledger -s balance [0.02s] +2: ledger --no-cache -f sample.ledger -s balance [0.02s] +1: ledger -f sample.ledger -s balance [0.02s] +2: ledger -f sample.ledger -s balance [0.02s] +1: hledger -f ~/.ledger -s balance [3.56s] +2: hledger -f ~/.ledger -s balance [3.56s] +1: ledger --no-cache -f ~/.ledger -s balance [0.10s] +2: ledger --no-cache -f ~/.ledger -s balance [0.10s] +1: ledger -f ~/.ledger -s balance [0.10s] +2: ledger -f ~/.ledger -s balance [0.10s] + +Summary (best iteration): + + || hledger | ledger --no-cache | ledger +============================++=========+===================+======= +-f sample.ledger -s balance || 0.01 | 0.02 | 0.02 + -f ~/.ledger -s balance || 3.56 | 0.10 | 0.10 + +-} + +module SimpleBench +where + +import Data.List +import System.Environment +-- import System.FilePath +import System.Process +import System.IO +import Text.Tabular +import qualified Text.Tabular.AsciiArt as TA +-- import qualified Text.Tabular.Html as TH +-- import Text.Html ((+++), renderHtml, stringToHtml) +import System.Exit +import Text.Printf +import Data.Time.Clock +import Data.Time.Format () +import Control.Monad +import System.Console.GetOpt + +usagehdr = "bench [-f testsfile] [-n iterations] [-p precision] executable1 [executable2 ...]\n" ++ + "\n" ++ + "Run some functional tests with each of the specified executables,\n" ++ + "where a test is \"zero or more arguments supported by all executables\",\n" ++ + "and report the best execution times.\n" + +options = [ + Option "f" ["testsfile"] (ReqArg File "testsfile") "file containing tests, one per line, default: bench.tests" + ,Option "n" ["iterations"] (ReqArg Num "iterations") "number of test iterations to run, default: 1" + ,Option "p" ["precision"] (ReqArg Prec "precision") "show times with this precision, default: 2" + ,Option "v" ["verbose"] (NoArg Verbose) "show intermediate results" + ,Option "h" ["help"] (NoArg Help) "show this help" + ] + +usageftr = "\n" ++ + "Tips:\n" ++ + "- executables may have arguments if enclosed in quotes\n" ++ + "- tests can be commented out with #\n" ++ + "- results are saved in benchresults.{html,txt}\n" + +usage = usageInfo usagehdr options ++ usageftr + +-- an option value +data Opt = File {value::String} + | Num {value::String} + | Prec {value::String} +-- I don't know how optValuesForConstructor etc. can have that +-- type signature with these, but it works.. +-- | Some Int + | Verbose + | Help + deriving (Eq,Show) + +-- option value getters. +fileopt :: [Opt] -> String +fileopt = optValueWithDefault File "bench.tests" + +precisionopt :: [Opt] -> Int +precisionopt = read . optValueWithDefault Prec "2" + +numopt :: [Opt] -> Int +numopt = read . optValueWithDefault Num "1" + +verboseopt :: [Opt] -> Bool +verboseopt = (Verbose `elem`) + +-- options utilities +parseargs :: [String] -> ([Opt],[String]) +parseargs as = + case (getOpt Permute options as) of + (opts,args,[]) -> (opts,args) + (_,_,errs) -> error (concat errs ++ usage) + +optValueWithDefault :: (String -> Opt) -> String -> [Opt] -> String +optValueWithDefault optcons def opts = + last $ def : optValuesForConstructor optcons opts + +optValuesForConstructor :: (String -> Opt) -> [Opt] -> [String] +optValuesForConstructor optcons opts = concatMap get opts + where get o = [v | optcons v == o] where v = value o + +defaultMain = do + args <- getArgs + let (opts,exes) = parseargs args + when (null exes) $ error $ "at least one executable needed\n" ++ usage + let (file, num) = (fileopt opts, numopt opts) + tests <- liftM (filter istest . lines) (readFile file) + now <- getCurrentTime + putStrLn $ printf "Using %s" file + putStrLn $ printf "Running %d tests %d times with %d executables at %s:" + (length tests) num (length exes) (show now) + let doexe t e = mapM (doiteration opts t e) [1..num] + let dotest t = mapM (doexe t) exes + hSetBuffering stdout NoBuffering + results <- mapM dotest tests + summarise opts tests exes results + +istest s = not (null s' || ("#" `isPrefixOf` s')) where s' = clean s +clean = unwords . words + +doiteration :: [Opt] -> String -> String -> Int -> IO Float +doiteration opts test exe iteration = do + let cmd = unwords [exe,clean test] + when (verboseopt opts) $ putStr $ show iteration ++ ": " ++ cmd + hFlush stdout + t <- time cmd + when (verboseopt opts) $ printf "\t[%ss]\n" (showtime opts t) + return t + +time :: String -> IO Float +time cmd = do + t1 <- getCurrentTime + ret <- system $ cmd ++ " >/dev/null 2>&1" + case ret of + ExitSuccess -> return () + ExitFailure f -> putStr $ printf " (error %d)" f + t2 <- getCurrentTime + return $ realToFrac $ diffUTCTime t2 t1 + +summarise :: [Opt] -> [String] -> [String] -> [[[Float]]] -> IO () +summarise opts tests exes results = do + putStrLn "\nSummary (best iteration):\n" + let t = maketable opts tests exes results + putStrLn $ TA.render id id id t + -- let outname = "benchresults" + -- writeFile (outname <.> "txt") $ TA.render id id id t + -- writeFile (outname <.> "html") $ renderHtml $ TH.css TH.defaultCss +++ TH.render stringToHtml stringToHtml stringToHtml t + +maketable :: [Opt] -> [String] -> [String] -> [[[Float]]] -> Table String String String +maketable opts rownames colnames results = Table rowhdrs colhdrs rows + where + rowhdrs = Group NoLine $ map Header $ padright rownames + colhdrs = Group SingleLine $ map Header colnames + rows = map (map (showtime opts . minimum)) results + padright ss = map (printf (printf "%%-%ds" w)) ss + where w = maximum $ map length ss + +showtime :: [Opt] -> (Float -> String) +showtime opts = printf $ "%." ++ show (precisionopt opts) ++ "f" diff --git a/hledger.cabal b/hledger.cabal --- a/hledger.cabal +++ b/hledger.cabal @@ -1,99 +1,86 @@ +-- This file has been generated from package.yaml by hpack version 0.5.4. +-- +-- see: https://github.com/sol/hpack + name: hledger -version: 0.26 +version: 0.27 stability: stable category: Finance, Console -synopsis: The main command-line interface for the hledger accounting tool. +synopsis: Command-line interface for the hledger accounting tool description: - hledger is a library and set of user tools for working - with financial data (or anything that can be tracked in a - double-entry accounting ledger.) It is a haskell port and - friendly fork of John Wiegley's Ledger. hledger provides - command-line, curses and web interfaces, and aims to be a - reliable, practical tool for daily use. - + This is hledger’s command-line interface. + Its basic function is to read a plain text file describing + financial transactions and produce useful reports. + hledger is a cross-platform program for tracking money, time, or + any other commodity, using double-entry accounting and a simple, + editable file format. It is inspired by and largely compatible + with ledger(1). hledger provides command-line, curses and web + interfaces, and aims to be a reliable, practical tool for daily + use. license: GPL license-file: LICENSE author: Simon Michael maintainer: Simon Michael homepage: http://hledger.org -bug-reports: http://hledger.org/bugs -tested-with: GHC==7.8.4, GHC==7.10.1 +bug-reports: http://bugs.hledger.org cabal-version: >= 1.10 build-type: Simple --- data-dir: data --- data-files: -extra-tmp-files: -extra-source-files: - test/test.hs - CHANGES +tested-with: GHC==7.4.2, GHC==7.6.3, GHC==7.8.4, GHC==7.10.2 +extra-source-files: + CHANGES + README.md + test/test.hs + source-repository head - type: git + type: git location: https://github.com/simonmichael/hledger flag threaded - Description: Build with support for multithreaded execution - Default: True + default: True + description: + Build with support for multithreaded execution flag curses - Description: On POSIX systems, enable curses support for auto-detecting terminal width. - Default: True + default: True + description: + On POSIX systems, enable curses support for auto-detecting terminal width. flag old-locale - description: A compatibility flag, set automatically by cabal. - If false then depend on time >= 1.5, - if true then depend on time < 1.5 together with old-locale. default: False - + description: + A compatibility flag, set automatically by cabal. + If false then depend on time >= 1.5, + if true then depend on time < 1.5 together with old-locale. library - cpp-options: -DVERSION="0.26" - ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures - ghc-options: -fno-warn-type-defaults -fno-warn-orphans - default-language: Haskell2010 - exposed-modules: - Hledger.Cli - Hledger.Cli.Main - Hledger.Cli.Options - Hledger.Cli.Tests - Hledger.Cli.Utils - Hledger.Cli.Version - Hledger.Cli.Add - Hledger.Cli.Accounts - Hledger.Cli.Balance - Hledger.Cli.Balancesheet - Hledger.Cli.Cashflow - Hledger.Cli.Histogram - Hledger.Cli.Incomestatement - Hledger.Cli.Print - Hledger.Cli.Register - Hledger.Cli.Stats + ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans + cpp-options: -DVERSION="0.27" build-depends: - hledger-lib == 0.26 - ,base >= 4.3 && < 5 - ,base-compat >= 0.8.1 - -- ,cabal-file-th - ,containers - ,unordered-containers - ,cmdargs >= 0.10 && < 0.11 - ,csv - -- ,data-pprint >= 0.2.1 && < 0.3 - ,directory - ,filepath - ,haskeline >= 0.6 && <= 0.8 - ,HUnit - ,mtl - ,mtl-compat - ,old-time - ,parsec >= 3 - ,process - ,regex-tdfa - ,safe >= 0.2 - ,split >= 0.1 && < 0.3 - ,text >= 0.11 - ,tabular >= 0.2 && < 0.3 - ,utf8-string >= 0.3.5 && < 1.1 - ,wizards == 1.0.* + hledger-lib == 0.27 + , base >= 4.3 && < 5 + , base-compat >= 0.8.1 + , containers + , unordered-containers + , cmdargs >= 0.10 && < 0.11 + , csv + , directory + , filepath + , haskeline >= 0.6 && <= 0.8 + , HUnit + , mtl + , mtl-compat + , old-time + , parsec >= 3 + , process + , regex-tdfa + , safe >= 0.2 + , split >= 0.1 && < 0.3 + , text >= 0.11 + , tabular >= 0.2 && < 0.3 + , utf8-string >= 0.3.5 && < 1.1 + , wizards == 1.0.* + if impl(ghc >= 7.10) -- ghc 7.10 requires shakespeare 2.0.2.2+ build-depends: shakespeare >= 2.0.2.2 && < 2.1 @@ -103,120 +90,152 @@ build-depends: shakespeare >= 1.0 && < 2.1 ,shakespeare-text >= 1.0 && < 1.2 + if flag(old-locale) build-depends: time < 1.5, old-locale else build-depends: time >= 1.5 + if impl(ghc >= 7.4) build-depends: pretty-show >= 1.6.4 + if !os(windows) && flag(curses) build-depends: terminfo + exposed-modules: + Hledger.Cli + Hledger.Cli.Main + Hledger.Cli.CliOptions + Hledger.Cli.Tests + Hledger.Cli.Utils + Hledger.Cli.Version + Hledger.Cli.Add + Hledger.Cli.Accounts + Hledger.Cli.Balance + Hledger.Cli.Balancesheet + Hledger.Cli.Cashflow + Hledger.Cli.Histogram + Hledger.Cli.Incomestatement + Hledger.Cli.Print + Hledger.Cli.Register + Hledger.Cli.Stats + Text.Tabular.AsciiWide + default-language: Haskell2010 executable hledger - main-is: hledger-cli.hs - hs-source-dirs: app - default-language: Haskell2010 - cpp-options: -DVERSION="0.26" - ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures - ghc-options: -fno-warn-type-defaults -fno-warn-orphans + main-is: hledger-cli.hs + hs-source-dirs: + app + ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans if flag(threaded) - ghc-options: -threaded - -- same as above: + ghc-options: -threaded + cpp-options: -DVERSION="0.27" build-depends: - hledger-lib == 0.26 - ,hledger == 0.26 - ,base >= 4.3 && < 5 - ,base-compat >= 0.8.1 - ,containers - ,unordered-containers - ,cmdargs >= 0.10 && < 0.11 - ,csv - -- ,data-pprint >= 0.2.1 && < 0.3 - ,directory - ,filepath - ,haskeline >= 0.6 && <= 0.8 - ,HUnit - ,mtl - ,mtl-compat - ,old-time - ,parsec >= 3 - ,process - ,regex-tdfa - ,safe >= 0.2 - ,split >= 0.1 && < 0.3 - ,tabular >= 0.2 && < 0.3 - ,text >= 0.11 - ,utf8-string >= 0.3.5 && < 1.1 - ,wizards == 1.0.* - -- as above + hledger-lib == 0.27 + , base >= 4.3 && < 5 + , base-compat >= 0.8.1 + , containers + , unordered-containers + , cmdargs >= 0.10 && < 0.11 + , csv + , directory + , filepath + , haskeline >= 0.6 && <= 0.8 + , HUnit + , mtl + , mtl-compat + , old-time + , parsec >= 3 + , process + , regex-tdfa + , safe >= 0.2 + , split >= 0.1 && < 0.3 + , text >= 0.11 + , tabular >= 0.2 && < 0.3 + , utf8-string >= 0.3.5 && < 1.1 + , wizards == 1.0.* + , hledger == 0.27 + if impl(ghc >= 7.10) build-depends: shakespeare >= 2.0.2.2 && < 2.1 else build-depends: shakespeare >= 1.0 && < 2.1 ,shakespeare-text >= 1.0 && < 1.2 + if flag(old-locale) build-depends: time < 1.5, old-locale else build-depends: time >= 1.5 + if impl(ghc >= 7.4) build-depends: pretty-show >= 1.6.4 + if !os(windows) && flag(curses) + build-depends: terminfo -test-suite test - type: exitcode-stdio-1.0 - main-is: test.hs - hs-source-dirs: test default-language: Haskell2010 - ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures - ghc-options: -fno-warn-type-defaults -fno-warn-orphans - -- same as above: - build-depends: hledger-lib - , hledger - , base >= 4.3 && < 5 - , base-compat >= 0.8.1 - , cmdargs - , containers - , csv - -- , data-pprint >= 0.2.1 && < 0.3 - , directory - , filepath - , haskeline - , HUnit - , mtl - , mtl-compat - , old-time - , parsec >= 3 - , process - , regex-tdfa - , safe - , split - ,tabular >= 0.2 && < 0.3 - , test-framework - , test-framework-hunit - , text - , transformers - , wizards == 1.0.* - -- as above + +test-suite test + type: exitcode-stdio-1.0 + main-is: test.hs + hs-source-dirs: + test + ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans + cpp-options: -DVERSION="0.27" + build-depends: + hledger-lib == 0.27 + , base >= 4.3 && < 5 + , base-compat >= 0.8.1 + , containers + , unordered-containers + , cmdargs >= 0.10 && < 0.11 + , csv + , directory + , filepath + , haskeline >= 0.6 && <= 0.8 + , HUnit + , mtl + , mtl-compat + , old-time + , parsec >= 3 + , process + , regex-tdfa + , safe >= 0.2 + , split >= 0.1 && < 0.3 + , text >= 0.11 + , tabular >= 0.2 && < 0.3 + , utf8-string >= 0.3.5 && < 1.1 + , wizards == 1.0.* + , hledger + , test-framework + , test-framework-hunit + if impl(ghc >= 7.10) build-depends: shakespeare >= 2.0.2.2 && < 2.1 else build-depends: shakespeare >= 1.0 && < 2.1 ,shakespeare-text >= 1.0 && < 1.2 + if impl(ghc >= 7.4) build-depends: pretty-show >= 1.6.4 + if flag(old-locale) build-depends: time < 1.5, old-locale else build-depends: time >= 1.5 + if !os(windows) && flag(curses) + build-depends: terminfo + default-language: Haskell2010 + benchmark bench type: exitcode-stdio-1.0 hs-source-dirs: bench main-is: bench.hs + other-modules: SimpleBench ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures ghc-options: -fno-warn-type-defaults -fno-warn-orphans default-language: Haskell2010 @@ -231,6 +250,7 @@ process, filepath, directory + if flag(old-locale) build-depends: time < 1.5, old-locale else