packages feed

hledger 0.26 → 0.27

raw patch · 20 files changed

+1357/−828 lines, 20 filesdep −transformersdep ~cmdargsdep ~haskelinedep ~hledgerPVP ok

version bump matches the API change (PVP)

Dependencies removed: transformers

Dependency ranges changed: cmdargs, haskeline, hledger, hledger-lib, regex-tdfa, safe, split, text

API changes (from Hackage documentation)

- Hledger.Cli.Add: esArgs :: EntryState -> [String]
- Hledger.Cli.Add: esDefDate :: EntryState -> Day
- Hledger.Cli.Add: esJournal :: EntryState -> Journal
- Hledger.Cli.Add: esOpts :: EntryState -> CliOpts
- Hledger.Cli.Add: esPostings :: EntryState -> [Posting]
- Hledger.Cli.Add: esSimilarTransaction :: EntryState -> Maybe Transaction
- Hledger.Cli.Add: esToday :: EntryState -> Day
- Hledger.Cli.Add: instance Exception RestartTransactionException
- Hledger.Cli.Add: instance Show EntryState
- Hledger.Cli.Add: instance Show RestartTransactionException
- Hledger.Cli.Add: instance Typeable EntryState
- Hledger.Cli.Add: instance Typeable RestartTransactionException
- Hledger.Cli.Options: CliOpts :: RawOpts -> String -> [FilePath] -> Maybe FilePath -> Maybe FilePath -> Maybe String -> [String] -> Bool -> Int -> Bool -> Maybe String -> Int -> ReportOpts -> CliOpts
- Hledger.Cli.Options: alias_ :: CliOpts -> [String]
- Hledger.Cli.Options: aliasesFromOpts :: CliOpts -> [AccountAlias]
- Hledger.Cli.Options: argsFlag :: FlagHelp -> Arg RawOpts
- Hledger.Cli.Options: available_width_ :: CliOpts -> Int
- Hledger.Cli.Options: checkCliOpts :: CliOpts -> IO CliOpts
- Hledger.Cli.Options: command_ :: CliOpts -> String
- Hledger.Cli.Options: data CliOpts
- Hledger.Cli.Options: debug_ :: CliOpts -> Int
- Hledger.Cli.Options: decodeRawOpts :: RawOpts -> RawOpts
- Hledger.Cli.Options: defAddonCommandMode :: Name -> Mode RawOpts
- Hledger.Cli.Options: defCommandMode :: [Name] -> Mode RawOpts
- Hledger.Cli.Options: defMode :: Mode RawOpts
- Hledger.Cli.Options: defaultOutputFormat :: [Char]
- Hledger.Cli.Options: defaultWidth :: Int
- Hledger.Cli.Options: defcliopts :: CliOpts
- Hledger.Cli.Options: detailedversionflag :: Flag RawOpts
- Hledger.Cli.Options: file_ :: CliOpts -> [FilePath]
- Hledger.Cli.Options: generalflagsgroup1 :: (String, [Flag RawOpts])
- Hledger.Cli.Options: generalflagsgroup2 :: (String, [Flag RawOpts])
- Hledger.Cli.Options: generalflagsgroup3 :: (String, [Flag RawOpts])
- Hledger.Cli.Options: getCliOpts :: Mode RawOpts -> IO CliOpts
- Hledger.Cli.Options: helpflags :: [Flag RawOpts]
- Hledger.Cli.Options: hledgerAddons :: IO ([String], [String])
- Hledger.Cli.Options: ignore_assertions_ :: CliOpts -> Bool
- Hledger.Cli.Options: inputflags :: [Flag RawOpts]
- Hledger.Cli.Options: instance Data CliOpts
- Hledger.Cli.Options: instance Default CliOpts
- Hledger.Cli.Options: instance Show CliOpts
- Hledger.Cli.Options: instance Typeable CliOpts
- Hledger.Cli.Options: journalFilePathFromOpts :: CliOpts -> IO [String]
- Hledger.Cli.Options: lineFormatFromOpts :: ReportOpts -> Either String [OutputFormat]
- Hledger.Cli.Options: maybeAccountNameDrop :: ReportOpts -> AccountName -> AccountName
- Hledger.Cli.Options: no_new_accounts_ :: CliOpts -> Bool
- Hledger.Cli.Options: outputFileFromOpts :: CliOpts -> IO FilePath
- Hledger.Cli.Options: outputFormatFromOpts :: CliOpts -> String
- Hledger.Cli.Options: outputFormats :: [[Char]]
- Hledger.Cli.Options: output_file_ :: CliOpts -> Maybe FilePath
- Hledger.Cli.Options: output_format_ :: CliOpts -> Maybe String
- Hledger.Cli.Options: outputflags :: [Flag RawOpts]
- Hledger.Cli.Options: rawOptsToCliOpts :: RawOpts -> IO CliOpts
- Hledger.Cli.Options: rawopts_ :: CliOpts -> RawOpts
- Hledger.Cli.Options: registerWidthsFromOpts :: CliOpts -> (Int, Maybe Int)
- Hledger.Cli.Options: reportflags :: [Flag RawOpts]
- Hledger.Cli.Options: reportopts_ :: CliOpts -> ReportOpts
- Hledger.Cli.Options: rulesFilePathFromOpts :: CliOpts -> IO (Maybe FilePath)
- Hledger.Cli.Options: rules_file_ :: CliOpts -> Maybe FilePath
- Hledger.Cli.Options: showModeHelp :: Mode a -> String
- Hledger.Cli.Options: tests_Hledger_Cli_Options :: Test
- Hledger.Cli.Options: widthFromOpts :: CliOpts -> Int
- Hledger.Cli.Options: width_ :: CliOpts -> Maybe String
- Hledger.Cli.Options: withAliases :: String -> [String] -> String
+ Hledger.Cli.Add: [esArgs] :: EntryState -> [String]
+ Hledger.Cli.Add: [esDefDate] :: EntryState -> Day
+ Hledger.Cli.Add: [esJournal] :: EntryState -> Journal
+ Hledger.Cli.Add: [esOpts] :: EntryState -> CliOpts
+ Hledger.Cli.Add: [esPostings] :: EntryState -> [Posting]
+ Hledger.Cli.Add: [esSimilarTransaction] :: EntryState -> Maybe Transaction
+ Hledger.Cli.Add: [esToday] :: EntryState -> Day
+ Hledger.Cli.Add: instance GHC.Exception.Exception Hledger.Cli.Add.RestartTransactionException
+ Hledger.Cli.Add: instance GHC.Show.Show Hledger.Cli.Add.EntryState
+ Hledger.Cli.Add: instance GHC.Show.Show Hledger.Cli.Add.RestartTransactionException
+ Hledger.Cli.Balance: balanceReportItemAsText :: ReportOpts -> StringFormat -> BalanceReportItem -> [String]
+ Hledger.Cli.CliOptions: CliOpts :: RawOpts -> String -> [FilePath] -> Maybe FilePath -> Maybe FilePath -> Maybe String -> [String] -> Bool -> Int -> Bool -> Maybe String -> Int -> ReportOpts -> CliOpts
+ Hledger.Cli.CliOptions: [alias_] :: CliOpts -> [String]
+ Hledger.Cli.CliOptions: [available_width_] :: CliOpts -> Int
+ Hledger.Cli.CliOptions: [command_] :: CliOpts -> String
+ Hledger.Cli.CliOptions: [debug_] :: CliOpts -> Int
+ Hledger.Cli.CliOptions: [file_] :: CliOpts -> [FilePath]
+ Hledger.Cli.CliOptions: [ignore_assertions_] :: CliOpts -> Bool
+ Hledger.Cli.CliOptions: [no_new_accounts_] :: CliOpts -> Bool
+ Hledger.Cli.CliOptions: [output_file_] :: CliOpts -> Maybe FilePath
+ Hledger.Cli.CliOptions: [output_format_] :: CliOpts -> Maybe String
+ Hledger.Cli.CliOptions: [rawopts_] :: CliOpts -> RawOpts
+ Hledger.Cli.CliOptions: [reportopts_] :: CliOpts -> ReportOpts
+ Hledger.Cli.CliOptions: [rules_file_] :: CliOpts -> Maybe FilePath
+ Hledger.Cli.CliOptions: [width_] :: CliOpts -> Maybe String
+ Hledger.Cli.CliOptions: aliasesFromOpts :: CliOpts -> [AccountAlias]
+ Hledger.Cli.CliOptions: argsFlag :: FlagHelp -> Arg RawOpts
+ Hledger.Cli.CliOptions: checkCliOpts :: CliOpts -> CliOpts
+ Hledger.Cli.CliOptions: data CliOpts
+ Hledger.Cli.CliOptions: decodeRawOpts :: RawOpts -> RawOpts
+ Hledger.Cli.CliOptions: defAddonCommandMode :: Name -> Mode RawOpts
+ Hledger.Cli.CliOptions: defCommandMode :: [Name] -> Mode RawOpts
+ Hledger.Cli.CliOptions: defMode :: Mode RawOpts
+ Hledger.Cli.CliOptions: defaultBalanceLineFormat :: StringFormat
+ Hledger.Cli.CliOptions: defaultOutputFormat :: [Char]
+ Hledger.Cli.CliOptions: defaultWidth :: Int
+ Hledger.Cli.CliOptions: defcliopts :: CliOpts
+ Hledger.Cli.CliOptions: detailedversionflag :: Flag RawOpts
+ Hledger.Cli.CliOptions: generalflagsgroup1 :: (String, [Flag RawOpts])
+ Hledger.Cli.CliOptions: generalflagsgroup2 :: (String, [Flag RawOpts])
+ Hledger.Cli.CliOptions: generalflagsgroup3 :: (String, [Flag RawOpts])
+ Hledger.Cli.CliOptions: getCliOpts :: Mode RawOpts -> IO CliOpts
+ Hledger.Cli.CliOptions: helpflags :: [Flag RawOpts]
+ Hledger.Cli.CliOptions: hledgerAddons :: IO ([String], [String])
+ Hledger.Cli.CliOptions: inputflags :: [Flag RawOpts]
+ Hledger.Cli.CliOptions: instance Data.Data.Data Hledger.Cli.CliOptions.CliOpts
+ Hledger.Cli.CliOptions: instance GHC.Show.Show Hledger.Cli.CliOptions.CliOpts
+ Hledger.Cli.CliOptions: instance System.Console.CmdArgs.Default.Default Hledger.Cli.CliOptions.CliOpts
+ Hledger.Cli.CliOptions: journalFilePathFromOpts :: CliOpts -> IO [String]
+ Hledger.Cli.CliOptions: lineFormatFromOpts :: ReportOpts -> Either String StringFormat
+ Hledger.Cli.CliOptions: maybeAccountNameDrop :: ReportOpts -> AccountName -> AccountName
+ Hledger.Cli.CliOptions: outputFileFromOpts :: CliOpts -> IO FilePath
+ Hledger.Cli.CliOptions: outputFormatFromOpts :: CliOpts -> String
+ Hledger.Cli.CliOptions: outputFormats :: [[Char]]
+ Hledger.Cli.CliOptions: outputflags :: [Flag RawOpts]
+ Hledger.Cli.CliOptions: rawOptsToCliOpts :: RawOpts -> IO CliOpts
+ Hledger.Cli.CliOptions: registerWidthsFromOpts :: CliOpts -> (Int, Maybe Int)
+ Hledger.Cli.CliOptions: reportflags :: [Flag RawOpts]
+ Hledger.Cli.CliOptions: rulesFilePathFromOpts :: CliOpts -> IO (Maybe FilePath)
+ Hledger.Cli.CliOptions: showModeHelp :: Mode a -> String
+ Hledger.Cli.CliOptions: tests_Hledger_Cli_CliOptions :: Test
+ Hledger.Cli.CliOptions: widthFromOpts :: CliOpts -> Int
+ Hledger.Cli.CliOptions: withAliases :: String -> [String] -> String
+ Hledger.Cli.Print: entriesReportAsText :: EntriesReport -> String
+ Hledger.Cli.Register: postingsReportItemAsText :: CliOpts -> Int -> Int -> PostingsReportItem -> String
+ Text.Tabular.AsciiWide: render :: (rh -> String) -> (ch -> String) -> (a -> String) -> Table rh ch a -> String
+ Text.Tabular.AsciiWide: renderColumns :: [Int] -> Header String -> String
+ Text.Tabular.AsciiWide: renderHLine :: [Int] -> Header String -> Properties -> [String]
+ Text.Tabular.AsciiWide: renderHLine' :: [Int] -> Char -> Header String -> String
- Hledger.Cli.Add: compareDescriptions :: [Char] -> [Char] -> Double
+ Hledger.Cli.Add: compareDescriptions :: String -> String -> Double
- Hledger.Cli.Add: defaultTo' :: b -> Wizard Haskeline b -> Wizard Haskeline b
+ Hledger.Cli.Add: defaultTo' :: a -> Wizard Haskeline a -> Wizard Haskeline a
- Hledger.Cli.Add: letterPairs :: [t] -> [[t]]
+ Hledger.Cli.Add: letterPairs :: [a] -> [[a]]
- Hledger.Cli.Histogram: countBar :: [a] -> [Char]
+ Hledger.Cli.Histogram: countBar :: Foldable t => t a -> [Char]
- Hledger.Cli.Histogram: printDayWith :: (PrintfArg t2, PrintfType t1) => (t -> t2) -> (DateSpan, t) -> t1
+ Hledger.Cli.Histogram: printDayWith :: (PrintfType t, PrintfArg t1) => (t2 -> t1) -> (DateSpan, t2) -> t

Files

CHANGES view
@@ -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.
Hledger/Cli.hs view
@@ -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,
Hledger/Cli/Accounts.hs view
@@ -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.
Hledger/Cli/Add.hs view
@@ -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 
Hledger/Cli/Balance.hs view
@@ -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 [])
Hledger/Cli/Balancesheet.hs view
@@ -17,7 +17,7 @@ import Text.Shakespeare.Text  import Hledger-import Hledger.Cli.Options+import Hledger.Cli.CliOptions import Hledger.Cli.Balance  
Hledger/Cli/Cashflow.hs view
@@ -20,7 +20,7 @@ import Text.Shakespeare.Text  import Hledger-import Hledger.Cli.Options+import Hledger.Cli.CliOptions import Hledger.Cli.Balance  
+ Hledger/Cli/CliOptions.hs view
@@ -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+ [+ ]
Hledger/Cli/Histogram.hs view
@@ -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) 
Hledger/Cli/Incomestatement.hs view
@@ -17,7 +17,7 @@ import Text.Shakespeare.Text  import Hledger-import Hledger.Cli.Options+import Hledger.Cli.CliOptions import Hledger.Cli.Balance  
Hledger/Cli/Main.hs view
@@ -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
− Hledger/Cli/Options.hs
@@ -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- [- ]
Hledger/Cli/Print.hs view
@@ -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
Hledger/Cli/Register.hs view
@@ -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
Hledger/Cli/Stats.hs view
@@ -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) 
Hledger/Cli/Utils.hs view
@@ -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
+ README.md view
@@ -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)+<!-- [![github release](https://img.shields.io/github/release/simonmichael/hledger.svg?label=github+release)](https://github.com/simonmichael/hledger/releases) -->+<!-- [![github latest release downloads](https://img.shields.io/github/downloads/simonmichael/hledger/latest/total.svg?label=github+downloads)](https://github.com/simonmichael/hledger/releases) -->+<!-- [![gratipay](https://img.shields.io/gratipay/hledger.svg)]() -->++[![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)+
+ Text/Tabular/AsciiWide.hs view
@@ -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) ' '+
+ bench/SimpleBench.hs view
@@ -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"
hledger.cabal view
@@ -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 <simon@joyful.com> maintainer:     Simon Michael <simon@joyful.com> 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