hledger 0.9 → 0.10

raw patch · 45 files changed

+5139/−3766 lines, 45 filesdep −hack-handler-happstackdep −happstackdep −happstack-datadep ~hledger-libdep ~testpackPVP ok

version bump matches the API change (PVP)

Dependencies removed: hack-handler-happstack, happstack, happstack-data, happstack-server, happstack-state

Dependency ranges changed: hledger-lib, testpack

API changes (from Hackage documentation)

Files

• CONTRIBUTORS.rst +71/−0
• Commands/Add.hs +0/−202
• Commands/All.hs +0/−67
• Commands/Balance.hs +0/−165
• Commands/Chart.hs +0/−108
• Commands/Convert.hs +0/−386
• Commands/Histogram.hs +0/−50
• Commands/Print.hs +0/−29
• Commands/Register.hs +0/−150
• Commands/Stats.hs +0/−74
• Commands/UI.hs +0/−371
• Commands/Web.hs +0/−389
• Hledger/Cli/Commands/Add.hs +198/−0
• Hledger/Cli/Commands/All.hs +67/−0
• Hledger/Cli/Commands/Balance.hs +165/−0
• Hledger/Cli/Commands/Chart.hs +108/−0
• Hledger/Cli/Commands/Convert.hs +386/−0
• Hledger/Cli/Commands/Histogram.hs +50/−0
• Hledger/Cli/Commands/Print.hs +29/−0
• Hledger/Cli/Commands/Register.hs +150/−0
• Hledger/Cli/Commands/Stats.hs +75/−0
• Hledger/Cli/Commands/Vty.hs +379/−0
• Hledger/Cli/Commands/Web.hs +345/−0
• Hledger/Cli/Main.hs +80/−0
• Hledger/Cli/Options.hs +269/−0
• Hledger/Cli/Tests.hs +1082/−0
• Hledger/Cli/Utils.hs +77/−0
• Hledger/Cli/Version.hs +77/−0
• HledgerMain.hs +0/−47
• MANUAL.markdown +903/−0
• NEWS.rst +344/−0
• Options.hs +0/−277
• README +0/−36
• README.rst +39/−0
• README2.rst +99/−0
• Tests.hs +0/−1114
• Utils.hs +0/−94
• Version.hs +0/−75
• data/sample.ledger +40/−0
• data/sample.rules +17/−0
• data/sample.timelog +6/−0
• hledger.cabal +81/−49
• hledger.hs +2/−37
• sample.ledger +0/−40
• sample.timelog +0/−6

@@ -0,0 +1,71 @@+---+title: hledger Contributor List and Agreement+---+hledger Contributor List and Agreement+======================================++hledger Contributors+--------------------+hledger is brought to you by:++- Simon Michael - lead developer, project manager, general dogsbody+- Sergey Astanin - utf8 support+- Nick Ingolia - parser improvements+- Roman Cheplyaka - "chart" command, "add" command improvements++Developers who have not yet signed the contributor agreement:++- Tim Docker - parser improvements+- Marko Kocić - hlint cleanup+- Oliver Braun - GHC 6.12 compatibility+- Gwern Branwen - cleanups++Also:++- John Wiegley - created the original ledger program++.. raw:: html++ <br>++----++.. raw:: html++ <br>++hledger Contributor Agreement+-----------------------------+This is the official contributor agreement (v1) and contributor list+for the hledger project. If you have contributed non-trivial code+changes to hledger, please sign this, to help ensure:++1. that there is a clear legal status and audit trail for the project++2. that you get proper credit for your work++3. that we are able to remain license-compatible with related software+   by updating to newer versions of our license when appropriate+   (eg GPLv2 -> GPLv3)++To "sign", read the conditions below and then send a darcs patch to+`this file`_  adding your name to the Contributor List above.  By so+doing you promise that all of your commits to hledger:++- are free of patent violations or copyright violations, to the best of+  your knowledge++- are released under the hledger project's license_; or are released+  under another compatible license (in which case this must be clearly+  noted); or are public domain++- may be relicensed under official future versions of their license +  at the discretion of the project leader++We don't currently gather paper signatures, but this is a good start.+Feel free to update your entry as your contributions grow!+++.. _license:   http://joyful.com/repos/hledger/LICENSE+.. _this file: http://joyful.com//darcsweb/darcsweb.cgi?r=hledger;a=filehistory;f=/CONTRIBUTORS+

@@ -1,202 +0,0 @@-{-# LANGUAGE CPP #-}-{-| --A history-aware add command to help with data entry.---}--module Commands.Add-where-import Ledger-import Options-import Commands.Register (showRegisterReport)-#if __GLASGOW_HASKELL__ <= 610-import Prelude hiding (putStr, putStrLn, getLine, appendFile)-import System.IO.UTF8-import System.IO ( stderr, hFlush )-#else-import System.IO ( stderr, hFlush, hPutStrLn, hPutStr )-#endif-import System.IO.Error-import Text.ParserCombinators.Parsec-import Utils (ledgerFromStringWithOpts)-import qualified Data.Foldable as Foldable (find)---- | Read ledger transactions from the terminal, prompting for each field,--- and append them to the ledger file. If the ledger came from stdin, this--- command has no effect.-add :: [Opt] -> [String] -> Ledger -> IO ()-add opts args l-    | filepath (journal l) == "-" = return ()-    | otherwise = do-  hPutStrLn stderr $-    "Enter one or more transactions, which will be added to your ledger file.\n"-    ++"To complete a transaction, enter . as account name. To quit, press control-c."-  today <- getCurrentDay-  getAndAddTransactions l opts args today `catch` (\e -> unless (isEOFError e) $ ioError e)---- | Read a number of ledger transactions from the command line,--- prompting, validating, displaying and appending them to the ledger--- file, until end of input (then raise an EOF exception). Any--- command-line arguments are used as the first transaction's description.-getAndAddTransactions :: Ledger -> [Opt] -> [String] -> Day -> IO ()-getAndAddTransactions l opts args defaultDate = do-  (ledgerTransaction,date) <- getTransaction l opts args defaultDate-  l <- ledgerAddTransaction l ledgerTransaction-  getAndAddTransactions l opts args date---- | Read a transaction from the command line, with history-aware prompting.-getTransaction :: Ledger -> [Opt] -> [String] -> Day -> IO (Transaction,Day)-getTransaction l opts args defaultDate = do-  today <- getCurrentDay-  datestr <- askFor "date" -            (Just $ showDate defaultDate)-            (Just $ \s -> null s || -             isRight (parse (smartdate >> many spacenonewline >> eof) "" $ lowercase s))-  description <- askFor "description" Nothing (Just $ not . null) -  let historymatches = transactionsSimilarTo l args description-      bestmatch | null historymatches = Nothing-                | otherwise = Just $ snd $ head historymatches-      bestmatchpostings = maybe Nothing (Just . tpostings) bestmatch-      date = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) datestr-      accept x = x == "." || (not . null) x &&-        if NoNewAccts `elem` opts-            then isJust $ Foldable.find (== x) ant-            else True-        where (ant,_,_,_) = groupPostings . journalPostings . journal $ l-      getpostingsandvalidate = do-        ps <- getPostings accept bestmatchpostings []-        let t = nulltransaction{tdate=date-                               ,tstatus=False-                               ,tdescription=description-                               ,tpostings=ps-                               }-            retry msg = do-              hPutStrLn stderr $ "\n" ++ msg ++ "please re-enter."-              getpostingsandvalidate-        either retry (return . flip (,) date) $ balanceTransaction t-  unless (null historymatches) -       (do-         hPutStrLn stderr "Similar transactions found, using the first for defaults:\n"-         hPutStr stderr $ concatMap (\(n,t) -> printf "[%3d%%] %s" (round $ n*100 :: Int) (show t)) $ take 3 historymatches)-  getpostingsandvalidate---- | Read postings from the command line until . is entered, using the--- provided historical postings, if any, to guess defaults.-getPostings :: (AccountName -> Bool) -> Maybe [Posting] -> [Posting] -> IO [Posting]-getPostings accept historicalps enteredps = do-  account <- askFor (printf "account %d" n) defaultaccount (Just accept)-  if account=="."-    then return enteredps-    else do-      amountstr <- askFor (printf "amount  %d" n) defaultamount validateamount-      let amount = fromparse $ parse (someamount <|> return missingamt) "" amountstr-      let p = nullposting{paccount=stripbrackets account,-                          pamount=amount,-                          ptype=postingtype account}-      getPostings accept historicalps $ enteredps ++ [p]-    where-      n = length enteredps + 1-      enteredrealps = filter isReal enteredps-      bestmatch | isNothing historicalps = Nothing-                | n <= length ps = Just $ ps !! (n-1)-                | otherwise = Nothing-                where Just ps = historicalps-      defaultaccount = maybe Nothing (Just . showacctname) bestmatch-      showacctname p = showAccountName Nothing (ptype p) $ paccount p-      defaultamount = maybe balancingamount (Just . show . pamount) bestmatch-          where balancingamount = Just $ show $ negate $ sumMixedAmountsPreservingHighestPrecision $ map pamount enteredrealps-      postingtype ('[':_) = BalancedVirtualPosting-      postingtype ('(':_) = VirtualPosting-      postingtype _ = RegularPosting-      stripbrackets = dropWhile (`elem` "([") . reverse . dropWhile (`elem` "])") . reverse-      validateamount = Just $ \s -> (null s && not (null enteredrealps))-                                   || isRight (parse (someamount>>many spacenonewline>>eof) "" s)---- | Prompt for and read a string value, optionally with a default value--- and a validator. A validator causes the prompt to repeat until the--- input is valid. May also raise an EOF exception if control-d is pressed.-askFor :: String -> Maybe String -> Maybe (String -> Bool) -> IO String-askFor prompt def validator = do-  hPutStr stderr $ prompt ++ maybe "" showdef def ++ ": "-  hFlush stderr-  l <- getLine-  let input = if null l then fromMaybe l def else l-  case validator of-    Just valid -> if valid input-                   then return input-                   else askFor prompt def validator-    Nothing -> return input-    where showdef s = " [" ++ s ++ "]"---- | Append this transaction to the ledger's file. Also, to the ledger's--- transaction list, but we don't bother updating the other fields - this--- is enough to include new transactions in the history matching.-ledgerAddTransaction :: Ledger -> Transaction -> IO Ledger-ledgerAddTransaction l t = do-  appendToLedgerFile l $ showTransaction t-  putStrLn $ printf "\nAdded transaction to %s:" (filepath $ journal l)-  putStrLn =<< registerFromString (show t)-  return l{journal=rl{jtxns=ts}}-      where rl = journal l-            ts = jtxns rl ++ [t]---- | Append data to the ledger's file, ensuring proper separation from any--- existing data; or if the file is "-", dump it to stdout.-appendToLedgerFile :: Ledger -> String -> IO ()-appendToLedgerFile l s = -    if f == "-"-    then putStr $ sep ++ s-    else appendFile f $ sep++s-    where -      f = filepath $ journal l-      -- XXX we are looking at the original raw text from when the ledger-      -- was first read, but that's good enough for now-      t = jtext $ journal l-      sep | null $ strip t = ""-          | otherwise = replicate (2 - min 2 (length lastnls)) '\n'-          where lastnls = takeWhile (=='\n') $ reverse t---- | Convert a string of ledger data into a register report.-registerFromString :: String -> IO String-registerFromString s = do-  now <- getCurrentLocalTime-  l <- ledgerFromStringWithOpts [] s-  return $ showRegisterReport opts (optsToFilterSpec opts [] now) l-    where opts = [Empty]---- | 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.-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-    where-      i = length $ intersect pairs1 pairs2-      u = length pairs1 + length pairs2-      pairs1 = wordLetterPairs $ uppercase s1-      pairs2 = wordLetterPairs $ uppercase s2-wordLetterPairs = concatMap letterPairs . words-letterPairs (a:b:rest) = [a,b] : letterPairs (b:rest)-letterPairs _ = []--compareLedgerDescriptions :: [Char] -> [Char] -> Double-compareLedgerDescriptions s t = compareStrings s' t'-    where s' = simplify s-          t' = simplify t-          simplify = filter (not . (`elem` "0123456789"))--transactionsSimilarTo :: Ledger -> [String] -> String -> [(Double,Transaction)]-transactionsSimilarTo l apats s =-    sortBy compareRelevanceAndRecency-               $ filter ((> threshold).fst)-               [(compareLedgerDescriptions s $ tdescription t, t) | t <- ts]-    where-      compareRelevanceAndRecency (n1,t1) (n2,t2) = compare (n2,tdate t2) (n1,tdate t1)-      ts = jtxns $ filterJournalTransactionsByAccount apats $ journal l-      threshold = 0-

@@ -1,67 +0,0 @@-{-# LANGUAGE CPP #-}-{-| --The Commands package defines all the commands offered by the hledger-application, like \"register\" and \"balance\".  This module exports all-the commands; you can also import individual modules if you prefer.---}--module Commands.All (-                     module Commands.Add,-                     module Commands.Balance,-                     module Commands.Convert,-                     module Commands.Histogram,-                     module Commands.Print,-                     module Commands.Register,-                     module Commands.Stats,-#ifdef VTY-                     module Commands.UI,-#endif-#if defined(WEB) || defined(WEBHAPPSTACK)-                     module Commands.Web,-#endif-#ifdef CHART-                     module Commands.Chart,-#endif-                     tests_Commands-              )-where-import Commands.Add-import Commands.Balance-import Commands.Convert-import Commands.Histogram-import Commands.Print-import Commands.Register-import Commands.Stats-#ifdef VTY-import Commands.UI-#endif-#if defined(WEB) || defined(WEBHAPPSTACK)-import Commands.Web-#endif-#ifdef CHART-import Commands.Chart-#endif-import Test.HUnit (Test(TestList))---tests_Commands = TestList-    [---      Commands.Add.tests_Add---     ,Commands.Balance.tests_Balance-     Commands.Convert.tests_Convert---     ,Commands.Histogram.tests_Histogram---     ,Commands.Print.tests_Print-    ,Commands.Register.tests_Register---     ,Commands.Stats.tests_Stats-    ]--- #ifdef VTY---     ,Commands.UI.tests_UI--- #endif--- #if defined(WEB) || defined(WEBHAPPSTACK)---     ,Commands.Web.tests_Web--- #endif--- #ifdef CHART---     ,Commands.Chart.tests_Chart--- #endif

@@ -1,165 +0,0 @@-{-# LANGUAGE CPP #-}-{-|--A ledger-compatible @balance@ command.--ledger's balance command is easy to use but not easy to describe-precisely.  In the examples below we'll use sample.ledger, which has the-following account tree:--@- assets-   bank-     checking-     saving-   cash- expenses-   food-   supplies- income-   gifts-   salary- liabilities-   debts-@--The balance command shows accounts with their aggregate balances.-Subaccounts are displayed indented below their parent. Each balance is the-sum of any transactions in that account plus any balances from-subaccounts:--@- $ hledger -f sample.ledger balance-                 $-1  assets-                  $1    bank:saving-                 $-2    cash-                  $2  expenses-                  $1    food-                  $1    supplies-                 $-2  income-                 $-1    gifts-                 $-1    salary-                  $1  liabilities:debts-@--Usually, the non-interesting accounts are elided or omitted. Above,-@checking@ is omitted because it has no subaccounts and a zero balance.-@bank@ is elided because it has only a single displayed subaccount-(@saving@) and it would be showing the same balance as that ($1). Ditto-for @liabilities@. We will return to this in a moment.--The --depth argument can be used to limit the depth of the balance report.-So, to see just the top level accounts:--@-$ hledger -f sample.ledger balance --depth 1-                 $-1  assets-                  $2  expenses-                 $-2  income-                  $1  liabilities-@--This time liabilities has no displayed subaccounts (due to --depth) and-is not elided.--With one or more account pattern arguments, the balance command shows-accounts whose name matches one of the patterns, plus their parents-(elided) and subaccounts. So with the pattern o we get:--@- $ hledger -f sample.ledger balance o-                  $1  expenses:food-                 $-2  income-                 $-1    gifts-                 $-1    salary----------------------                 $-1-@--The o pattern matched @food@ and @income@, so they are shown. Unmatched-parents of matched accounts are also shown (elided) for context (@expenses@).--Also, the balance report shows the total of all displayed accounts, when-that is non-zero. Here, it is displayed because the accounts shown add up-to $-1.--Here is a more precise definition of \"interesting\" accounts in ledger's-balance report:--- an account which has just one interesting subaccount branch, and which-  is not at the report's maximum depth, is interesting if the balance is-  different from the subaccount's, and otherwise boring.--- any other account is interesting if it has a non-zero balance, or the -E-  flag is used.---}--module Commands.Balance-where-import Ledger.Utils-import Ledger.Types-import Ledger.Amount-import Ledger.AccountName-import Ledger.Posting-import Ledger.Ledger-import Options-#if __GLASGOW_HASKELL__ <= 610-import Prelude hiding ( putStr )-import System.IO.UTF8-#endif----- | Print a balance report.-balance :: [Opt] -> [String] -> Ledger -> IO ()-balance opts args l = do-  t <- getCurrentLocalTime-  putStr $ showBalanceReport opts (optsToFilterSpec opts args t) l---- | Generate a balance report with the specified options for this ledger.-showBalanceReport :: [Opt] -> FilterSpec -> Ledger -> String-showBalanceReport opts filterspec l = acctsstr ++ totalstr-    where-      l' = cacheLedger'' filterspec l-      acctsstr = unlines $ map showacct interestingaccts-          where-            showacct = showInterestingAccount l' interestingaccts-            interestingaccts = filter (isInteresting opts l') acctnames-            acctnames = sort $ tail $ flatten $ treemap aname accttree-            accttree = ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) l'-      totalstr | NoTotal `elem` opts = ""-               | notElem Empty opts && isZeroMixedAmount total = ""-               | otherwise = printf "--------------------\n%s\n" $ padleft 20 $ showMixedAmountWithoutPrice total-          where-            total = sum $ map abalance $ ledgerTopAccounts l'---- | Display one line of the balance report with appropriate indenting and eliding.-showInterestingAccount :: Ledger -> [AccountName] -> AccountName -> String-showInterestingAccount l interestingaccts a = concatTopPadded [amt, "  ", depthspacer ++ partialname]-    where-      amt = padleft 20 $ showMixedAmountWithoutPrice $ abalance $ ledgerAccount l a-      parents = parentAccountNames a-      interestingparents = filter (`elem` interestingaccts) parents-      depthspacer = replicate (indentperlevel * length interestingparents) ' '-      indentperlevel = 2-      -- the partial name is the account's leaf name, prefixed by the-      -- names of any boring parents immediately above-      partialname = accountNameFromComponents $ reverse (map accountLeafName ps) ++ [accountLeafName a]-          where ps = takeWhile boring parents where boring = not . (`elem` interestingparents)---- | Is the named account considered interesting for this ledger's balance report ?-isInteresting :: [Opt] -> Ledger -> AccountName -> Bool-isInteresting opts l a-    | numinterestingsubs==1 && not atmaxdepth = notlikesub-    | otherwise = notzero || emptyflag-    where-      atmaxdepth = isJust d && Just (accountNameLevel a) == d where d = depthFromOpts opts-      emptyflag = Empty `elem` opts-      acct = ledgerAccount l a-      notzero = not $ isZeroMixedAmount inclbalance where inclbalance = abalance acct-      notlikesub = not $ isZeroMixedAmount exclbalance where exclbalance = sumPostings $ apostings acct-      numinterestingsubs = length $ filter isInterestingTree subtrees-          where-            isInterestingTree = treeany (isInteresting opts l . aname)-            subtrees = map (fromJust . ledgerAccountTreeAt l) $ ledgerSubAccounts l $ ledgerAccount l a-

@@ -1,108 +0,0 @@-{-|--Generate balances pie chart---}--module Commands.Chart-where-import Ledger.Utils-import Ledger.Types-import Ledger.Amount-import Ledger.Ledger-import Ledger.Commodity-import Options--import Control.Monad (liftM3)-import Graphics.Rendering.Chart-import Data.Colour-import Data.Colour.Names-import Data.Colour.RGBSpace-import Data.Colour.RGBSpace.HSL (hsl)-import Data.Colour.SRGB.Linear (rgb)-import Data.List-import Safe (readDef)---- | Generate an image with the pie chart and write it to a file-chart :: [Opt] -> [String] -> Ledger -> IO ()-chart opts args l = do-  t <- getCurrentLocalTime-  let chart = genPie opts (optsToFilterSpec opts args t) l-  renderableToPNGFile (toRenderable chart) w h filename-    where-      filename = getOption opts ChartOutput chartoutput-      (w,h) = parseSize $ getOption opts ChartSize chartsize---- | Extract string option value from a list of options or use the default-getOption :: [Opt] -> (String->Opt) -> String -> String-getOption opts opt def = -    case reverse $ optValuesForConstructor opt opts of-        [] -> def-        x:_ -> x---- | Parse image size from a command-line option-parseSize :: String -> (Int,Int)-parseSize str = (read w, read h)-    where-    x = fromMaybe (error "Size should be in WIDTHxHEIGHT format") $ findIndex (=='x') str-    (w,_:h) = splitAt x str---- | Generate pie chart-genPie :: [Opt] -> FilterSpec -> Ledger -> PieLayout-genPie opts filterspec l = defaultPieLayout { pie_background_ = solidFillStyle $ opaque $ white-                                            , pie_plot_ = pie_chart }-    where-      pie_chart = defaultPieChart { pie_data_ = map (uncurry accountPieItem) chartitems'-                                  , pie_start_angle_ = (-90)-                                  , pie_colors_ = mkColours hue-                                  , pie_label_style_ = defaultFontStyle{font_size_=12}-                                  }-      chartitems' = debug "chart" $ top num samesignitems-      (samesignitems, sign) = sameSignNonZero rawitems-      rawitems = debug "raw" $ flatten $ balances $-                 ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) $ cacheLedger'' filterspec l-      top n t = topn ++ [other]-          where-            (topn,rest) = splitAt n $ reverse $ sortBy (comparing snd) t-            other = ("other", sum $ map snd rest)-      num = readDef (fromIntegral chartitems) (getOption opts ChartItems (show chartitems))-      hue = if sign > 0 then red else green where (red, green) = (0, 110)-      debug s = if Debug `elem` opts then ltrace s else id---- | Select the nonzero items with same sign as the first, and make--- them positive. Also return a 1 or -1 corresponding to the original sign.-sameSignNonZero :: [(AccountName, Double)] -> ([(AccountName, Double)], Int)-sameSignNonZero is | null nzs = ([], 1)-                   | otherwise = (map pos $ filter (test.snd) nzs, sign)-                   where-                     nzs = filter ((/=0).snd) is-                     pos (a,b) = (a, abs b)-                     sign = if snd (head nzs) >= 0 then 1 else (-1)-                     test = if sign > 0 then (>0) else (<0)---- | Convert all quantities of MixedAccount to a single commodity-amountValue :: MixedAmount -> Double-amountValue = quantity . convertMixedAmountTo unknown---- | Generate a tree of account names together with their balances.---   The balance of account is decremented by the balance of its subaccounts---   which are drawn on the chart.-balances :: Tree Account -> Tree (AccountName, Double)-balances (Node rootAcc subAccs) = Node newroot newsubs-    where-      newroot = (aname rootAcc,-                 amountValue $-                 abalance rootAcc - (sum . map (abalance . root)) subAccs)-      newsubs = map balances subAccs---- | Build a single pie chart item-accountPieItem :: AccountName -> Double -> PieItem-accountPieItem accname balance = PieItem accname offset balance where offset = 0---- | Generate an infinite color list suitable for charts.-mkColours :: Double -> [AlphaColour Double]-mkColours hue = cycle $ [opaque $ rgbToColour $ hsl h s l | (h,s,l) <- liftM3 (,,)-                         [hue] [0.7] [0.1,0.2..0.7] ]--rgbToColour :: (Fractional a) => RGB a -> Colour a-rgbToColour (RGB r g b) = rgb r g b

@@ -1,386 +0,0 @@-{-|-Convert account data in CSV format (eg downloaded from a bank) to ledger-format, and print it on stdout. See the manual for more details.--}--module Commands.Convert where-import Options (Opt(Debug))-import Version (versionstr)-import Ledger.Types (Ledger,AccountName,Transaction(..),Posting(..),PostingType(..))-import Ledger.Utils (strip, spacenonewline, restofline, parseWithCtx, assertParse, assertParseEqual)-import Ledger.Parse (someamount, emptyCtx, ledgeraccountname)-import Ledger.Amount (nullmixedamt)-import Safe (atDef, maximumDef)-import System.IO (stderr)-import Text.CSV (parseCSVFromFile, printCSV)-import Text.Printf (hPrintf)-import Text.RegexPR (matchRegexPR, gsubRegexPR)-import Data.Maybe-import Ledger.Dates (firstJust, showDate, parsedate)-import System.Locale (defaultTimeLocale)-import Data.Time.Format (parseTime)-import Control.Monad (when, guard, liftM)-import Safe (readDef, readMay)-import System.Directory (doesFileExist)-import System.Exit (exitFailure)-import System.FilePath.Posix (takeBaseName, replaceExtension)-import Text.ParserCombinators.Parsec-import Test.HUnit---{- |-A set of data definitions and account-matching patterns sufficient to-convert a particular CSV data file into meaningful ledger transactions. See above.--}-data CsvRules = CsvRules {-      dateField :: Maybe FieldPosition,-      statusField :: Maybe FieldPosition,-      codeField :: Maybe FieldPosition,-      descriptionField :: Maybe FieldPosition,-      amountField :: Maybe FieldPosition,-      currencyField :: Maybe FieldPosition,-      baseCurrency :: Maybe String,-      baseAccount :: AccountName,-      accountRules :: [AccountRule]-} deriving (Show, Eq)--nullrules = CsvRules {-      dateField=Nothing,-      statusField=Nothing,-      codeField=Nothing,-      descriptionField=Nothing,-      amountField=Nothing,-      currencyField=Nothing,-      baseCurrency=Nothing,-      baseAccount="unknown",-      accountRules=[]-}--type FieldPosition = Int--type AccountRule = (-   [(String, Maybe String)] -- list of regex match patterns with optional replacements-  ,AccountName              -- account name to use for a transaction matching this rule-  )--type CsvRecord = [String]----- | Read the CSV file named as an argument and print equivalent ledger transactions,--- using/creating a .rules file.-convert :: [Opt] -> [String] -> Ledger -> IO ()-convert opts args _ = do-  when (null args) $ error "please specify a csv data file."-  let csvfile = head args-  csvparse <- parseCSVFromFile csvfile-  let records = case csvparse of-                  Left e -> error $ show e-                  Right rs -> reverse $ filter (/= [""]) rs-  let debug = Debug `elem` opts-      rulesfile = rulesFileFor csvfile-  exists <- doesFileExist rulesfile-  if (not exists) then do-                  hPrintf stderr "creating conversion rules file %s, edit this file for better results\n" rulesfile-                  writeFile rulesfile initialRulesFileContent-   else-      hPrintf stderr "using conversion rules file %s\n" rulesfile-  rules <- liftM (either (error.show) id) $ parseCsvRulesFile rulesfile-  when debug $ hPrintf stderr "rules: %s\n" (show rules)-  let requiredfields = max 2 (maxFieldIndex rules + 1)-      badrecords = take 1 $ filter ((< requiredfields).length) records-  if null badrecords-   then mapM_ (printTxn debug rules) records-   else do-     hPrintf stderr (unlines [-                      "Warning, at least one CSV record does not contain a field referenced by the"-                     ,"conversion rules file, or has less than two fields. Are you converting a"-                     ,"valid CSV file ? First bad record:\n%s"-                     ]) (show $ head badrecords)-     exitFailure---- | The highest (0-based) field index referenced in the field--- definitions, or -1 if no fields are defined.-maxFieldIndex :: CsvRules -> Int-maxFieldIndex r = maximumDef (-1) $ catMaybes [-                   dateField r-                  ,statusField r-                  ,codeField r-                  ,descriptionField r-                  ,amountField r-                  ,currencyField r-                  ]--rulesFileFor :: FilePath -> FilePath-rulesFileFor csvfile = replaceExtension csvfile ".rules"--initialRulesFileContent :: String-initialRulesFileContent =-    "# csv conversion rules file generated by hledger "++versionstr++"\n" ++-    "# Add rules to this file for more accurate conversion, see\n"++-    "# http://hledger.org/MANUAL.html#convert\n" ++-    "\n" ++-    "base-account assets:bank:checking\n" ++-    "date-field 0\n" ++-    "description-field 4\n" ++-    "amount-field 1\n" ++-    "currency $\n" ++-    "\n" ++-    "# account-assigning rules\n" ++-    "\n" ++-    "SPECTRUM\n" ++-    "expenses:health:gym\n" ++-    "\n" ++-    "ITUNES\n" ++-    "BLKBSTR=BLOCKBUSTER\n" ++-    "expenses:entertainment\n" ++-    "\n" ++-    "(TO|FROM) SAVINGS\n" ++-    "assets:bank:savings\n"---- rules file parser--parseCsvRulesFile :: FilePath -> IO (Either ParseError CsvRules)-parseCsvRulesFile f = do-  s <- readFile f-  return $ parseCsvRules f s--parseCsvRules :: FilePath -> String -> Either ParseError CsvRules-parseCsvRules rulesfile s = runParser csvrulesfile nullrules{baseAccount=takeBaseName rulesfile} rulesfile s--csvrulesfile :: GenParser Char CsvRules CsvRules-csvrulesfile = do-  many blankorcommentline-  many definitions-  r <- getState-  ars <- many accountrule-  many blankorcommentline-  eof-  return r{accountRules=ars}---- | Real independent parser choice, even when alternative matches share a prefix.-choice' parsers = choice $ map try (init parsers) ++ [last parsers]--definitions :: GenParser Char CsvRules ()-definitions = do-  choice' [-    datefield-   ,statusfield-   ,codefield-   ,descriptionfield-   ,amountfield-   ,currencyfield-   ,basecurrency-   ,baseaccount-   ,commentline-   ] <?> "definition"-  return ()--datefield = do-  string "date-field"-  many1 spacenonewline-  v <- restofline-  r <- getState-  setState r{dateField=readMay v}--codefield = do-  string "code-field"-  many1 spacenonewline-  v <- restofline-  r <- getState-  setState r{codeField=readMay v}--statusfield = do-  string "status-field"-  many1 spacenonewline-  v <- restofline-  r <- getState-  setState r{statusField=readMay v}--descriptionfield = do-  string "description-field"-  many1 spacenonewline-  v <- restofline-  r <- getState-  setState r{descriptionField=readMay v}--amountfield = do-  string "amount-field"-  many1 spacenonewline-  v <- restofline-  r <- getState-  setState r{amountField=readMay v}--currencyfield = do-  string "currency-field"-  many1 spacenonewline-  v <- restofline-  r <- getState-  setState r{currencyField=readMay v}--basecurrency = do-  string "currency"-  many1 spacenonewline-  v <- restofline-  r <- getState-  setState r{baseCurrency=Just v}--baseaccount = do-  string "base-account"-  many1 spacenonewline-  v <- ledgeraccountname-  optional newline-  r <- getState-  setState r{baseAccount=v}--accountrule :: GenParser Char CsvRules AccountRule-accountrule = do-  many blankorcommentline-  pats <- many1 matchreplacepattern-  guard $ length pats >= 2-  let pats' = init pats-      acct = either (fail.show) id $ runParser ledgeraccountname () "" $ fst $ last pats-  many blankorcommentline-  return (pats',acct)- <?> "account rule"--blanklines = many1 blankline >> return ()--blankline = many spacenonewline >> newline >> return () <?> "blank line"--commentchar = oneOf ";#"--commentline = many spacenonewline >> commentchar >> restofline >> return () <?> "comment line"--blankorcommentline = choice' [blankline, commentline]--matchreplacepattern = do-  notFollowedBy commentchar-  matchpat <- many1 (noneOf "=\n")-  replpat <- optionMaybe $ do {char '='; many $ noneOf "\n"}-  newline-  return (matchpat,replpat)--printTxn :: Bool -> CsvRules -> CsvRecord -> IO ()-printTxn debug rules rec = do-  when debug $ hPrintf stderr "record: %s" (printCSV [rec])-  putStr $ show $ transactionFromCsvRecord rules rec---- csv record conversion--transactionFromCsvRecord :: CsvRules -> CsvRecord -> Transaction-transactionFromCsvRecord rules fields =-  let -      date = parsedate $ normaliseDate $ maybe "1900/1/1" (atDef "" fields) (dateField rules)-      status = maybe False (null . strip . (atDef "" fields)) (statusField rules)-      code = maybe "" (atDef "" fields) (codeField rules)-      desc = maybe "" (atDef "" fields) (descriptionField rules)-      comment = ""-      precomment = ""-      amountstr = maybe "" (atDef "" fields) (amountField rules)-      amountstr' = strnegate amountstr where strnegate ('-':s) = s-                                             strnegate s = '-':s-      currency = maybe (fromMaybe "" $ baseCurrency rules) (atDef "" fields) (currencyField rules)-      amountstr'' = currency ++ amountstr'-      amountparse = runParser someamount emptyCtx "" amountstr''-      amount = either (const nullmixedamt) id amountparse-      unknownacct | (readDef 0 amountstr' :: Double) < 0 = "income:unknown"-                  | otherwise = "expenses:unknown"-      (acct,newdesc) = identify (accountRules rules) unknownacct desc-      t = Transaction {-              tdate=date,-              teffectivedate=Nothing,-              tstatus=status,-              tcode=code,-              tdescription=newdesc,-              tcomment=comment,-              tpreceding_comment_lines=precomment,-              tpostings=[-                   Posting {-                     pstatus=False,-                     paccount=acct,-                     pamount=amount,-                     pcomment="",-                     ptype=RegularPosting,-                     ptransaction=Just t-                   },-                   Posting {-                     pstatus=False,-                     paccount=baseAccount rules,-                     pamount=(-amount),-                     pcomment="",-                     ptype=RegularPosting,-                     ptransaction=Just t-                   }-                  ]-            }-  in t---- | Convert some date string with unknown format to YYYY/MM/DD.-normaliseDate :: String -> String-normaliseDate s = maybe "0000/00/00" showDate $-              firstJust-              [parseTime defaultTimeLocale "%Y/%m/%e" s-               -- can't parse a month without leading 0, try adding one-              ,parseTime defaultTimeLocale "%Y/%m/%e" (take 5 s ++ "0" ++ drop 5 s)-              ,parseTime defaultTimeLocale "%Y-%m-%e" s-              ,parseTime defaultTimeLocale "%Y-%m-%e" (take 5 s ++ "0" ++ drop 5 s)-              ,parseTime defaultTimeLocale "%m/%e/%Y" s-              ,parseTime defaultTimeLocale "%m/%e/%Y" ('0':s)-              ,parseTime defaultTimeLocale "%m-%e-%Y" s-              ,parseTime defaultTimeLocale "%m-%e-%Y" ('0':s)-              ]---- | Apply account matching rules to a transaction description to obtain--- the most appropriate account and a new description.-identify :: [AccountRule] -> String -> String -> (String,String)-identify rules defacct desc | null matchingrules = (defacct,desc)-                            | otherwise = (acct,newdesc)-    where-      matchingrules = filter ismatch rules :: [AccountRule]-          where ismatch = any (isJust . flip matchRegexPR (caseinsensitive desc) . fst) . fst-      (prs,acct) = head matchingrules-      p_ms_r = filter (\(_,m,_) -> isJust m) $ map (\(p,r) -> (p, matchRegexPR (caseinsensitive p) desc, r)) prs-      (p,_,r) = head p_ms_r-      newdesc = case r of Just rpat -> gsubRegexPR (caseinsensitive p) rpat desc-                          Nothing   -> desc--caseinsensitive = ("(?i)"++)--tests_Convert = TestList [--   "convert rules parsing: empty file" ~: do-     -- let assertMixedAmountParse parseresult mixedamount =-     --         (either (const "parse error") showMixedAmountDebug parseresult) ~?= (showMixedAmountDebug mixedamount)-    assertParseEqual (parseCsvRules "unknown" "") nullrules--  ,"convert rules parsing: accountrule" ~: do-     assertParseEqual (parseWithCtx nullrules accountrule "A\na\n") -- leading blank line required-                 ([("A",Nothing)], "a")--  ,"convert rules parsing: trailing comments" ~: do-     assertParse (parseWithCtx nullrules csvrulesfile "A\na\n# \n#\n")--  ,"convert rules parsing: trailing blank lines" ~: do-     assertParse (parseWithCtx nullrules csvrulesfile "A\na\n\n  \n")--  -- not supported-  -- ,"convert rules parsing: no final newline" ~: do-  --    assertParse (parseWithCtx nullrules csvrulesfile "A\na")-  --    assertParse (parseWithCtx nullrules csvrulesfile "A\na\n# \n#")-  --    assertParse (parseWithCtx nullrules csvrulesfile "A\na\n\n  ")--                 -- (nullrules{-                 --   -- dateField=Maybe FieldPosition,-                 --   -- statusField=Maybe FieldPosition,-                 --   -- codeField=Maybe FieldPosition,-                 --   -- descriptionField=Maybe FieldPosition,-                 --   -- amountField=Maybe FieldPosition,-                 --   -- currencyField=Maybe FieldPosition,-                 --   -- baseCurrency=Maybe String,-                 --   -- baseAccount=AccountName,-                 --   accountRules=[-                 --        ([("A",Nothing)], "a")-                 --       ]-                 --  })--  ]

@@ -1,50 +0,0 @@-{-# LANGUAGE CPP #-}-{-| --Print a histogram report.---}--module Commands.Histogram-where-import Ledger-import Options-#if __GLASGOW_HASKELL__ <= 610-import Prelude hiding ( putStr )-import System.IO.UTF8-#endif---barchar = '*'---- | Print a histogram of some statistic per reporting interval, such as--- number of postings per day.-histogram :: [Opt] -> [String] -> Ledger -> IO ()-histogram opts args l = do-  t <- getCurrentLocalTime-  putStr $ showHistogram opts (optsToFilterSpec opts args t) l--showHistogram :: [Opt] -> FilterSpec -> Ledger -> String-showHistogram opts filterspec l = concatMap (printDayWith countBar) dayps-    where-      i = intervalFromOpts opts-      interval | i == NoInterval = Daily-               | otherwise = i-      fullspan = journalDateSpan $ journal l-      days = filter (DateSpan Nothing Nothing /=) $ splitSpan interval fullspan-      dayps = [(s, filter (isPostingInDateSpan s) ps) | s <- days]-      -- same as Register-      -- should count transactions, not postings ?-      ps = sortBy (comparing postingDate) $ filterempties $ filter matchapats $ filterdepth $ ledgerPostings l-      filterempties-          | Empty `elem` opts = id-          | otherwise = filter (not . isZeroMixedAmount . pamount)-      matchapats = matchpats apats . paccount-      apats = acctpats filterspec-      filterdepth | interval == NoInterval = filter (\p -> accountNameLevel (paccount p) <= depth)-                  | otherwise = id-      depth = fromMaybe 99999 $ depthFromOpts opts--printDayWith f (DateSpan b _, ts) = printf "%s %s\n" (show $ fromJust b) (f ts)--countBar ps = replicate (length ps) barchar

@@ -1,29 +0,0 @@-{-# LANGUAGE CPP #-}-{-| --A ledger-compatible @print@ command.---}--module Commands.Print-where-import Ledger-import Options-#if __GLASGOW_HASKELL__ <= 610-import Prelude hiding ( putStr )-import System.IO.UTF8-#endif----- | Print ledger transactions in standard format.-print' :: [Opt] -> [String] -> Ledger -> IO ()-print' opts args l = do-  t <- getCurrentLocalTime-  putStr $ showTransactions (optsToFilterSpec opts args t) l--showTransactions :: FilterSpec -> Ledger -> String-showTransactions filterspec l =-    concatMap (showTransactionForPrint effective) $ sortBy (comparing tdate) txns-        where-          effective = EffectiveDate == whichdate filterspec-          txns = jtxns $ filterJournalTransactions filterspec $ journal l

@@ -1,150 +0,0 @@-{-# LANGUAGE CPP #-}-{-| --A ledger-compatible @register@ command.---}--module Commands.Register (-  register- ,showRegisterReport- ,showPostingWithBalance- ,tests_Register-) where--import Safe (headMay, lastMay)-import Ledger-import Options-#if __GLASGOW_HASKELL__ <= 610-import Prelude hiding ( putStr )-import System.IO.UTF8-#endif----- | Print a register report.-register :: [Opt] -> [String] -> Ledger -> IO ()-register opts args l = do-  t <- getCurrentLocalTime-  putStr $ showRegisterReport opts (optsToFilterSpec opts args t) l---- | Generate the register report, which is a list of postings with transaction--- info and a running balance.-showRegisterReport :: [Opt] -> FilterSpec -> Ledger -> String-showRegisterReport opts filterspec l = showPostingsWithBalance ps nullposting startbal-    where-      ps | interval == NoInterval = displayableps-         | otherwise             = summarisePostings interval depth empty filterspan displayableps-      startbal = sumPostings precedingps-      (precedingps,displayableps,_) =-          postingsMatchingDisplayExpr (displayExprFromOpts opts) $ journalPostings $ filterJournalPostings filterspec $ journal l-      (interval, depth, empty) = (intervalFromOpts opts, depthFromOpts opts, Empty `elem` opts)-      filterspan = datespan filterspec---- | Convert a list of postings into summary postings, one per interval.-summarisePostings :: Interval -> Maybe Int -> Bool -> DateSpan -> [Posting] -> [Posting]-summarisePostings interval depth empty filterspan ps = concatMap summarisespan $ splitSpan interval reportspan-    where-      summarisespan s = summarisePostingsInDateSpan s depth empty (postingsinspan s)-      postingsinspan s = filter (isPostingInDateSpan s) ps-      dataspan = postingsDateSpan ps-      reportspan | empty = filterspan `orDatesFrom` dataspan-                 | otherwise = dataspan---- | Combine two datespans, filling any unspecified dates in the first--- with dates from the second.-orDatesFrom (DateSpan a1 b1) (DateSpan a2 b2) = DateSpan a b-    where a = if isJust a1 then a1 else a2-          b = if isJust b1 then b1 else b2---- | Date-sort and split a list of postings into three spans - postings matched--- by the given display expression, and the preceding and following postings.-postingsMatchingDisplayExpr :: Maybe String -> [Posting] -> ([Posting],[Posting],[Posting])-postingsMatchingDisplayExpr d ps = (before, matched, after)-    where -      sorted = sortBy (comparing postingDate) ps-      (before, rest) = break (displayExprMatches d) sorted-      (matched, after) = span (displayExprMatches d) rest---- | Does this display expression allow this posting to be displayed ?--- Raises an error if the display expression can't be parsed.-displayExprMatches :: Maybe String -> Posting -> Bool-displayExprMatches Nothing  _ = True-displayExprMatches (Just d) p = (fromparse $ parsewith datedisplayexpr d) p-                        --- XXX confusing, refactor--- | Given a date span (representing a reporting interval) and a list of--- postings within it: aggregate the postings so there is only one per--- account, and adjust their date/description so that they will render--- as a summary for this interval.--- --- As usual with date spans the end date is exclusive, but for display--- purposes we show the previous day as end date, like ledger.--- --- When a depth argument is present, postings to accounts of greater--- depth are aggregated where possible.--- --- The showempty flag forces the display of a zero-posting span--- and also zero-posting accounts within the span.-summarisePostingsInDateSpan :: DateSpan -> Maybe Int -> Bool -> [Posting] -> [Posting]-summarisePostingsInDateSpan (DateSpan b e) depth showempty ps-    | null ps && (isNothing b || isNothing e) = []-    | null ps && showempty = [summaryp]-    | otherwise = summaryps'-    where-      summaryp = summaryPosting b' ("- "++ showDate (addDays (-1) e'))-      b' = fromMaybe (maybe nulldate postingDate $ headMay ps) b-      e' = fromMaybe (maybe (addDays 1 nulldate) postingDate $ lastMay ps) e-      summaryPosting date desc = nullposting{ptransaction=Just nulltransaction{tdate=date,tdescription=desc}}--      summaryps' = (if showempty then id else filter (not . isZeroMixedAmount . pamount)) summaryps-      summaryps = [summaryp{paccount=a,pamount=balancetoshowfor a} | a <- clippedanames]-      anames = sort $ nub $ map paccount ps-      -- aggregate balances by account, like cacheLedger, then do depth-clipping-      (_,_,exclbalof,inclbalof) = groupPostings ps-      clippedanames = nub $ map (clipAccountName d) anames-      isclipped a = accountNameLevel a >= d-      d = fromMaybe 99999 $ depth-      balancetoshowfor a =-          (if isclipped a then inclbalof else exclbalof) (if null a then "top" else a)--{- |-Show postings one per line, plus transaction info for the first posting of-each transaction, and a running balance. Eg:--@-date (10)  description (20)     account (22)            amount (11)  balance (12)-DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAA AAAAAAAAAAAA-                                aaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAA AAAAAAAAAAAA-@--}-showPostingsWithBalance :: [Posting] -> Posting -> MixedAmount -> String-showPostingsWithBalance [] _ _ = ""-showPostingsWithBalance (p:ps) pprev bal = this ++ showPostingsWithBalance ps p bal'-    where-      this = showPostingWithBalance isfirst p bal'-      isfirst = ptransaction p /= ptransaction pprev-      bal' = bal + pamount p---- | Show one posting and running balance, with or without transaction info.-showPostingWithBalance :: Bool -> Posting -> MixedAmount -> String-showPostingWithBalance withtxninfo p b = concatBottomPadded [txninfo ++ pstr ++ " ", bal] ++ "\n"-    where-      ledger3ishlayout = False-      datedescwidth = if ledger3ishlayout then 34 else 32-      txninfo = if withtxninfo then printf "%s %s " date desc else replicate datedescwidth ' '-      date = showDate da-      datewidth = 10-      descwidth = datedescwidth - datewidth - 2-      desc = printf ("%-"++(show descwidth)++"s") $ elideRight descwidth de :: String-      pstr = showPostingForRegister p-      bal = padleft 12 (showMixedAmountOrZeroWithoutPrice b)-      (da,de) = case ptransaction p of Just (Transaction{tdate=da',tdescription=de'}) -> (da',de')-                                       Nothing -> (nulldate,"")--tests_Register :: Test-tests_Register = TestList [--         "summarisePostings" ~: do-           summarisePostings Quarterly Nothing False (DateSpan Nothing Nothing) [] ~?= []--        ]

@@ -1,74 +0,0 @@-{-# LANGUAGE CPP #-}-{-|--Print some statistics for the ledger.---}--module Commands.Stats-where-import Ledger-import Options-#if __GLASGOW_HASKELL__ <= 610-import Prelude hiding ( putStr )-import System.IO.UTF8-#endif----- | Print various statistics for the ledger.-stats :: [Opt] -> [String] -> Ledger -> IO ()-stats opts args l = do-  today <- getCurrentDay-  putStr $ showStats opts args (cacheLedger' l) today--showStats :: [Opt] -> [String] -> Ledger -> Day -> String-showStats _ _ l today =-    heading ++ unlines (map (uncurry (printf fmt)) stats)-    where-      heading = underline $ printf "Ledger statistics as of %s" (show today)-      fmt = "%-" ++ show w1 ++ "s: %-" ++ show w2 ++ "s"-      w1 = maximum $ map (length . fst) stats-      w2 = maximum $ map (length . show . snd) stats-      stats = [-         ("File", filepath $ journal l)-        ,("Period", printf "%s to %s (%d days)" (start span) (end span) days)-        ,("Last transaction", maybe "none" show lastdate ++ showelapsed lastelapsed)-        ,("Transactions", printf "%d (%0.1f per day)" tnum txnrate)-        ,("Transactions last 30 days", printf "%d (%0.1f per day)" tnum30 txnrate30)-        ,("Transactions last 7 days", printf "%d (%0.1f per day)" tnum7 txnrate7)---        ,("Payees/descriptions", show $ length $ nub $ map tdescription ts)-        ,("Accounts", show $ length $ accounts l)-        ,("Account tree depth", show $ maximum $ map (accountNameLevel.aname) $ accounts l)-        ,("Commodities", printf "%s (%s)" (show $ length $ cs) (intercalate ", " $ sort $ map symbol cs)) -      -- Transactions this month     : %(monthtxns)s (last month in the same period: %(lastmonthtxns)s)-      -- Uncleared transactions      : %(uncleared)s-      -- Days since reconciliation   : %(reconcileelapsed)s-      -- Days since last transaction : %(recentelapsed)s-       ]-           where-             ts = sortBy (comparing tdate) $ jtxns $ journal l-             lastdate | null ts = Nothing-                      | otherwise = Just $ tdate $ last ts-             lastelapsed = maybe Nothing (Just . diffDays today) lastdate-             showelapsed Nothing = ""-             showelapsed (Just days) = printf " (%d %s)" days' direction-                                       where days' = abs days-                                             direction | days >= 0 = "days ago"-                                                       | otherwise = "days from now"-             tnum = length ts-             span = rawdatespan l-             start (DateSpan (Just d) _) = show d-             start _ = ""-             end (DateSpan _ (Just d)) = show d-             end _ = ""-             days = fromMaybe 0 $ daysInSpan span-             txnrate | days==0 = 0-                     | otherwise = fromIntegral tnum / fromIntegral days :: Double-             tnum30 = length $ filter withinlast30 ts-             withinlast30 t = d >= addDays (-30) today && (d<=today) where d = tdate t-             txnrate30 = fromIntegral tnum30 / 30 :: Double-             tnum7 = length $ filter withinlast7 ts-             withinlast7 t = d >= addDays (-7) today && (d<=today) where d = tdate t-             txnrate7 = fromIntegral tnum7 / 7 :: Double-             cs = commodities l-

@@ -1,371 +0,0 @@-{-| --A simple text UI for hledger, based on the vty library.---}--module Commands.UI-where-import Safe (headDef)-import Graphics.Vty-import Ledger-import Options-import Commands.Balance-import Commands.Register-import Commands.Print---helpmsg = "(b)alance, (r)egister, (p)rint, (right) to drill down, (left) to back up, (q)uit"--instance Show Vty where show = const "a Vty"---- | The application state when running the ui command.-data AppState = AppState {-     av :: Vty                   -- ^ the vty context-    ,aw :: Int                  -- ^ window width-    ,ah :: Int                  -- ^ window height-    ,amsg :: String              -- ^ status message-    ,aopts :: [Opt]              -- ^ command-line opts-    ,aargs :: [String]           -- ^ command-line args-    ,aledger :: Ledger           -- ^ parsed ledger-    ,abuf :: [String]            -- ^ lines of the current buffered view-    ,alocs :: [Loc]              -- ^ user's navigation trail within the UI-                                -- ^ never null, head is current location-    } deriving (Show)---- | A location within the user interface.-data Loc = Loc {-     scr :: Screen               -- ^ one of the available screens-    ,sy :: Int                   -- ^ viewport y scroll position-    ,cy :: Int                   -- ^ cursor y position-    } deriving (Show)---- | The screens available within the user interface.-data Screen = BalanceScreen     -- ^ like hledger balance, shows accounts-            | RegisterScreen    -- ^ like hledger register, shows transaction-postings-            | PrintScreen       -- ^ like hledger print, shows ledger transactions-            -- | LedgerScreen      -- ^ shows the raw ledger-              deriving (Eq,Show)---- | Run the interactive text ui.-ui :: [Opt] -> [String] -> Ledger -> IO ()-ui opts args l = do-  v <- mkVty-  DisplayRegion w h <- display_bounds $ terminal v-  let opts' = SubTotal:opts-  t <-  getCurrentLocalTime-  let a = enter t BalanceScreen-          AppState {-                  av=v-                 ,aw=fromIntegral w-                 ,ah=fromIntegral h-                 ,amsg=helpmsg-                 ,aopts=opts'-                 ,aargs=args-                 ,aledger=l-                 ,abuf=[]-                 ,alocs=[]-                 }-  go a ---- | Update the screen, wait for the next event, repeat.-go :: AppState -> IO ()-go a@AppState{av=av,aopts=opts} = do-  when (notElem DebugNoUI opts) $ update av (renderScreen a)-  k <- next_event av-  t <- getCurrentLocalTime-  case k of -    EvResize x y                -> go $ resize x y a-    EvKey (KASCII 'l') [MCtrl]  -> refresh av >> go a{amsg=helpmsg}-    EvKey (KASCII 'b') []       -> go $ resetTrailAndEnter t BalanceScreen a-    EvKey (KASCII 'r') []       -> go $ resetTrailAndEnter t RegisterScreen a-    EvKey (KASCII 'p') []       -> go $ resetTrailAndEnter t PrintScreen a-    EvKey KRight []             -> go $ drilldown t a-    EvKey KEnter []             -> go $ drilldown t a-    EvKey KLeft  []             -> go $ backout t a-    EvKey KUp    []             -> go $ moveUpAndPushEdge a-    EvKey KDown  []             -> go $ moveDownAndPushEdge a-    EvKey KHome  []             -> go $ moveToTop a-    EvKey KUp    [MCtrl]        -> go $ moveToTop a-    EvKey KUp    [MShift]       -> go $ moveToTop a-    EvKey KEnd   []             -> go $ moveToBottom a-    EvKey KDown  [MCtrl]        -> go $ moveToBottom a-    EvKey KDown  [MShift]       -> go $ moveToBottom a-    EvKey KPageUp []            -> go $ prevpage a-    EvKey KBS []                -> go $ prevpage a-    EvKey (KASCII ' ') [MShift] -> go $ prevpage a-    EvKey KPageDown []          -> go $ nextpage a-    EvKey (KASCII ' ') []       -> go $ nextpage a-    EvKey (KASCII 'q') []       -> shutdown av >> return ()---    EvKey KEsc   []           -> shutdown av >> return ()-    _                           -> go a---- app state modifiers---- | The number of lines currently available for the main data display area.-pageHeight :: AppState -> Int-pageHeight a = ah a - 1--setLocCursorY, setLocScrollY :: Int -> Loc -> Loc-setLocCursorY y l = l{cy=y}-setLocScrollY y l = l{sy=y}--cursorY, scrollY, posY :: AppState -> Int-cursorY = cy . loc-scrollY = sy . loc-posY a = scrollY a + cursorY a--setCursorY, setScrollY, setPosY :: Int -> AppState -> AppState-setCursorY _ AppState{alocs=[]} = error "shouldn't happen" -- silence warnings-setCursorY y a@AppState{alocs=(l:locs)} = a{alocs=(l':locs)} where l' = setLocCursorY y l--setScrollY _ AppState{alocs=[]} = error "shouldn't happen" -- silence warnings-setScrollY y a@AppState{alocs=(l:locs)} = a{alocs=(l':locs)} where l' = setLocScrollY y l--setPosY _ AppState{alocs=[]}    = error "shouldn't happen" -- silence warnings-setPosY y a@AppState{alocs=(l:locs)} = a{alocs=(l':locs)}-    where -      l' = setLocScrollY sy $ setLocCursorY cy l-      ph = pageHeight a-      cy = y `mod` ph-      sy = y - cy--updateCursorY, updateScrollY, updatePosY :: (Int -> Int) -> AppState -> AppState-updateCursorY f a = setCursorY (f $ cursorY a) a-updateScrollY f a = setScrollY (f $ scrollY a) a-updatePosY f a = setPosY (f $ posY a) a--resize :: Int -> Int -> AppState -> AppState-resize x y a = setCursorY cy' a{aw=x,ah=y}-    where-      cy = cursorY a-      cy' = min cy (y-2)--moveToTop :: AppState -> AppState-moveToTop = setPosY 0--moveToBottom :: AppState -> AppState-moveToBottom a = setPosY (length $ abuf a) a--moveUpAndPushEdge :: AppState -> AppState-moveUpAndPushEdge a-    | cy > 0 = updateCursorY (subtract 1) a-    | sy > 0 = updateScrollY (subtract 1) a-    | otherwise = a-    where Loc{sy=sy,cy=cy} = head $ alocs a--moveDownAndPushEdge :: AppState -> AppState-moveDownAndPushEdge a-    | sy+cy >= bh = a-    | cy < ph-1 = updateCursorY (+1) a-    | otherwise = updateScrollY (+1) a-    where -      Loc{sy=sy,cy=cy} = head $ alocs a-      ph = pageHeight a-      bh = length $ abuf a---- | Scroll down by page height or until we can just see the last line,--- without moving the cursor, or if we are already scrolled as far as--- possible then move the cursor to the last line.-nextpage :: AppState -> AppState-nextpage (a@AppState{abuf=b})-    | sy < bh-jump = setScrollY sy' a-    | otherwise    = setCursorY (bh-sy) a-    where-      sy = scrollY a-      jump = pageHeight a - 1-      bh = length b-      sy' = min (sy+jump) (bh-jump)---- | Scroll up by page height or until we can just see the first line,--- without moving the cursor, or if we are scrolled as far as possible--- then move the cursor to the first line.-prevpage :: AppState -> AppState-prevpage a-    | sy > 0    = setScrollY sy' a-    | otherwise = setCursorY 0 a-    where-      sy = scrollY a-      jump = pageHeight a - 1-      sy' = max (sy-jump) 0---- | Push a new UI location on to the stack.-pushLoc :: Loc -> AppState -> AppState-pushLoc l a = a{alocs=(l:alocs a)}--popLoc :: AppState -> AppState-popLoc a@AppState{alocs=locs}-    | length locs > 1 = a{alocs=drop 1 locs}-    | otherwise = a--clearLocs :: AppState -> AppState-clearLocs a = a{alocs=[]}--exit :: AppState -> AppState -exit = popLoc--loc :: AppState -> Loc-loc = head . alocs--screen :: AppState -> Screen-screen a = scr where (Loc scr _ _) = loc a---- | Enter a new screen, saving the old ui location on the stack.-enter :: LocalTime -> Screen -> AppState -> AppState-enter t scr@BalanceScreen a  = updateData t $ pushLoc Loc{scr=scr,sy=0,cy=0} a-enter t scr@RegisterScreen a = updateData t $ pushLoc Loc{scr=scr,sy=0,cy=0} a-enter t scr@PrintScreen a    = updateData t $ pushLoc Loc{scr=scr,sy=0,cy=0} a--resetTrailAndEnter t scr = enter t scr . clearLocs---- | Regenerate the display data appropriate for the current screen.-updateData :: LocalTime -> AppState -> AppState-updateData t a@AppState{aopts=opts,aargs=args,aledger=l} =-    case screen a of-      BalanceScreen  -> a{abuf=lines $ showBalanceReport opts (optsToFilterSpec opts args t) l, aargs=[]}-      RegisterScreen -> a{abuf=lines $ showRegisterReport opts (optsToFilterSpec opts args t) l}-      PrintScreen    -> a{abuf=lines $ showTransactions (optsToFilterSpec opts args t) l}--backout :: LocalTime -> AppState -> AppState-backout t a | screen a == BalanceScreen = a-            | otherwise = updateData t $ popLoc a--drilldown :: LocalTime -> AppState -> AppState-drilldown t a =-    case screen a of-      BalanceScreen  -> enter t RegisterScreen a{aargs=[currentAccountName a]}-      RegisterScreen -> scrollToTransaction e $ enter t PrintScreen a-      PrintScreen   -> a-    where e = currentTransaction a---- | Get the account name currently highlighted by the cursor on the--- balance screen. Results undefined while on other screens.-currentAccountName :: AppState -> AccountName-currentAccountName a = accountNameAt (abuf a) (posY a)---- | Get the full name of the account being displayed at a specific line--- within the balance command's output.-accountNameAt :: [String] -> Int -> AccountName-accountNameAt buf lineno = accountNameFromComponents anamecomponents-    where-      namestohere = map (drop 22) $ take (lineno+1) buf-      (indented, nonindented) = span (" " `isPrefixOf`) $ reverse namestohere-      thisbranch = indented ++ take 1 nonindented-      anamecomponents = reverse $ map strip $ dropsiblings thisbranch-      dropsiblings :: [AccountName] -> [AccountName]-      dropsiblings [] = []-      dropsiblings (x:xs) = x : dropsiblings xs'-          where-            xs' = dropWhile moreindented xs-            moreindented = (>= myindent) . indentof-            myindent = indentof x-            indentof = length . takeWhile (==' ')---- | If on the print screen, move the cursor to highlight the specified entry--- (or a reasonable guess). Doesn't work.-scrollToTransaction :: Maybe Transaction -> AppState -> AppState-scrollToTransaction Nothing a = a-scrollToTransaction (Just t) a@AppState{abuf=buf} = setCursorY cy $ setScrollY sy a-    where-      entryfirstline = head $ lines $ showTransaction t-      halfph = pageHeight a `div` 2-      y = fromMaybe 0 $ findIndex (== entryfirstline) buf-      sy = max 0 $ y - halfph-      cy = y - sy---- | Get the transaction containing the posting currently highlighted by--- the cursor on the register screen (or best guess). Results undefined--- while on other screens.-currentTransaction :: AppState -> Maybe Transaction-currentTransaction a@AppState{aledger=l,abuf=buf} = ptransaction p-    where-      p = headDef nullposting $ filter ismatch $ ledgerPostings l-      ismatch p = postingDate p == parsedate (take 10 datedesc)-                  && take 70 (showPostingWithBalance False p nullmixedamt) == (datedesc ++ acctamt)-      datedesc = take 32 $ fromMaybe "" $ find (not . (" " `isPrefixOf`)) $ headDef "" rest : reverse above-      acctamt = drop 32 $ headDef "" rest-      (above,rest) = splitAt y buf-      y = posY a---- renderers--renderScreen :: AppState -> Picture-renderScreen (a@AppState{aw=w,ah=h,abuf=buf,amsg=msg}) =-    Picture {pic_cursor = Cursor (fromIntegral cx) (fromIntegral cy)-            ,pic_image = mainimg-                         <->-                         renderStatus w msg-            ,pic_background = Background ' ' def_attr-            }-    where -      (cx, cy) = (0, cursorY a)-      sy = scrollY a---       mainimg = (renderString attr $ unlines $ above)---           <->---           (renderString reverseattr $ thisline)---           <->---           (renderString attr $ unlines $ below)---       (above,(thisline:below))---           | null ls   = ([],[""])---           | otherwise = splitAt y ls---       ls = lines $ fitto w (h-1) $ unlines $ drop as $ buf--- trying for more speed-      mainimg = vert_cat (map (string defaultattr) above)-               <->-               string currentlineattr thisline-               <->-               vert_cat (map (string defaultattr) below)-      (thisline,below) | null rest = (blankline,[])-                       | otherwise = (head rest, tail rest)-      (above,rest) = splitAt cy linestorender-      linestorender = map padclipline $ take (h-1) $ drop sy $ buf ++ replicate h blankline-      padclipline = take w . (++ blankline)-      blankline = replicate w ' '--padClipString :: Int -> Int -> String -> [String]-padClipString h w s = rows-    where-      rows = map padclipline $ take h $ lines s ++ replicate h blankline-      padclipline = take w . (++ blankline)-      blankline = replicate w ' '--renderString :: Attr -> String -> Image-renderString attr s = vert_cat $ map (string attr) rows-    where-      rows = lines $ fitto w h s-      w = maximum $ map length ls-      h = length ls-      ls = lines s--renderStatus :: Int -> String -> Image-renderStatus w = string statusattr . take w . (++ repeat ' ')---- the all-important theming engine!--theme = Restrained--data UITheme = Restrained | Colorful | Blood--(defaultattr, - currentlineattr, - statusattr- ) = case theme of-       Restrained -> (def_attr-                    ,def_attr `with_style` bold-                    ,def_attr `with_style` reverse_video-                    )-       Colorful   -> (def_attr `with_style` reverse_video-                    ,def_attr `with_fore_color` white `with_back_color` red-                    ,def_attr `with_fore_color` black `with_back_color` green-                    )-       Blood      -> (def_attr `with_style` reverse_video-                    ,def_attr `with_fore_color` white `with_back_color` red-                    ,def_attr `with_style` reverse_video-                    )--halfbrightattr = def_attr `with_style` dim-reverseattr = def_attr `with_style` reverse_video-redattr = def_attr `with_fore_color` red-greenattr = def_attr `with_fore_color` green-reverseredattr = def_attr `with_style` reverse_video `with_fore_color` red-reversegreenattr= def_attr `with_style` reverse_video `with_fore_color` green

@@ -1,389 +0,0 @@-{-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}-{-# OPTIONS_GHC -F -pgmFtrhsx #-}-{-| -A web-based UI.--}--module Commands.Web-where-#if __GLASGOW_HASKELL__ <= 610-import Codec.Binary.UTF8.String (decodeString)-#endif-import Control.Applicative.Error (Failing(Success,Failure))-import Control.Concurrent-import Control.Monad.Reader (ask)-import Data.IORef (newIORef, atomicModifyIORef)-import Network.HTTP (urlEncode, urlDecode)-import System.Directory (getModificationTime)-import System.IO.Storage (withStore, putValue, getValue)-import System.Time (ClockTime, getClockTime, diffClockTimes, TimeDiff(TimeDiff))-import Text.ParserCombinators.Parsec (parse)--import Hack.Contrib.Constants (_TextHtmlUTF8)-import Hack.Contrib.Response (set_content_type)-import qualified Hack (Env, http)-import qualified Hack.Contrib.Request (inputs, params, path)-import qualified Hack.Contrib.Response (redirect)-#ifdef WEBHAPPSTACK-import System.Process (readProcess)-import Hack.Handler.Happstack (runWithConfig,ServerConf(ServerConf))-#else-import Hack.Handler.SimpleServer (run)-#endif--import Network.Loli (loli, io, get, post, html, text, public)-import Network.Loli.Type (AppUnit)-import Network.Loli.Utils (update)--import HSP hiding (Request,catch)-import qualified HSP (Request(..))-import HSP.HTML (renderAsHTML)--import Commands.Add (ledgerAddTransaction)-import Commands.Balance-import Commands.Histogram-import Commands.Print-import Commands.Register-import Ledger-import Options hiding (value)-#ifdef MAKE-import Paths_hledger_make (getDataFileName)-#else-import Paths_hledger (getDataFileName)-#endif-import Utils (openBrowserOn)---- import Debug.Trace--- strace :: Show a => a -> a--- strace a = trace (show a) a--tcpport = 5000 :: Int-homeurl = printf "http://localhost:%d/" tcpport-browserdelay = 100000 -- microseconds--web :: [Opt] -> [String] -> Ledger -> IO ()-web opts args l = do-  unless (Debug `elem` opts) $ forkIO browser >> return ()-  server opts args l--browser :: IO ()-browser = putStrLn "starting web browser" >> threadDelay browserdelay >> openBrowserOn homeurl >> return ()--server :: [Opt] -> [String] -> Ledger -> IO ()-server opts args l =-  -- server initialisation-  withStore "hledger" $ do -- IO ()-    printf "starting web server on port %d\n" tcpport-    t <- getCurrentLocalTime-    webfiles <- getDataFileName "web"-    putValue "hledger" "ledger" l-#ifdef WEBHAPPSTACK-    hostname <- readProcess "hostname" [] "" `catch` \_ -> return "hostname"-    runWithConfig (ServerConf tcpport hostname) $            -- (Env -> IO Response) -> IO ()-#else-    run tcpport $            -- (Env -> IO Response) -> IO ()-#endif-      \env -> do -- IO Response-       -- general request handler-       let a = intercalate "+" $ reqparam env "a"-           p = intercalate "+" $ reqparam env "p"-           opts' = opts ++ [Period p]-           args' = args ++ (map urlDecode $ words a)-       l' <- fromJust `fmap` getValue "hledger" "ledger"-       l'' <- reloadIfChanged opts' args' l'-       -- declare path-specific request handlers-       let command :: [String] -> ([Opt] -> FilterSpec -> Ledger -> String) -> AppUnit-           command msgs f = string msgs $ f opts' (optsToFilterSpec opts' args' t) l''-       (loli $                                               -- State Loli () -> (Env -> IO Response)-         do-          get  "/balance"   $ command [] showBalanceReport  -- String -> ReaderT Env (StateT Response IO) () -> State Loli ()-          get  "/register"  $ command [] showRegisterReport-          get  "/histogram" $ command [] showHistogram-          get  "/transactions"   $ ledgerpage [] l'' (showTransactions (optsToFilterSpec opts' args' t))-          post "/transactions"   $ handleAddform l''-          get  "/env"       $ getenv >>= (text . show)-          get  "/params"    $ getenv >>= (text . show . Hack.Contrib.Request.params)-          get  "/inputs"    $ getenv >>= (text . show . Hack.Contrib.Request.inputs)-          public (Just webfiles) ["/style.css"]-          get  "/"          $ redirect ("transactions") Nothing-          ) env--getenv = ask-response = update-redirect u c = response $ Hack.Contrib.Response.redirect u c--reqparam :: Hack.Env -> String -> [String]-#if __GLASGOW_HASKELL__ <= 610-reqparam env p = map snd $ filter ((==p).fst) $ Hack.Contrib.Request.params env-#else-reqparam env p = map (decodeString.snd) $ filter ((==p).fst) $ Hack.Contrib.Request.params env-#endif--ledgerFileModifiedTime :: Ledger -> IO ClockTime-ledgerFileModifiedTime l-    | null path = getClockTime-    | otherwise = getModificationTime path `Prelude.catch` \_ -> getClockTime-    where path = filepath $ journal l--ledgerFileReadTime :: Ledger -> ClockTime-ledgerFileReadTime l = filereadtime $ journal l--reload :: Ledger -> IO Ledger-reload l = do-  l' <- readLedger (filepath $ journal l)-  putValue "hledger" "ledger" l'-  return l'-            -reloadIfChanged :: [Opt] -> [String] -> Ledger -> IO Ledger-reloadIfChanged opts _ l = do-  tmod <- ledgerFileModifiedTime l-  let tread = ledgerFileReadTime l-      newer = diffClockTimes tmod tread > (TimeDiff 0 0 0 0 0 0 0)-  -- when (Debug `elem` opts) $ printf "checking file, last modified %s, last read %s, %s\n" (show tmod) (show tread) (show newer)-  if newer-   then do-     when (Verbose `elem` opts) $ printf "%s has changed, reloading\n" (filepath $ journal l)-     reload l-   else return l---- refilter :: [Opt] -> [String] -> Ledger -> LocalTime -> IO Ledger--- refilter opts args l t = return $ filterAndCacheLedgerWithOpts opts args t (jtext $ journal l) (journal l)--ledgerpage :: [String] -> Ledger -> (Ledger -> String) -> AppUnit-ledgerpage msgs l f = do-  env <- getenv-  l' <- io $ reloadIfChanged [] [] l-  hsp msgs $ const <div><% addform env %><pre><% f l' %></pre></div>---- | A loli directive to serve a string in pre tags within the hledger web--- layout.-string :: [String] -> String -> AppUnit-string msgs s = hsp msgs $ const <pre><% s %></pre>---- | A loli directive to serve a hsp template wrapped in the hledger web--- layout. The hack environment is passed in to every hsp template as an--- argument, since I don't see how to get it within the hsp monad.--- A list of messages is also passed, eg for form errors.-hsp :: [String] -> (Hack.Env -> HSP XML) -> AppUnit-hsp msgs f = do-  env <- getenv-  let contenthsp = f env-      pagehsp = hledgerpage env msgs title contenthsp-  html =<< (io $ do-              hspenv <- hackEnvToHspEnv env-              (_,xml) <- runHSP html4Strict pagehsp hspenv-              return $ addDoctype $ renderAsHTML xml)-  response $ set_content_type _TextHtmlUTF8-    where-      title = ""-      addDoctype = ("<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">\n" ++)-      hackEnvToHspEnv :: Hack.Env -> IO HSPEnv-      hackEnvToHspEnv env = do-          x <- newIORef 0-          let req = HSP.Request (reqparam env) (Hack.http env)-              num = NumberGen (atomicModifyIORef x (\a -> (a+1,a)))-          return $ HSPEnv req num---- htmlToHsp :: Html -> HSP XML--- htmlToHsp h = return $ cdata $ showHtml h---- views--hledgerpage :: Hack.Env -> [String] -> String -> HSP XML -> HSP XML-hledgerpage env msgs title content =-    <html>-      <head>-        <meta http-equiv = "Content-Type" content = "text/html; charset=utf-8" />-        <link rel="stylesheet" type="text/css" href="/style.css" media="all" />-        <title><% title %></title>-      </head>-      <body>-        <% navbar env %>-        <div id="messages"><% intercalate ", " msgs %></div>-        <div id="content"><% content %></div>-      </body>-    </html>--navbar :: Hack.Env -> HSP XML-navbar env =-    <div id="navbar">-      <a href="http://hledger.org" id="hledgerorglink">hledger.org</a>-      <% navlinks env %>-      <% searchform env %>-      <a href="http://hledger.org/MANUAL.html" id="helplink">help</a>-    </div>--#if __GLASGOW_HASKELL__ <= 610-getParamOrNull p = (decodeString . fromMaybe "") `fmap` getParam p-#else-getParamOrNull p = fromMaybe "" `fmap` getParam p-#endif--navlinks :: Hack.Env -> HSP XML-navlinks _ = do-   a <- getParamOrNull "a"-   p <- getParamOrNull "p"-   let addparams=(++(printf "?a=%s&p=%s" (urlEncode a) (urlEncode p)))-       link s = <a href=(addparams s) class="navlink"><% s %></a>-   <div id="navlinks">-     <% link "transactions" %> |-     <% link "register" %> |-     <% link "balance" %>-    </div>--searchform :: Hack.Env -> HSP XML-searchform env = do-   a <- getParamOrNull "a"-   p <- getParamOrNull "p"-   let resetlink | null a && null p = <span></span>-                 | otherwise = <span id="resetlink"><% nbsp %><a href=u>reset</a></span>-                 where u = dropWhile (=='/') $ Hack.Contrib.Request.path env-   <form action="" id="searchform">-      <% nbsp %>search for:<% nbsp %><input name="a" size="20" value=a-      /><% help "filter-patterns"-      %><% nbsp %><% nbsp %>in reporting period:<% nbsp %><input name="p" size="20" value=p-      /><% help "period-expressions"-      %><input type="submit" name="submit" value="filter" style="display:none" />-      <% resetlink %>-    </form>--addform :: Hack.Env -> HSP XML-addform env = do-  today <- io $ liftM showDate $ getCurrentDay-  let inputs = Hack.Contrib.Request.inputs env-#if __GLASGOW_HASKELL__ <= 610-      date  = decodeString $ fromMaybe today $ lookup "date"  inputs-      desc  = decodeString $ fromMaybe "" $ lookup "desc"  inputs-#else-      date  = fromMaybe today $ lookup "date"  inputs-      desc  = fromMaybe "" $ lookup "desc"  inputs-#endif-  <div>-   <div id="addform">-   <form action="" method="POST">-    <table border="0">-      <tr>-        <td>-          Date: <input size="15" name="date" value=date /><% help "dates" %><% nbsp %>-          Description: <input size="35" name="desc" value=desc /><% nbsp %>-        </td>-      </tr>-      <% transactionfields 1 env %>-      <% transactionfields 2 env %>-      <tr id="addbuttonrow"><td><input type="submit" value="add transaction" -      /><% help "file-format" %></td></tr>-    </table>-   </form>-   </div>-   <br clear="all" />-   </div>--help :: String -> HSP XML-help topic = <a href=u>?</a>-    where u = printf "http://hledger.org/MANUAL.html%s" l :: String-          l | null topic = ""-            | otherwise = '#':topic--transactionfields :: Int -> Hack.Env -> HSP XML-transactionfields n env = do-  let inputs = Hack.Contrib.Request.inputs env-#if __GLASGOW_HASKELL__ <= 610-      acct = decodeString $ fromMaybe "" $ lookup acctvar inputs-      amt  = decodeString $ fromMaybe "" $ lookup amtvar  inputs-#else-      acct = fromMaybe "" $ lookup acctvar inputs-      amt  = fromMaybe "" $ lookup amtvar  inputs-#endif-  <tr>-    <td>-    <% nbsp %><% nbsp %>-      Account: <input size="35" name=acctvar value=acct /><% nbsp %>-      Amount: <input size="15" name=amtvar value=amt /><% nbsp %>-    </td>-   </tr>-    where-      numbered = (++ show n)-      acctvar = numbered "acct"-      amtvar = numbered "amt"--handleAddform :: Ledger -> AppUnit-handleAddform l = do-  env <- getenv-  d <- io getCurrentDay-  t <- io getCurrentLocalTime-  handle t $ validate env d-  where-    validate :: Hack.Env -> Day -> Failing Transaction-    validate env today =-        let inputs = Hack.Contrib.Request.inputs env-#if __GLASGOW_HASKELL__ <= 610-            date  = decodeString $ fromMaybe "today" $ lookup "date"  inputs-            desc  = decodeString $ fromMaybe "" $ lookup "desc"  inputs-            acct1 = decodeString $ fromMaybe "" $ lookup "acct1" inputs-            amt1  = decodeString $ fromMaybe "" $ lookup "amt1"  inputs-            acct2 = decodeString $ fromMaybe "" $ lookup "acct2" inputs-            amt2  = decodeString $ fromMaybe "" $ lookup "amt2"  inputs-#else-            date  = fromMaybe "today" $ lookup "date"  inputs-            desc  = fromMaybe "" $ lookup "desc"  inputs-            acct1 = fromMaybe "" $ lookup "acct1" inputs-            amt1  = fromMaybe "" $ lookup "amt1"  inputs-            acct2 = fromMaybe "" $ lookup "acct2" inputs-            amt2  = fromMaybe "" $ lookup "amt2"  inputs-#endif-            validateDate ""  = ["missing date"]-            validateDate _   = []-            validateDesc ""  = ["missing description"]-            validateDesc _   = []-            validateAcct1 "" = ["missing account 1"]-            validateAcct1 _  = []-            validateAmt1 ""  = ["missing amount 1"]-            validateAmt1 _   = []-            validateAcct2 "" = ["missing account 2"]-            validateAcct2 _  = []-            validateAmt2 _   = []-            amt1' = either (const missingamt) id $ parse someamount "" amt1-            amt2' = either (const missingamt) id $ parse someamount "" amt2-            (date', dateparseerr) = case fixSmartDateStrEither today date of-                                      Right d -> (d, [])-                                      Left e -> ("1900/01/01", [showDateParseError e])-            t = Transaction {-                            tdate = parsedate date' -- date' must be parseable-                           ,teffectivedate=Nothing-                           ,tstatus=False-                           ,tcode=""-                           ,tdescription=desc-                           ,tcomment=""-                           ,tpostings=[-                             Posting False acct1 amt1' "" RegularPosting (Just t')-                            ,Posting False acct2 amt2' "" RegularPosting (Just t')-                            ]-                           ,tpreceding_comment_lines=""-                           }-            (t', balanceerr) = case balanceTransaction t of-                           Right t'' -> (t'', [])-                           Left e -> (t, [head $ lines e]) -- show just the error not the transaction-            errs = concat [-                    validateDate date-                   ,dateparseerr-                   ,validateDesc desc-                   ,validateAcct1 acct1-                   ,validateAmt1 amt1-                   ,validateAcct2 acct2-                   ,validateAmt2 amt2-                   ,balanceerr-                   ]-        in-        case null errs of-          False -> Failure errs-          True  -> Success t'--    handle :: LocalTime -> Failing Transaction -> AppUnit-    handle _ (Failure errs) = hsp errs addform-    handle ti (Success t)   = do-                    io $ ledgerAddTransaction l t >> reload l-                    ledgerpage [msg] l (showTransactions (optsToFilterSpec [] [] ti))-       where msg = printf "Added transaction:\n%s" (show t)--nbsp :: XML-nbsp = cdata "&nbsp;"

@@ -0,0 +1,198 @@+{-# LANGUAGE CPP #-}+{-| ++A history-aware add command to help with data entry.++-}++module Hledger.Cli.Commands.Add+where+import Hledger.Data+import Hledger.Cli.Options+import Hledger.Cli.Commands.Register (showRegisterReport)+#if __GLASGOW_HASKELL__ <= 610+import Prelude hiding (putStr, putStrLn, getLine, appendFile)+import System.IO.UTF8+import System.IO ( stderr, hFlush )+#else+import System.IO ( stderr, hFlush, hPutStrLn, hPutStr )+#endif+import System.IO.Error+import Text.ParserCombinators.Parsec+import Hledger.Cli.Utils (journalFromStringWithOpts)+import qualified Data.Foldable as Foldable (find)++-- | Read ledger transactions from the terminal, prompting for each field,+-- and append them to the ledger file. If the ledger came from stdin, this+-- command has no effect.+add :: [Opt] -> [String] -> Journal -> IO ()+add opts args j+    | filepath j == "-" = return ()+    | otherwise = do+  hPutStrLn stderr $+    "Enter one or more transactions, which will be added to your ledger file.\n"+    ++"To complete a transaction, enter . as account name. To quit, press control-c."+  today <- getCurrentDay+  getAndAddTransactions j opts args today `catch` (\e -> unless (isEOFError e) $ ioError e)++-- | Read a number of transactions from the command line, prompting,+-- validating, displaying and appending them to the journal file, until+-- end of input (then raise an EOF exception). Any command-line arguments+-- are used as the first transaction's description.+getAndAddTransactions :: Journal -> [Opt] -> [String] -> Day -> IO ()+getAndAddTransactions j opts args defaultDate = do+  (t, d) <- getTransaction j opts args defaultDate+  j <- journalAddTransaction j t+  getAndAddTransactions j opts args d++-- | Read a transaction from the command line, with history-aware prompting.+getTransaction :: Journal -> [Opt] -> [String] -> Day -> IO (Transaction,Day)+getTransaction j opts args defaultDate = do+  today <- getCurrentDay+  datestr <- askFor "date" +            (Just $ showDate defaultDate)+            (Just $ \s -> null s || +             isRight (parse (smartdate >> many spacenonewline >> eof) "" $ lowercase s))+  description <- askFor "description" Nothing (Just $ not . null) +  let historymatches = transactionsSimilarTo j args description+      bestmatch | null historymatches = Nothing+                | otherwise = Just $ snd $ head historymatches+      bestmatchpostings = maybe Nothing (Just . tpostings) bestmatch+      date = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) datestr+      accept x = x == "." || (not . null) x &&+        if NoNewAccts `elem` opts+            then isJust $ Foldable.find (== x) ant+            else True+        where (ant,_,_,_) = groupPostings $ journalPostings j+      getpostingsandvalidate = do+        ps <- getPostings accept bestmatchpostings []+        let t = nulltransaction{tdate=date+                               ,tstatus=False+                               ,tdescription=description+                               ,tpostings=ps+                               }+            retry msg = do+              hPutStrLn stderr $ "\n" ++ msg ++ "please re-enter."+              getpostingsandvalidate+        either retry (return . flip (,) date) $ balanceTransaction t+  unless (null historymatches) +       (do+         hPutStrLn stderr "Similar transactions found, using the first for defaults:\n"+         hPutStr stderr $ concatMap (\(n,t) -> printf "[%3d%%] %s" (round $ n*100 :: Int) (show t)) $ take 3 historymatches)+  getpostingsandvalidate++-- | Read postings from the command line until . is entered, using the+-- provided historical postings, if any, to guess defaults.+getPostings :: (AccountName -> Bool) -> Maybe [Posting] -> [Posting] -> IO [Posting]+getPostings accept historicalps enteredps = do+  account <- askFor (printf "account %d" n) defaultaccount (Just accept)+  if account=="."+    then return enteredps+    else do+      amountstr <- askFor (printf "amount  %d" n) defaultamount validateamount+      let amount = fromparse $ parse (someamount <|> return missingamt) "" amountstr+      let p = nullposting{paccount=stripbrackets account,+                          pamount=amount,+                          ptype=postingtype account}+      getPostings accept historicalps $ enteredps ++ [p]+    where+      n = length enteredps + 1+      enteredrealps = filter isReal enteredps+      bestmatch | isNothing historicalps = Nothing+                | n <= length ps = Just $ ps !! (n-1)+                | otherwise = Nothing+                where Just ps = historicalps+      defaultaccount = maybe Nothing (Just . showacctname) bestmatch+      showacctname p = showAccountName Nothing (ptype p) $ paccount p+      defaultamount = maybe balancingamount (Just . show . pamount) bestmatch+          where balancingamount = Just $ show $ negate $ sumMixedAmountsPreservingHighestPrecision $ map pamount enteredrealps+      postingtype ('[':_) = BalancedVirtualPosting+      postingtype ('(':_) = VirtualPosting+      postingtype _ = RegularPosting+      stripbrackets = dropWhile (`elem` "([") . reverse . dropWhile (`elem` "])") . reverse+      validateamount = Just $ \s -> (null s && not (null enteredrealps))+                                   || isRight (parse (someamount>>many spacenonewline>>eof) "" s)++-- | Prompt for and read a string value, optionally with a default value+-- and a validator. A validator causes the prompt to repeat until the+-- input is valid. May also raise an EOF exception if control-d is pressed.+askFor :: String -> Maybe String -> Maybe (String -> Bool) -> IO String+askFor prompt def validator = do+  hPutStr stderr $ prompt ++ maybe "" showdef def ++ ": "+  hFlush stderr+  l <- getLine+  let input = if null l then fromMaybe l def else l+  case validator of+    Just valid -> if valid input+                   then return input+                   else askFor prompt def validator+    Nothing -> return input+    where showdef s = " [" ++ s ++ "]"++-- | Append this transaction to the journal's file. Also, to the journal's+-- transaction list, but we don't bother updating the other fields - this+-- is enough to include new transactions in the history matching.+journalAddTransaction :: Journal -> Transaction -> IO Journal+journalAddTransaction j@Journal{jtxns=ts} t = do+  appendToJournalFile j $ showTransaction t+  putStrLn $ printf "\nAdded transaction to %s:" (filepath j)+  putStrLn =<< registerFromString (show t)+  return j{jtxns=ts++[t]}++-- | Append data to the journal's file, ensuring proper separation from+-- any existing data; or if the file is "-", dump it to stdout.+appendToJournalFile :: Journal -> String -> IO ()+appendToJournalFile Journal{filepath=f, jtext=t} s =+    if f == "-"+    then putStr $ sep ++ s+    else appendFile f $ sep++s+    where +      -- XXX we are looking at the original raw text from when the ledger+      -- was first read, but that's good enough for now+      sep | null $ strip t = ""+          | otherwise = replicate (2 - min 2 (length lastnls)) '\n'+          where lastnls = takeWhile (=='\n') $ reverse t++-- | Convert a string of ledger data into a register report.+registerFromString :: String -> IO String+registerFromString s = do+  now <- getCurrentLocalTime+  l <- journalFromStringWithOpts [] s+  return $ showRegisterReport opts (optsToFilterSpec opts [] now) l+    where opts = [Empty]++-- | 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.+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+    where+      i = length $ intersect pairs1 pairs2+      u = length pairs1 + length pairs2+      pairs1 = wordLetterPairs $ uppercase s1+      pairs2 = wordLetterPairs $ uppercase s2+wordLetterPairs = concatMap letterPairs . words+letterPairs (a:b:rest) = [a,b] : letterPairs (b:rest)+letterPairs _ = []++compareDescriptions :: [Char] -> [Char] -> Double+compareDescriptions s t = compareStrings s' t'+    where s' = simplify s+          t' = simplify t+          simplify = filter (not . (`elem` "0123456789"))++transactionsSimilarTo :: Journal -> [String] -> String -> [(Double,Transaction)]+transactionsSimilarTo j apats s =+    sortBy compareRelevanceAndRecency+               $ filter ((> threshold).fst)+               [(compareDescriptions s $ tdescription t, t) | t <- ts]+    where+      compareRelevanceAndRecency (n1,t1) (n2,t2) = compare (n2,tdate t2) (n1,tdate t1)+      ts = jtxns $ filterJournalTransactionsByAccount apats j+      threshold = 0+

@@ -0,0 +1,67 @@+{-# LANGUAGE CPP #-}+{-| ++The Commands package defines all the commands offered by the hledger+application, like \"register\" and \"balance\".  This module exports all+the commands; you can also import individual modules if you prefer.++-}++module Hledger.Cli.Commands.All (+                     module Hledger.Cli.Commands.Add,+                     module Hledger.Cli.Commands.Balance,+                     module Hledger.Cli.Commands.Convert,+                     module Hledger.Cli.Commands.Histogram,+                     module Hledger.Cli.Commands.Print,+                     module Hledger.Cli.Commands.Register,+                     module Hledger.Cli.Commands.Stats,+#ifdef VTY+                     module Hledger.Cli.Commands.Vty,+#endif+#if defined(WEB) || defined(WEBHAPPSTACK)+                     module Hledger.Cli.Commands.Web,+#endif+#ifdef CHART+                     module Hledger.Cli.Commands.Chart,+#endif+                     tests_Hledger_Commands+              )+where+import Hledger.Cli.Commands.Add+import Hledger.Cli.Commands.Balance+import Hledger.Cli.Commands.Convert+import Hledger.Cli.Commands.Histogram+import Hledger.Cli.Commands.Print+import Hledger.Cli.Commands.Register+import Hledger.Cli.Commands.Stats+#ifdef VTY+import Hledger.Cli.Commands.Vty+#endif+#if defined(WEB) || defined(WEBHAPPSTACK)+import Hledger.Cli.Commands.Web+#endif+#ifdef CHART+import Hledger.Cli.Commands.Chart+#endif+import Test.HUnit (Test(TestList))+++tests_Hledger_Commands = TestList+    [+--      Hledger.Cli.Commands.Add.tests_Add+--     ,Hledger.Cli.Commands.Balance.tests_Balance+     Hledger.Cli.Commands.Convert.tests_Convert+--     ,Hledger.Cli.Commands.Histogram.tests_Histogram+--     ,Hledger.Cli.Commands.Print.tests_Print+    ,Hledger.Cli.Commands.Register.tests_Register+--     ,Hledger.Cli.Commands.Stats.tests_Stats+    ]+-- #ifdef VTY+--     ,Hledger.Cli.Commands.Vty.tests_Vty+-- #endif+-- #if defined(WEB) || defined(WEBHAPPSTACK)+--     ,Hledger.Cli.Commands.Web.tests_Web+-- #endif+-- #ifdef CHART+--     ,Hledger.Cli.Commands.Chart.tests_Chart+-- #endif

@@ -0,0 +1,165 @@+{-# LANGUAGE CPP #-}+{-|++A ledger-compatible @balance@ command.++ledger's balance command is easy to use but not easy to describe+precisely.  In the examples below we'll use sample.ledger, which has the+following account tree:++@+ assets+   bank+     checking+     saving+   cash+ expenses+   food+   supplies+ income+   gifts+   salary+ liabilities+   debts+@++The balance command shows accounts with their aggregate balances.+Subaccounts are displayed indented below their parent. Each balance is the+sum of any transactions in that account plus any balances from+subaccounts:++@+ $ hledger -f sample.ledger balance+                 $-1  assets+                  $1    bank:saving+                 $-2    cash+                  $2  expenses+                  $1    food+                  $1    supplies+                 $-2  income+                 $-1    gifts+                 $-1    salary+                  $1  liabilities:debts+@++Usually, the non-interesting accounts are elided or omitted. Above,+@checking@ is omitted because it has no subaccounts and a zero balance.+@bank@ is elided because it has only a single displayed subaccount+(@saving@) and it would be showing the same balance as that ($1). Ditto+for @liabilities@. We will return to this in a moment.++The --depth argument can be used to limit the depth of the balance report.+So, to see just the top level accounts:++@+$ hledger -f sample.ledger balance --depth 1+                 $-1  assets+                  $2  expenses+                 $-2  income+                  $1  liabilities+@++This time liabilities has no displayed subaccounts (due to --depth) and+is not elided.++With one or more account pattern arguments, the balance command shows+accounts whose name matches one of the patterns, plus their parents+(elided) and subaccounts. So with the pattern o we get:++@+ $ hledger -f sample.ledger balance o+                  $1  expenses:food+                 $-2  income+                 $-1    gifts+                 $-1    salary+--------------------+                 $-1+@++The o pattern matched @food@ and @income@, so they are shown. Unmatched+parents of matched accounts are also shown (elided) for context (@expenses@).++Also, the balance report shows the total of all displayed accounts, when+that is non-zero. Here, it is displayed because the accounts shown add up+to $-1.++Here is a more precise definition of \"interesting\" accounts in ledger's+balance report:++- an account which has just one interesting subaccount branch, and which+  is not at the report's maximum depth, is interesting if the balance is+  different from the subaccount's, and otherwise boring.++- any other account is interesting if it has a non-zero balance, or the -E+  flag is used.++-}++module Hledger.Cli.Commands.Balance+where+import Hledger.Data.Utils+import Hledger.Data.Types+import Hledger.Data.Amount+import Hledger.Data.AccountName+import Hledger.Data.Posting+import Hledger.Data.Ledger+import Hledger.Cli.Options+#if __GLASGOW_HASKELL__ <= 610+import Prelude hiding ( putStr )+import System.IO.UTF8+#endif+++-- | Print a balance report.+balance :: [Opt] -> [String] -> Journal -> IO ()+balance opts args j = do+  t <- getCurrentLocalTime+  putStr $ showBalanceReport opts (optsToFilterSpec opts args t) j++-- | Generate a balance report with the specified options for this ledger.+showBalanceReport :: [Opt] -> FilterSpec -> Journal -> String+showBalanceReport opts filterspec j = acctsstr ++ totalstr+    where+      l = journalToLedger filterspec j+      acctsstr = unlines $ map showacct interestingaccts+          where+            showacct = showInterestingAccount l interestingaccts+            interestingaccts = filter (isInteresting opts l) acctnames+            acctnames = sort $ tail $ flatten $ treemap aname accttree+            accttree = ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) l+      totalstr | NoTotal `elem` opts = ""+               | notElem Empty opts && isZeroMixedAmount total = ""+               | otherwise = printf "--------------------\n%s\n" $ padleft 20 $ showMixedAmountWithoutPrice total+          where+            total = sum $ map abalance $ ledgerTopAccounts l++-- | Display one line of the balance report with appropriate indenting and eliding.+showInterestingAccount :: Ledger -> [AccountName] -> AccountName -> String+showInterestingAccount l interestingaccts a = concatTopPadded [amt, "  ", depthspacer ++ partialname]+    where+      amt = padleft 20 $ showMixedAmountWithoutPrice $ abalance $ ledgerAccount l a+      parents = parentAccountNames a+      interestingparents = filter (`elem` interestingaccts) parents+      depthspacer = replicate (indentperlevel * length interestingparents) ' '+      indentperlevel = 2+      -- the partial name is the account's leaf name, prefixed by the+      -- names of any boring parents immediately above+      partialname = accountNameFromComponents $ reverse (map accountLeafName ps) ++ [accountLeafName a]+          where ps = takeWhile boring parents where boring = not . (`elem` interestingparents)++-- | Is the named account considered interesting for this ledger's balance report ?+isInteresting :: [Opt] -> Ledger -> AccountName -> Bool+isInteresting opts l a+    | numinterestingsubs==1 && not atmaxdepth = notlikesub+    | otherwise = notzero || emptyflag+    where+      atmaxdepth = isJust d && Just (accountNameLevel a) == d where d = depthFromOpts opts+      emptyflag = Empty `elem` opts+      acct = ledgerAccount l a+      notzero = not $ isZeroMixedAmount inclbalance where inclbalance = abalance acct+      notlikesub = not $ isZeroMixedAmount exclbalance where exclbalance = sumPostings $ apostings acct+      numinterestingsubs = length $ filter isInterestingTree subtrees+          where+            isInterestingTree = treeany (isInteresting opts l . aname)+            subtrees = map (fromJust . ledgerAccountTreeAt l) $ ledgerSubAccounts l $ ledgerAccount l a+

@@ -0,0 +1,108 @@+{-|++Generate balances pie chart++-}++module Hledger.Cli.Commands.Chart+where+import Hledger.Data.Utils+import Hledger.Data.Types+import Hledger.Data.Amount+import Hledger.Data.Ledger+import Hledger.Data.Commodity+import Hledger.Cli.Options++import Control.Monad (liftM3)+import Graphics.Rendering.Chart+import Data.Colour+import Data.Colour.Names+import Data.Colour.RGBSpace+import Data.Colour.RGBSpace.HSL (hsl)+import Data.Colour.SRGB.Linear (rgb)+import Data.List+import Safe (readDef)++-- | Generate an image with the pie chart and write it to a file+chart :: [Opt] -> [String] -> Journal -> IO ()+chart opts args j = do+  t <- getCurrentLocalTime+  let chart = genPie opts (optsToFilterSpec opts args t) j+  renderableToPNGFile (toRenderable chart) w h filename+    where+      filename = getOption opts ChartOutput chartoutput+      (w,h) = parseSize $ getOption opts ChartSize chartsize++-- | Extract string option value from a list of options or use the default+getOption :: [Opt] -> (String->Opt) -> String -> String+getOption opts opt def = +    case reverse $ optValuesForConstructor opt opts of+        [] -> def+        x:_ -> x++-- | Parse image size from a command-line option+parseSize :: String -> (Int,Int)+parseSize str = (read w, read h)+    where+    x = fromMaybe (error "Size should be in WIDTHxHEIGHT format") $ findIndex (=='x') str+    (w,_:h) = splitAt x str++-- | Generate pie chart+genPie :: [Opt] -> FilterSpec -> Journal -> PieLayout+genPie opts filterspec j = defaultPieLayout { pie_background_ = solidFillStyle $ opaque $ white+                                            , pie_plot_ = pie_chart }+    where+      pie_chart = defaultPieChart { pie_data_ = map (uncurry accountPieItem) chartitems'+                                  , pie_start_angle_ = (-90)+                                  , pie_colors_ = mkColours hue+                                  , pie_label_style_ = defaultFontStyle{font_size_=12}+                                  }+      chartitems' = debug "chart" $ top num samesignitems+      (samesignitems, sign) = sameSignNonZero rawitems+      rawitems = debug "raw" $ flatten $ balances $+                 ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) $ journalToLedger filterspec j+      top n t = topn ++ [other]+          where+            (topn,rest) = splitAt n $ reverse $ sortBy (comparing snd) t+            other = ("other", sum $ map snd rest)+      num = readDef (fromIntegral chartitems) (getOption opts ChartItems (show chartitems))+      hue = if sign > 0 then red else green where (red, green) = (0, 110)+      debug s = if Debug `elem` opts then ltrace s else id++-- | Select the nonzero items with same sign as the first, and make+-- them positive. Also return a 1 or -1 corresponding to the original sign.+sameSignNonZero :: [(AccountName, Double)] -> ([(AccountName, Double)], Int)+sameSignNonZero is | null nzs = ([], 1)+                   | otherwise = (map pos $ filter (test.snd) nzs, sign)+                   where+                     nzs = filter ((/=0).snd) is+                     pos (a,b) = (a, abs b)+                     sign = if snd (head nzs) >= 0 then 1 else (-1)+                     test = if sign > 0 then (>0) else (<0)++-- | Convert all quantities of MixedAccount to a single commodity+amountValue :: MixedAmount -> Double+amountValue = quantity . convertMixedAmountTo unknown++-- | Generate a tree of account names together with their balances.+--   The balance of account is decremented by the balance of its subaccounts+--   which are drawn on the chart.+balances :: Tree Account -> Tree (AccountName, Double)+balances (Node rootAcc subAccs) = Node newroot newsubs+    where+      newroot = (aname rootAcc,+                 amountValue $+                 abalance rootAcc - (sum . map (abalance . root)) subAccs)+      newsubs = map balances subAccs++-- | Build a single pie chart item+accountPieItem :: AccountName -> Double -> PieItem+accountPieItem accname balance = PieItem accname offset balance where offset = 0++-- | Generate an infinite color list suitable for charts.+mkColours :: Double -> [AlphaColour Double]+mkColours hue = cycle $ [opaque $ rgbToColour $ hsl h s l | (h,s,l) <- liftM3 (,,)+                         [hue] [0.7] [0.1,0.2..0.7] ]++rgbToColour :: (Fractional a) => RGB a -> Colour a+rgbToColour (RGB r g b) = rgb r g b

@@ -0,0 +1,386 @@+{-|+Convert account data in CSV format (eg downloaded from a bank) to ledger+format, and print it on stdout. See the manual for more details.+-}++module Hledger.Cli.Commands.Convert where+import Hledger.Cli.Options (Opt(Debug))+import Hledger.Cli.Version (versionstr)+import Hledger.Data.Types (Journal,AccountName,Transaction(..),Posting(..),PostingType(..))+import Hledger.Data.Utils (strip, spacenonewline, restofline, parseWithCtx, assertParse, assertParseEqual)+import Hledger.Data.Parse (someamount, emptyCtx, ledgeraccountname)+import Hledger.Data.Amount (nullmixedamt)+import Safe (atDef, maximumDef)+import System.IO (stderr)+import Text.CSV (parseCSVFromFile, printCSV)+import Text.Printf (hPrintf)+import Text.RegexPR (matchRegexPR, gsubRegexPR)+import Data.Maybe+import Hledger.Data.Dates (firstJust, showDate, parsedate)+import System.Locale (defaultTimeLocale)+import Data.Time.Format (parseTime)+import Control.Monad (when, guard, liftM)+import Safe (readDef, readMay)+import System.Directory (doesFileExist)+import System.Exit (exitFailure)+import System.FilePath.Posix (takeBaseName, replaceExtension)+import Text.ParserCombinators.Parsec+import Test.HUnit+++{- |+A set of data definitions and account-matching patterns sufficient to+convert a particular CSV data file into meaningful ledger transactions. See above.+-}+data CsvRules = CsvRules {+      dateField :: Maybe FieldPosition,+      statusField :: Maybe FieldPosition,+      codeField :: Maybe FieldPosition,+      descriptionField :: Maybe FieldPosition,+      amountField :: Maybe FieldPosition,+      currencyField :: Maybe FieldPosition,+      baseCurrency :: Maybe String,+      baseAccount :: AccountName,+      accountRules :: [AccountRule]+} deriving (Show, Eq)++nullrules = CsvRules {+      dateField=Nothing,+      statusField=Nothing,+      codeField=Nothing,+      descriptionField=Nothing,+      amountField=Nothing,+      currencyField=Nothing,+      baseCurrency=Nothing,+      baseAccount="unknown",+      accountRules=[]+}++type FieldPosition = Int++type AccountRule = (+   [(String, Maybe String)] -- list of regex match patterns with optional replacements+  ,AccountName              -- account name to use for a transaction matching this rule+  )++type CsvRecord = [String]+++-- | Read the CSV file named as an argument and print equivalent journal transactions,+-- using/creating a .rules file.+convert :: [Opt] -> [String] -> Journal -> IO ()+convert opts args _ = do+  when (null args) $ error "please specify a csv data file."+  let csvfile = head args+  csvparse <- parseCSVFromFile csvfile+  let records = case csvparse of+                  Left e -> error $ show e+                  Right rs -> reverse $ filter (/= [""]) rs+  let debug = Debug `elem` opts+      rulesfile = rulesFileFor csvfile+  exists <- doesFileExist rulesfile+  if (not exists) then do+                  hPrintf stderr "creating conversion rules file %s, edit this file for better results\n" rulesfile+                  writeFile rulesfile initialRulesFileContent+   else+      hPrintf stderr "using conversion rules file %s\n" rulesfile+  rules <- liftM (either (error.show) id) $ parseCsvRulesFile rulesfile+  when debug $ hPrintf stderr "rules: %s\n" (show rules)+  let requiredfields = max 2 (maxFieldIndex rules + 1)+      badrecords = take 1 $ filter ((< requiredfields).length) records+  if null badrecords+   then mapM_ (printTxn debug rules) records+   else do+     hPrintf stderr (unlines [+                      "Warning, at least one CSV record does not contain a field referenced by the"+                     ,"conversion rules file, or has less than two fields. Are you converting a"+                     ,"valid CSV file ? First bad record:\n%s"+                     ]) (show $ head badrecords)+     exitFailure++-- | The highest (0-based) field index referenced in the field+-- definitions, or -1 if no fields are defined.+maxFieldIndex :: CsvRules -> Int+maxFieldIndex r = maximumDef (-1) $ catMaybes [+                   dateField r+                  ,statusField r+                  ,codeField r+                  ,descriptionField r+                  ,amountField r+                  ,currencyField r+                  ]++rulesFileFor :: FilePath -> FilePath+rulesFileFor csvfile = replaceExtension csvfile ".rules"++initialRulesFileContent :: String+initialRulesFileContent =+    "# csv conversion rules file generated by hledger "++versionstr++"\n" +++    "# Add rules to this file for more accurate conversion, see\n"+++    "# http://hledger.org/MANUAL.html#convert\n" +++    "\n" +++    "base-account assets:bank:checking\n" +++    "date-field 0\n" +++    "description-field 4\n" +++    "amount-field 1\n" +++    "currency $\n" +++    "\n" +++    "# account-assigning rules\n" +++    "\n" +++    "SPECTRUM\n" +++    "expenses:health:gym\n" +++    "\n" +++    "ITUNES\n" +++    "BLKBSTR=BLOCKBUSTER\n" +++    "expenses:entertainment\n" +++    "\n" +++    "(TO|FROM) SAVINGS\n" +++    "assets:bank:savings\n"++-- rules file parser++parseCsvRulesFile :: FilePath -> IO (Either ParseError CsvRules)+parseCsvRulesFile f = do+  s <- readFile f+  return $ parseCsvRules f s++parseCsvRules :: FilePath -> String -> Either ParseError CsvRules+parseCsvRules rulesfile s = runParser csvrulesfile nullrules{baseAccount=takeBaseName rulesfile} rulesfile s++csvrulesfile :: GenParser Char CsvRules CsvRules+csvrulesfile = do+  many blankorcommentline+  many definitions+  r <- getState+  ars <- many accountrule+  many blankorcommentline+  eof+  return r{accountRules=ars}++-- | Real independent parser choice, even when alternative matches share a prefix.+choice' parsers = choice $ map try (init parsers) ++ [last parsers]++definitions :: GenParser Char CsvRules ()+definitions = do+  choice' [+    datefield+   ,statusfield+   ,codefield+   ,descriptionfield+   ,amountfield+   ,currencyfield+   ,basecurrency+   ,baseaccount+   ,commentline+   ] <?> "definition"+  return ()++datefield = do+  string "date-field"+  many1 spacenonewline+  v <- restofline+  r <- getState+  setState r{dateField=readMay v}++codefield = do+  string "code-field"+  many1 spacenonewline+  v <- restofline+  r <- getState+  setState r{codeField=readMay v}++statusfield = do+  string "status-field"+  many1 spacenonewline+  v <- restofline+  r <- getState+  setState r{statusField=readMay v}++descriptionfield = do+  string "description-field"+  many1 spacenonewline+  v <- restofline+  r <- getState+  setState r{descriptionField=readMay v}++amountfield = do+  string "amount-field"+  many1 spacenonewline+  v <- restofline+  r <- getState+  setState r{amountField=readMay v}++currencyfield = do+  string "currency-field"+  many1 spacenonewline+  v <- restofline+  r <- getState+  setState r{currencyField=readMay v}++basecurrency = do+  string "currency"+  many1 spacenonewline+  v <- restofline+  r <- getState+  setState r{baseCurrency=Just v}++baseaccount = do+  string "base-account"+  many1 spacenonewline+  v <- ledgeraccountname+  optional newline+  r <- getState+  setState r{baseAccount=v}++accountrule :: GenParser Char CsvRules AccountRule+accountrule = do+  many blankorcommentline+  pats <- many1 matchreplacepattern+  guard $ length pats >= 2+  let pats' = init pats+      acct = either (fail.show) id $ runParser ledgeraccountname () "" $ fst $ last pats+  many blankorcommentline+  return (pats',acct)+ <?> "account rule"++blanklines = many1 blankline >> return ()++blankline = many spacenonewline >> newline >> return () <?> "blank line"++commentchar = oneOf ";#"++commentline = many spacenonewline >> commentchar >> restofline >> return () <?> "comment line"++blankorcommentline = choice' [blankline, commentline]++matchreplacepattern = do+  notFollowedBy commentchar+  matchpat <- many1 (noneOf "=\n")+  replpat <- optionMaybe $ do {char '='; many $ noneOf "\n"}+  newline+  return (matchpat,replpat)++printTxn :: Bool -> CsvRules -> CsvRecord -> IO ()+printTxn debug rules rec = do+  when debug $ hPrintf stderr "record: %s" (printCSV [rec])+  putStr $ show $ transactionFromCsvRecord rules rec++-- csv record conversion++transactionFromCsvRecord :: CsvRules -> CsvRecord -> Transaction+transactionFromCsvRecord rules fields =+  let +      date = parsedate $ normaliseDate $ maybe "1900/1/1" (atDef "" fields) (dateField rules)+      status = maybe False (null . strip . (atDef "" fields)) (statusField rules)+      code = maybe "" (atDef "" fields) (codeField rules)+      desc = maybe "" (atDef "" fields) (descriptionField rules)+      comment = ""+      precomment = ""+      amountstr = maybe "" (atDef "" fields) (amountField rules)+      amountstr' = strnegate amountstr where strnegate ('-':s) = s+                                             strnegate s = '-':s+      currency = maybe (fromMaybe "" $ baseCurrency rules) (atDef "" fields) (currencyField rules)+      amountstr'' = currency ++ amountstr'+      amountparse = runParser someamount emptyCtx "" amountstr''+      amount = either (const nullmixedamt) id amountparse+      unknownacct | (readDef 0 amountstr' :: Double) < 0 = "income:unknown"+                  | otherwise = "expenses:unknown"+      (acct,newdesc) = identify (accountRules rules) unknownacct desc+      t = Transaction {+              tdate=date,+              teffectivedate=Nothing,+              tstatus=status,+              tcode=code,+              tdescription=newdesc,+              tcomment=comment,+              tpreceding_comment_lines=precomment,+              tpostings=[+                   Posting {+                     pstatus=False,+                     paccount=acct,+                     pamount=amount,+                     pcomment="",+                     ptype=RegularPosting,+                     ptransaction=Just t+                   },+                   Posting {+                     pstatus=False,+                     paccount=baseAccount rules,+                     pamount=(-amount),+                     pcomment="",+                     ptype=RegularPosting,+                     ptransaction=Just t+                   }+                  ]+            }+  in t++-- | Convert some date string with unknown format to YYYY/MM/DD.+normaliseDate :: String -> String+normaliseDate s = maybe "0000/00/00" showDate $+              firstJust+              [parseTime defaultTimeLocale "%Y/%m/%e" s+               -- can't parse a month without leading 0, try adding one+              ,parseTime defaultTimeLocale "%Y/%m/%e" (take 5 s ++ "0" ++ drop 5 s)+              ,parseTime defaultTimeLocale "%Y-%m-%e" s+              ,parseTime defaultTimeLocale "%Y-%m-%e" (take 5 s ++ "0" ++ drop 5 s)+              ,parseTime defaultTimeLocale "%m/%e/%Y" s+              ,parseTime defaultTimeLocale "%m/%e/%Y" ('0':s)+              ,parseTime defaultTimeLocale "%m-%e-%Y" s+              ,parseTime defaultTimeLocale "%m-%e-%Y" ('0':s)+              ]++-- | Apply account matching rules to a transaction description to obtain+-- the most appropriate account and a new description.+identify :: [AccountRule] -> String -> String -> (String,String)+identify rules defacct desc | null matchingrules = (defacct,desc)+                            | otherwise = (acct,newdesc)+    where+      matchingrules = filter ismatch rules :: [AccountRule]+          where ismatch = any (isJust . flip matchRegexPR (caseinsensitive desc) . fst) . fst+      (prs,acct) = head matchingrules+      p_ms_r = filter (\(_,m,_) -> isJust m) $ map (\(p,r) -> (p, matchRegexPR (caseinsensitive p) desc, r)) prs+      (p,_,r) = head p_ms_r+      newdesc = case r of Just rpat -> gsubRegexPR (caseinsensitive p) rpat desc+                          Nothing   -> desc++caseinsensitive = ("(?i)"++)++tests_Convert = TestList [++   "convert rules parsing: empty file" ~: do+     -- let assertMixedAmountParse parseresult mixedamount =+     --         (either (const "parse error") showMixedAmountDebug parseresult) ~?= (showMixedAmountDebug mixedamount)+    assertParseEqual (parseCsvRules "unknown" "") nullrules++  ,"convert rules parsing: accountrule" ~: do+     assertParseEqual (parseWithCtx nullrules accountrule "A\na\n") -- leading blank line required+                 ([("A",Nothing)], "a")++  ,"convert rules parsing: trailing comments" ~: do+     assertParse (parseWithCtx nullrules csvrulesfile "A\na\n# \n#\n")++  ,"convert rules parsing: trailing blank lines" ~: do+     assertParse (parseWithCtx nullrules csvrulesfile "A\na\n\n  \n")++  -- not supported+  -- ,"convert rules parsing: no final newline" ~: do+  --    assertParse (parseWithCtx nullrules csvrulesfile "A\na")+  --    assertParse (parseWithCtx nullrules csvrulesfile "A\na\n# \n#")+  --    assertParse (parseWithCtx nullrules csvrulesfile "A\na\n\n  ")++                 -- (nullrules{+                 --   -- dateField=Maybe FieldPosition,+                 --   -- statusField=Maybe FieldPosition,+                 --   -- codeField=Maybe FieldPosition,+                 --   -- descriptionField=Maybe FieldPosition,+                 --   -- amountField=Maybe FieldPosition,+                 --   -- currencyField=Maybe FieldPosition,+                 --   -- baseCurrency=Maybe String,+                 --   -- baseAccount=AccountName,+                 --   accountRules=[+                 --        ([("A",Nothing)], "a")+                 --       ]+                 --  })++  ]

@@ -0,0 +1,50 @@+{-# LANGUAGE CPP #-}+{-| ++Print a histogram report.++-}++module Hledger.Cli.Commands.Histogram+where+import Hledger.Data+import Hledger.Cli.Options+#if __GLASGOW_HASKELL__ <= 610+import Prelude hiding ( putStr )+import System.IO.UTF8+#endif+++barchar = '*'++-- | Print a histogram of some statistic per reporting interval, such as+-- number of postings per day.+histogram :: [Opt] -> [String] -> Journal -> IO ()+histogram opts args j = do+  t <- getCurrentLocalTime+  putStr $ showHistogram opts (optsToFilterSpec opts args t) j++showHistogram :: [Opt] -> FilterSpec -> Journal -> String+showHistogram opts filterspec j = concatMap (printDayWith countBar) dayps+    where+      i = intervalFromOpts opts+      interval | i == NoInterval = Daily+               | otherwise = i+      fullspan = journalDateSpan j+      days = filter (DateSpan Nothing Nothing /=) $ splitSpan interval fullspan+      dayps = [(s, filter (isPostingInDateSpan s) ps) | s <- days]+      -- same as Register+      -- should count transactions, not postings ?+      ps = sortBy (comparing postingDate) $ filterempties $ filter matchapats $ filterdepth $ journalPostings j+      filterempties+          | Empty `elem` opts = id+          | otherwise = filter (not . isZeroMixedAmount . pamount)+      matchapats = matchpats apats . paccount+      apats = acctpats filterspec+      filterdepth | interval == NoInterval = filter (\p -> accountNameLevel (paccount p) <= depth)+                  | otherwise = id+      depth = fromMaybe 99999 $ depthFromOpts opts++printDayWith f (DateSpan b _, ts) = printf "%s %s\n" (show $ fromJust b) (f ts)++countBar ps = replicate (length ps) barchar

@@ -0,0 +1,29 @@+{-# LANGUAGE CPP #-}+{-| ++A ledger-compatible @print@ command.++-}++module Hledger.Cli.Commands.Print+where+import Hledger.Data+import Hledger.Cli.Options+#if __GLASGOW_HASKELL__ <= 610+import Prelude hiding ( putStr )+import System.IO.UTF8+#endif+++-- | Print ledger transactions in standard format.+print' :: [Opt] -> [String] -> Journal -> IO ()+print' opts args j = do+  t <- getCurrentLocalTime+  putStr $ showTransactions (optsToFilterSpec opts args t) j++showTransactions :: FilterSpec -> Journal -> String+showTransactions filterspec j =+    concatMap (showTransactionForPrint effective) $ sortBy (comparing tdate) txns+        where+          effective = EffectiveDate == whichdate filterspec+          txns = jtxns $ filterJournalTransactions filterspec j

@@ -0,0 +1,150 @@+{-# LANGUAGE CPP #-}+{-| ++A ledger-compatible @register@ command.++-}++module Hledger.Cli.Commands.Register (+  register+ ,showRegisterReport+ ,showPostingWithBalance+ ,tests_Register+) where++import Safe (headMay, lastMay)+import Hledger.Data+import Hledger.Cli.Options+#if __GLASGOW_HASKELL__ <= 610+import Prelude hiding ( putStr )+import System.IO.UTF8+#endif+++-- | Print a register report.+register :: [Opt] -> [String] -> Journal -> IO ()+register opts args j = do+  t <- getCurrentLocalTime+  putStr $ showRegisterReport opts (optsToFilterSpec opts args t) j++-- | Generate the register report, which is a list of postings with transaction+-- info and a running balance.+showRegisterReport :: [Opt] -> FilterSpec -> Journal -> String+showRegisterReport opts filterspec j = showPostingsWithBalance ps nullposting startbal+    where+      ps | interval == NoInterval = displayableps+         | otherwise             = summarisePostings interval depth empty filterspan displayableps+      startbal = sumPostings precedingps+      (precedingps,displayableps,_) =+          postingsMatchingDisplayExpr (displayExprFromOpts opts) $ journalPostings $ filterJournalPostings filterspec j+      (interval, depth, empty) = (intervalFromOpts opts, depthFromOpts opts, Empty `elem` opts)+      filterspan = datespan filterspec++-- | Convert a list of postings into summary postings, one per interval.+summarisePostings :: Interval -> Maybe Int -> Bool -> DateSpan -> [Posting] -> [Posting]+summarisePostings interval depth empty filterspan ps = concatMap summarisespan $ splitSpan interval reportspan+    where+      summarisespan s = summarisePostingsInDateSpan s depth empty (postingsinspan s)+      postingsinspan s = filter (isPostingInDateSpan s) ps+      dataspan = postingsDateSpan ps+      reportspan | empty = filterspan `orDatesFrom` dataspan+                 | otherwise = dataspan++-- | Combine two datespans, filling any unspecified dates in the first+-- with dates from the second.+orDatesFrom (DateSpan a1 b1) (DateSpan a2 b2) = DateSpan a b+    where a = if isJust a1 then a1 else a2+          b = if isJust b1 then b1 else b2++-- | Date-sort and split a list of postings into three spans - postings matched+-- by the given display expression, and the preceding and following postings.+postingsMatchingDisplayExpr :: Maybe String -> [Posting] -> ([Posting],[Posting],[Posting])+postingsMatchingDisplayExpr d ps = (before, matched, after)+    where +      sorted = sortBy (comparing postingDate) ps+      (before, rest) = break (displayExprMatches d) sorted+      (matched, after) = span (displayExprMatches d) rest++-- | Does this display expression allow this posting to be displayed ?+-- Raises an error if the display expression can't be parsed.+displayExprMatches :: Maybe String -> Posting -> Bool+displayExprMatches Nothing  _ = True+displayExprMatches (Just d) p = (fromparse $ parsewith datedisplayexpr d) p+                        +-- XXX confusing, refactor+-- | Given a date span (representing a reporting interval) and a list of+-- postings within it: aggregate the postings so there is only one per+-- account, and adjust their date/description so that they will render+-- as a summary for this interval.+-- +-- As usual with date spans the end date is exclusive, but for display+-- purposes we show the previous day as end date, like ledger.+-- +-- When a depth argument is present, postings to accounts of greater+-- depth are aggregated where possible.+-- +-- The showempty flag forces the display of a zero-posting span+-- and also zero-posting accounts within the span.+summarisePostingsInDateSpan :: DateSpan -> Maybe Int -> Bool -> [Posting] -> [Posting]+summarisePostingsInDateSpan (DateSpan b e) depth showempty ps+    | null ps && (isNothing b || isNothing e) = []+    | null ps && showempty = [summaryp]+    | otherwise = summaryps'+    where+      summaryp = summaryPosting b' ("- "++ showDate (addDays (-1) e'))+      b' = fromMaybe (maybe nulldate postingDate $ headMay ps) b+      e' = fromMaybe (maybe (addDays 1 nulldate) postingDate $ lastMay ps) e+      summaryPosting date desc = nullposting{ptransaction=Just nulltransaction{tdate=date,tdescription=desc}}++      summaryps' = (if showempty then id else filter (not . isZeroMixedAmount . pamount)) summaryps+      summaryps = [summaryp{paccount=a,pamount=balancetoshowfor a} | a <- clippedanames]+      anames = sort $ nub $ map paccount ps+      -- aggregate balances by account, like journalToLedger, then do depth-clipping+      (_,_,exclbalof,inclbalof) = groupPostings ps+      clippedanames = nub $ map (clipAccountName d) anames+      isclipped a = accountNameLevel a >= d+      d = fromMaybe 99999 $ depth+      balancetoshowfor a =+          (if isclipped a then inclbalof else exclbalof) (if null a then "top" else a)++{- |+Show postings one per line, plus transaction info for the first posting of+each transaction, and a running balance. Eg:++@+date (10)  description (20)     account (22)            amount (11)  balance (12)+DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAA AAAAAAAAAAAA+                                aaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAA AAAAAAAAAAAA+@+-}+showPostingsWithBalance :: [Posting] -> Posting -> MixedAmount -> String+showPostingsWithBalance [] _ _ = ""+showPostingsWithBalance (p:ps) pprev bal = this ++ showPostingsWithBalance ps p bal'+    where+      this = showPostingWithBalance isfirst p bal'+      isfirst = ptransaction p /= ptransaction pprev+      bal' = bal + pamount p++-- | Show one posting and running balance, with or without transaction info.+showPostingWithBalance :: Bool -> Posting -> MixedAmount -> String+showPostingWithBalance withtxninfo p b = concatBottomPadded [txninfo ++ pstr ++ " ", bal] ++ "\n"+    where+      ledger3ishlayout = False+      datedescwidth = if ledger3ishlayout then 34 else 32+      txninfo = if withtxninfo then printf "%s %s " date desc else replicate datedescwidth ' '+      date = showDate da+      datewidth = 10+      descwidth = datedescwidth - datewidth - 2+      desc = printf ("%-"++(show descwidth)++"s") $ elideRight descwidth de :: String+      pstr = showPostingForRegister p+      bal = padleft 12 (showMixedAmountOrZeroWithoutPrice b)+      (da,de) = case ptransaction p of Just (Transaction{tdate=da',tdescription=de'}) -> (da',de')+                                       Nothing -> (nulldate,"")++tests_Register :: Test+tests_Register = TestList [++         "summarisePostings" ~: do+           summarisePostings Quarterly Nothing False (DateSpan Nothing Nothing) [] ~?= []++        ]

@@ -0,0 +1,75 @@+{-# LANGUAGE CPP #-}+{-|++Print some statistics for the ledger.++-}++module Hledger.Cli.Commands.Stats+where+import Hledger.Data+import Hledger.Cli.Options+#if __GLASGOW_HASKELL__ <= 610+import Prelude hiding ( putStr )+import System.IO.UTF8+#endif+import qualified Data.Map as Map+++-- | Print various statistics for the ledger.+stats :: [Opt] -> [String] -> Journal -> IO ()+stats opts args j = do+  today <- getCurrentDay+  putStr $ showStats opts args (journalToLedger nullfilterspec j) today++showStats :: [Opt] -> [String] -> Ledger -> Day -> String+showStats _ _ l today =+    heading ++ unlines (map (uncurry (printf fmt)) stats)+    where+      heading = underline $ printf "Ledger statistics as of %s" (show today)+      fmt = "%-" ++ show w1 ++ "s: %-" ++ show w2 ++ "s"+      w1 = maximum $ map (length . fst) stats+      w2 = maximum $ map (length . show . snd) stats+      stats = [+         ("File", filepath $ journal l)+        ,("Period", printf "%s to %s (%d days)" (start span) (end span) days)+        ,("Last transaction", maybe "none" show lastdate ++ showelapsed lastelapsed)+        ,("Transactions", printf "%d (%0.1f per day)" tnum txnrate)+        ,("Transactions last 30 days", printf "%d (%0.1f per day)" tnum30 txnrate30)+        ,("Transactions last 7 days", printf "%d (%0.1f per day)" tnum7 txnrate7)+--        ,("Payees/descriptions", show $ length $ nub $ map tdescription ts)+        ,("Accounts", show $ length $ accounts l)+        ,("Account tree depth", show $ maximum $ map (accountNameLevel.aname) $ accounts l)+        ,("Commodities", printf "%s (%s)" (show $ length $ cs) (intercalate ", " $ sort $ map symbol cs)) +      -- Transactions this month     : %(monthtxns)s (last month in the same period: %(lastmonthtxns)s)+      -- Uncleared transactions      : %(uncleared)s+      -- Days since reconciliation   : %(reconcileelapsed)s+      -- Days since last transaction : %(recentelapsed)s+       ]+           where+             ts = sortBy (comparing tdate) $ jtxns $ journal l+             lastdate | null ts = Nothing+                      | otherwise = Just $ tdate $ last ts+             lastelapsed = maybe Nothing (Just . diffDays today) lastdate+             showelapsed Nothing = ""+             showelapsed (Just days) = printf " (%d %s)" days' direction+                                       where days' = abs days+                                             direction | days >= 0 = "days ago"+                                                       | otherwise = "days from now"+             tnum = length ts+             span = rawdatespan l+             start (DateSpan (Just d) _) = show d+             start _ = ""+             end (DateSpan _ (Just d)) = show d+             end _ = ""+             days = fromMaybe 0 $ daysInSpan span+             txnrate | days==0 = 0+                     | otherwise = fromIntegral tnum / fromIntegral days :: Double+             tnum30 = length $ filter withinlast30 ts+             withinlast30 t = d >= addDays (-30) today && (d<=today) where d = tdate t+             txnrate30 = fromIntegral tnum30 / 30 :: Double+             tnum7 = length $ filter withinlast7 ts+             withinlast7 t = d >= addDays (-7) today && (d<=today) where d = tdate t+             txnrate7 = fromIntegral tnum7 / 7 :: Double+             cs = Map.elems $ commodities l+

@@ -0,0 +1,379 @@+{-| ++A simple text UI for hledger, based on the vty library.++-}++module Hledger.Cli.Commands.Vty+where+import Safe (headDef)+import Graphics.Vty+import Hledger.Data+import Hledger.Cli.Options+import Hledger.Cli.Commands.Balance+import Hledger.Cli.Commands.Register+import Hledger.Cli.Commands.Print+++helpmsg = "(b)alance, (r)egister, (p)rint, (right) to drill down, (left) to back up, (q)uit"++instance Show Vty where show = const "a Vty"++-- | The application state when running the vty command.+data AppState = AppState {+     av :: Vty                   -- ^ the vty context+    ,aw :: Int                  -- ^ window width+    ,ah :: Int                  -- ^ window height+    ,amsg :: String              -- ^ status message+    ,aopts :: [Opt]              -- ^ command-line opts+    ,aargs :: [String]           -- ^ command-line args at startup+    ,ajournal :: Journal         -- ^ parsed journal+    ,abuf :: [String]            -- ^ lines of the current buffered view+    ,alocs :: [Loc]              -- ^ user's navigation trail within the UI+                                -- ^ never null, head is current location+    } deriving (Show)++-- | A location within the user interface.+data Loc = Loc {+     scr :: Screen               -- ^ one of the available screens+    ,sy :: Int                   -- ^ viewport y scroll position+    ,cy :: Int                   -- ^ cursor y position+    ,largs :: [String]           -- ^ command-line args, possibly narrowed for this location+    } deriving (Show)++-- | The screens available within the user interface.+data Screen = BalanceScreen     -- ^ like hledger balance, shows accounts+            | RegisterScreen    -- ^ like hledger register, shows transaction-postings+            | PrintScreen       -- ^ like hledger print, shows ledger transactions+            -- | LedgerScreen      -- ^ shows the raw ledger+              deriving (Eq,Show)++-- | Run the vty (curses-style) ui.+vty :: [Opt] -> [String] -> Journal -> IO ()+vty opts args j = do+  v <- mkVty+  DisplayRegion w h <- display_bounds $ terminal v+  let opts' = SubTotal:opts+  t <-  getCurrentLocalTime+  let a = enter t BalanceScreen args+          AppState {+                  av=v+                 ,aw=fromIntegral w+                 ,ah=fromIntegral h+                 ,amsg=helpmsg+                 ,aopts=opts'+                 ,aargs=args+                 ,ajournal=j+                 ,abuf=[]+                 ,alocs=[]+                 }+  go a ++-- | Update the screen, wait for the next event, repeat.+go :: AppState -> IO ()+go a@AppState{av=av,aopts=opts} = do+  when (notElem DebugVty opts) $ update av (renderScreen a)+  k <- next_event av+  t <- getCurrentLocalTime+  case k of +    EvResize x y                -> go $ resize x y a+    EvKey (KASCII 'l') [MCtrl]  -> refresh av >> go a{amsg=helpmsg}+    EvKey (KASCII 'b') []       -> go $ resetTrailAndEnter t BalanceScreen a+    EvKey (KASCII 'r') []       -> go $ resetTrailAndEnter t RegisterScreen a+    EvKey (KASCII 'p') []       -> go $ resetTrailAndEnter t PrintScreen a+    EvKey KRight []             -> go $ drilldown t a+    EvKey KEnter []             -> go $ drilldown t a+    EvKey KLeft  []             -> go $ backout t a+    EvKey KUp    []             -> go $ moveUpAndPushEdge a+    EvKey KDown  []             -> go $ moveDownAndPushEdge a+    EvKey KHome  []             -> go $ moveToTop a+    EvKey KUp    [MCtrl]        -> go $ moveToTop a+    EvKey KUp    [MShift]       -> go $ moveToTop a+    EvKey KEnd   []             -> go $ moveToBottom a+    EvKey KDown  [MCtrl]        -> go $ moveToBottom a+    EvKey KDown  [MShift]       -> go $ moveToBottom a+    EvKey KPageUp []            -> go $ prevpage a+    EvKey KBS []                -> go $ prevpage a+    EvKey (KASCII ' ') [MShift] -> go $ prevpage a+    EvKey KPageDown []          -> go $ nextpage a+    EvKey (KASCII ' ') []       -> go $ nextpage a+    EvKey (KASCII 'q') []       -> shutdown av >> return ()+--    EvKey KEsc   []           -> shutdown av >> return ()+    _                           -> go a++-- app state modifiers++-- | The number of lines currently available for the main data display area.+pageHeight :: AppState -> Int+pageHeight a = ah a - 1++setLocCursorY, setLocScrollY :: Int -> Loc -> Loc+setLocCursorY y l = l{cy=y}+setLocScrollY y l = l{sy=y}++cursorY, scrollY, posY :: AppState -> Int+cursorY = cy . loc+scrollY = sy . loc+posY a = scrollY a + cursorY a++setCursorY, setScrollY, setPosY :: Int -> AppState -> AppState+setCursorY _ AppState{alocs=[]} = error "shouldn't happen" -- silence warnings+setCursorY y a@AppState{alocs=(l:locs)} = a{alocs=(l':locs)} where l' = setLocCursorY y l++setScrollY _ AppState{alocs=[]} = error "shouldn't happen" -- silence warnings+setScrollY y a@AppState{alocs=(l:locs)} = a{alocs=(l':locs)} where l' = setLocScrollY y l++setPosY _ AppState{alocs=[]}    = error "shouldn't happen" -- silence warnings+setPosY y a@AppState{alocs=(l:locs)} = a{alocs=(l':locs)}+    where +      l' = setLocScrollY sy $ setLocCursorY cy l+      ph = pageHeight a+      cy = y `mod` ph+      sy = y - cy++updateCursorY, updateScrollY, updatePosY :: (Int -> Int) -> AppState -> AppState+updateCursorY f a = setCursorY (f $ cursorY a) a+updateScrollY f a = setScrollY (f $ scrollY a) a+updatePosY f a = setPosY (f $ posY a) a++resize :: Int -> Int -> AppState -> AppState+resize x y a = setCursorY cy' a{aw=x,ah=y}+    where+      cy = cursorY a+      cy' = min cy (y-2)++moveToTop :: AppState -> AppState+moveToTop = setPosY 0++moveToBottom :: AppState -> AppState+moveToBottom a = setPosY (length $ abuf a) a++moveUpAndPushEdge :: AppState -> AppState+moveUpAndPushEdge a+    | cy > 0 = updateCursorY (subtract 1) a+    | sy > 0 = updateScrollY (subtract 1) a+    | otherwise = a+    where Loc{sy=sy,cy=cy} = head $ alocs a++moveDownAndPushEdge :: AppState -> AppState+moveDownAndPushEdge a+    | sy+cy >= bh = a+    | cy < ph-1 = updateCursorY (+1) a+    | otherwise = updateScrollY (+1) a+    where +      Loc{sy=sy,cy=cy} = head $ alocs a+      ph = pageHeight a+      bh = length $ abuf a++-- | Scroll down by page height or until we can just see the last line,+-- without moving the cursor, or if we are already scrolled as far as+-- possible then move the cursor to the last line.+nextpage :: AppState -> AppState+nextpage (a@AppState{abuf=b})+    | sy < bh-jump = setScrollY sy' a+    | otherwise    = setCursorY (bh-sy) a+    where+      sy = scrollY a+      jump = pageHeight a - 1+      bh = length b+      sy' = min (sy+jump) (bh-jump)++-- | Scroll up by page height or until we can just see the first line,+-- without moving the cursor, or if we are scrolled as far as possible+-- then move the cursor to the first line.+prevpage :: AppState -> AppState+prevpage a+    | sy > 0    = setScrollY sy' a+    | otherwise = setCursorY 0 a+    where+      sy = scrollY a+      jump = pageHeight a - 1+      sy' = max (sy-jump) 0++-- | Push a new UI location on to the stack.+pushLoc :: Loc -> AppState -> AppState+pushLoc l a = a{alocs=(l:alocs a)}++popLoc :: AppState -> AppState+popLoc a@AppState{alocs=locs}+    | length locs > 1 = a{alocs=drop 1 locs}+    | otherwise = a++clearLocs :: AppState -> AppState+clearLocs a = a{alocs=[]}++exit :: AppState -> AppState +exit = popLoc++loc :: AppState -> Loc+loc = head . alocs++-- | Get the filter pattern args in effect for the current ui location.+currentArgs :: AppState -> [String]+currentArgs (AppState {alocs=Loc{largs=as}:_}) = as+currentArgs (AppState {aargs=as}) = as++screen :: AppState -> Screen+screen a = scr where (Loc scr _ _ _) = loc a++-- | Enter a new screen, with possibly new args, adding the new ui location to the stack.+enter :: LocalTime -> Screen -> [String] -> AppState -> AppState+enter t scr@BalanceScreen args a  = updateData t $ pushLoc Loc{scr=scr,sy=0,cy=0,largs=args} a+enter t scr@RegisterScreen args a = updateData t $ pushLoc Loc{scr=scr,sy=0,cy=0,largs=args} a+enter t scr@PrintScreen args a    = updateData t $ pushLoc Loc{scr=scr,sy=0,cy=0,largs=args} a++resetTrailAndEnter :: LocalTime -> Screen -> AppState -> AppState+resetTrailAndEnter t scr a = enter t scr (aargs a) $ clearLocs a++-- | Regenerate the display data appropriate for the current screen.+updateData :: LocalTime -> AppState -> AppState+updateData t a@AppState{aopts=opts,ajournal=j} =+    case screen a of+      BalanceScreen  -> a{abuf=lines $ showBalanceReport opts fspec j}+      RegisterScreen -> a{abuf=lines $ showRegisterReport opts fspec j}+      PrintScreen    -> a{abuf=lines $ showTransactions fspec j}+    where fspec = optsToFilterSpec opts (currentArgs a) t++backout :: LocalTime -> AppState -> AppState+backout t a | screen a == BalanceScreen = a+            | otherwise = updateData t $ popLoc a++drilldown :: LocalTime -> AppState -> AppState+drilldown t a =+    case screen a of+      BalanceScreen  -> enter t RegisterScreen [currentAccountName a] a+      RegisterScreen -> scrollToTransaction e $ enter t PrintScreen (currentArgs a) a+      PrintScreen   -> a+    where e = currentTransaction a++-- | Get the account name currently highlighted by the cursor on the+-- balance screen. Results undefined while on other screens.+currentAccountName :: AppState -> AccountName+currentAccountName a = accountNameAt (abuf a) (posY a)++-- | Get the full name of the account being displayed at a specific line+-- within the balance command's output.+accountNameAt :: [String] -> Int -> AccountName+accountNameAt buf lineno = accountNameFromComponents anamecomponents+    where+      namestohere = map (drop 22) $ take (lineno+1) buf+      (indented, nonindented) = span (" " `isPrefixOf`) $ reverse namestohere+      thisbranch = indented ++ take 1 nonindented+      anamecomponents = reverse $ map strip $ dropsiblings thisbranch+      dropsiblings :: [AccountName] -> [AccountName]+      dropsiblings [] = []+      dropsiblings (x:xs) = x : dropsiblings xs'+          where+            xs' = dropWhile moreindented xs+            moreindented = (>= myindent) . indentof+            myindent = indentof x+            indentof = length . takeWhile (==' ')++-- | If on the print screen, move the cursor to highlight the specified entry+-- (or a reasonable guess). Doesn't work.+scrollToTransaction :: Maybe Transaction -> AppState -> AppState+scrollToTransaction Nothing a = a+scrollToTransaction (Just t) a@AppState{abuf=buf} = setCursorY cy $ setScrollY sy a+    where+      entryfirstline = head $ lines $ showTransaction t+      halfph = pageHeight a `div` 2+      y = fromMaybe 0 $ findIndex (== entryfirstline) buf+      sy = max 0 $ y - halfph+      cy = y - sy++-- | Get the transaction containing the posting currently highlighted by+-- the cursor on the register screen (or best guess). Results undefined+-- while on other screens.+currentTransaction :: AppState -> Maybe Transaction+currentTransaction a@AppState{ajournal=j,abuf=buf} = ptransaction p+    where+      p = headDef nullposting $ filter ismatch $ journalPostings j+      ismatch p = postingDate p == parsedate (take 10 datedesc)+                  && take 70 (showPostingWithBalance False p nullmixedamt) == (datedesc ++ acctamt)+      datedesc = take 32 $ fromMaybe "" $ find (not . (" " `isPrefixOf`)) $ headDef "" rest : reverse above+      acctamt = drop 32 $ headDef "" rest+      (above,rest) = splitAt y buf+      y = posY a++-- renderers++renderScreen :: AppState -> Picture+renderScreen (a@AppState{aw=w,ah=h,abuf=buf,amsg=msg}) =+    Picture {pic_cursor = Cursor (fromIntegral cx) (fromIntegral cy)+            ,pic_image = mainimg+                         <->+                         renderStatus w msg+            ,pic_background = Background ' ' def_attr+            }+    where +      (cx, cy) = (0, cursorY a)+      sy = scrollY a+--       mainimg = (renderString attr $ unlines $ above)+--           <->+--           (renderString reverseattr $ thisline)+--           <->+--           (renderString attr $ unlines $ below)+--       (above,(thisline:below))+--           | null ls   = ([],[""])+--           | otherwise = splitAt y ls+--       ls = lines $ fitto w (h-1) $ unlines $ drop as $ buf+-- trying for more speed+      mainimg = vert_cat (map (string defaultattr) above)+               <->+               string currentlineattr thisline+               <->+               vert_cat (map (string defaultattr) below)+      (thisline,below) | null rest = (blankline,[])+                       | otherwise = (head rest, tail rest)+      (above,rest) = splitAt cy linestorender+      linestorender = map padclipline $ take (h-1) $ drop sy $ buf ++ replicate h blankline+      padclipline = take w . (++ blankline)+      blankline = replicate w ' '++padClipString :: Int -> Int -> String -> [String]+padClipString h w s = rows+    where+      rows = map padclipline $ take h $ lines s ++ replicate h blankline+      padclipline = take w . (++ blankline)+      blankline = replicate w ' '++renderString :: Attr -> String -> Image+renderString attr s = vert_cat $ map (string attr) rows+    where+      rows = lines $ fitto w h s+      w = maximum $ map length ls+      h = length ls+      ls = lines s++renderStatus :: Int -> String -> Image+renderStatus w = string statusattr . take w . (++ repeat ' ')++-- the all-important theming engine!++theme = Restrained++data UITheme = Restrained | Colorful | Blood++(defaultattr, + currentlineattr, + statusattr+ ) = case theme of+       Restrained -> (def_attr+                    ,def_attr `with_style` bold+                    ,def_attr `with_style` reverse_video+                    )+       Colorful   -> (def_attr `with_style` reverse_video+                    ,def_attr `with_fore_color` white `with_back_color` red+                    ,def_attr `with_fore_color` black `with_back_color` green+                    )+       Blood      -> (def_attr `with_style` reverse_video+                    ,def_attr `with_fore_color` white `with_back_color` red+                    ,def_attr `with_style` reverse_video+                    )++halfbrightattr = def_attr `with_style` dim+reverseattr = def_attr `with_style` reverse_video+redattr = def_attr `with_fore_color` red+greenattr = def_attr `with_fore_color` green+reverseredattr = def_attr `with_style` reverse_video `with_fore_color` red+reversegreenattr= def_attr `with_style` reverse_video `with_fore_color` green

@@ -0,0 +1,345 @@+{-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}+{-# OPTIONS_GHC -F -pgmFtrhsx #-}+{-| +A web-based UI.+-}++module Hledger.Cli.Commands.Web+where+import Codec.Binary.UTF8.String (decodeString)+import Control.Applicative.Error (Failing(Success,Failure))+import Control.Concurrent+import Control.Monad.Reader (ask)+import Data.IORef (newIORef, atomicModifyIORef)+import System.Directory (getModificationTime)+import System.IO.Storage (withStore, putValue, getValue)+import System.Time (ClockTime, getClockTime, diffClockTimes, TimeDiff(TimeDiff))+import Text.ParserCombinators.Parsec (parse)++import Hack.Contrib.Constants (_TextHtmlUTF8)+import Hack.Contrib.Response (set_content_type)+import qualified Hack (Env, http)+import qualified Hack.Contrib.Request (inputs, params, path)+import qualified Hack.Contrib.Response (redirect)+#ifdef WEBHAPPSTACK+import System.Process (readProcess)+import Hack.Handler.Happstack (runWithConfig,ServerConf(ServerConf))+#else+import Hack.Handler.SimpleServer (run)+#endif++import Network.Loli (loli, io, get, post, html, text, public)+import Network.Loli.Type (AppUnit)+import Network.Loli.Utils (update)++import HSP hiding (Request,catch)+import qualified HSP (Request(..))++import Hledger.Cli.Commands.Add (journalAddTransaction)+import Hledger.Cli.Commands.Balance+import Hledger.Cli.Commands.Histogram+import Hledger.Cli.Commands.Print+import Hledger.Cli.Commands.Register+import Hledger.Data+import Hledger.Cli.Options hiding (value)+#ifdef MAKE+import Paths_hledger_make (getDataFileName)+#else+import Paths_hledger (getDataFileName)+#endif+import Hledger.Cli.Utils (openBrowserOn)+++tcpport = 5000 :: Int+homeurl = printf "http://localhost:%d/" tcpport+browserdelay = 100000 -- microseconds++web :: [Opt] -> [String] -> Journal -> IO ()+web opts args j = do+  unless (Debug `elem` opts) $ forkIO browser >> return ()+  server opts args j++browser :: IO ()+browser = putStrLn "starting web browser" >> threadDelay browserdelay >> openBrowserOn homeurl >> return ()++server :: [Opt] -> [String] -> Journal -> IO ()+server opts args j =+  -- server initialisation+  withStore "hledger" $ do -- IO ()+    printf "starting web server on port %d\n" tcpport+    t <- getCurrentLocalTime+    webfiles <- getDataFileName "web"+    putValue "hledger" "journal" j+#ifdef WEBHAPPSTACK+    hostname <- readProcess "hostname" [] "" `catch` \_ -> return "hostname"+    runWithConfig (ServerConf tcpport hostname) $            -- (Env -> IO Response) -> IO ()+#else+    run tcpport $            -- (Env -> IO Response) -> IO ()+#endif+      \env -> do -- IO Response+       -- general request handler+       let opts' = opts ++ [Period $ unwords $ map decodeString $ reqParamUtf8 env "p"]+           args' = args ++ map decodeString (reqParamUtf8 env "a")+       j' <- fromJust `fmap` getValue "hledger" "journal"+       j'' <- journalReloadIfChanged opts' args' j'+       -- declare path-specific request handlers+       let command :: [String] -> ([Opt] -> FilterSpec -> Journal -> String) -> AppUnit+           command msgs f = string msgs $ f opts' (optsToFilterSpec opts' args' t) j''+       (loli $                                               -- State Loli () -> (Env -> IO Response)+         do+          get  "/balance"   $ command [] showBalanceReport  -- String -> ReaderT Env (StateT Response IO) () -> State Loli ()+          get  "/register"  $ command [] showRegisterReport+          get  "/histogram" $ command [] showHistogram+          get  "/transactions"   $ ledgerpage [] j'' (showTransactions (optsToFilterSpec opts' args' t))+          post "/transactions"   $ handleAddform j''+          get  "/env"       $ getenv >>= (text . show)+          get  "/params"    $ getenv >>= (text . show . Hack.Contrib.Request.params)+          get  "/inputs"    $ getenv >>= (text . show . Hack.Contrib.Request.inputs)+          public (Just webfiles) ["/style.css"]+          get  "/"          $ redirect ("transactions") Nothing+          ) env++getenv = ask+response = update+redirect u c = response $ Hack.Contrib.Response.redirect u c++reqParamUtf8 :: Hack.Env -> String -> [String]+reqParamUtf8 env p = map snd $ filter ((==p).fst) $ Hack.Contrib.Request.params env++journalReloadIfChanged :: [Opt] -> [String] -> Journal -> IO Journal+journalReloadIfChanged opts _ j@Journal{filepath=f,filereadtime=tread} = do+  tmod <- journalFileModifiedTime j+  let newer = diffClockTimes tmod tread > (TimeDiff 0 0 0 0 0 0 0)+  -- when (Debug `elem` opts) $ printf "checking file, last modified %s, last read %s, %s\n" (show tmod) (show tread) (show newer)+  if newer+   then do+     when (Verbose `elem` opts) $ printf "%s has changed, reloading\n" f+     reload j+   else return j++journalFileModifiedTime :: Journal -> IO ClockTime+journalFileModifiedTime Journal{filepath=f}+    | null f = getClockTime+    | otherwise = getModificationTime f `Prelude.catch` \_ -> getClockTime++reload :: Journal -> IO Journal+reload Journal{filepath=f} = do+  j' <- readJournal f+  putValue "hledger" "journal" j'+  return j'+            +ledgerpage :: [String] -> Journal -> (Journal -> String) -> AppUnit+ledgerpage msgs j f = do+  env <- getenv+  j' <- io $ journalReloadIfChanged [] [] j+  hsp msgs $ const <div><% addform env %><pre><% f j' %></pre></div>++-- | A loli directive to serve a string in pre tags within the hledger web+-- layout.+string :: [String] -> String -> AppUnit+string msgs s = hsp msgs $ const <pre><% s %></pre>++-- | A loli directive to serve a hsp template wrapped in the hledger web+-- layout. The hack environment is passed in to every hsp template as an+-- argument, since I don't see how to get it within the hsp monad.+-- A list of messages is also passed, eg for form errors.+hsp :: [String] -> (Hack.Env -> HSP XML) -> AppUnit+hsp msgs f = do+  env <- getenv+  let contenthsp = f env+      pagehsp = hledgerpage env msgs title contenthsp+  html =<< (io $ do+              hspenv <- hackEnvToHspEnv env+              (_,xml) <- runHSP html4Strict pagehsp hspenv+              return $ addDoctype $ renderAsHTML xml)+  response $ set_content_type _TextHtmlUTF8+    where+      title = ""+      addDoctype = ("<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">\n" ++)+      hackEnvToHspEnv :: Hack.Env -> IO HSPEnv+      hackEnvToHspEnv env = do+          x <- newIORef 0+          let req = HSP.Request (reqParamUtf8 env) (Hack.http env)+              num = NumberGen (atomicModifyIORef x (\a -> (a+1,a)))+          return $ HSPEnv req num++-- htmlToHsp :: Html -> HSP XML+-- htmlToHsp h = return $ cdata $ showHtml h++-- views++hledgerpage :: Hack.Env -> [String] -> String -> HSP XML -> HSP XML+hledgerpage env msgs title content =+    <html>+      <head>+        <meta http-equiv = "Content-Type" content = "text/html; charset=utf-8" />+        <link rel="stylesheet" type="text/css" href="/style.css" media="all" />+        <title><% title %></title>+      </head>+      <body>+        <% navbar env %>+        <div id="messages"><% intercalate ", " msgs %></div>+        <div id="content"><% content %></div>+      </body>+    </html>++navbar :: Hack.Env -> HSP XML+navbar env =+    <div id="navbar">+      <a href="http://hledger.org" id="hledgerorglink">hledger.org</a>+      <% navlinks env %>+      <% searchform env %>+      <a href="http://hledger.org/MANUAL.html" id="helplink">help</a>+    </div>++getParamOrNull p = (decodeString . fromMaybe "") `fmap` getParam p++navlinks :: Hack.Env -> HSP XML+navlinks _ = do+   a <- getParamOrNull "a"+   p <- getParamOrNull "p"+   let addparams=(++(printf "?a=%s&p=%s" a p))+       link s = <a href=(addparams s) class="navlink"><% s %></a>+   <div id="navlinks">+     <% link "transactions" %> |+     <% link "register" %> |+     <% link "balance" %>+    </div>++searchform :: Hack.Env -> HSP XML+searchform env = do+   a <- getParamOrNull "a"+   p <- getParamOrNull "p"+   let resetlink | null a && null p = <span></span>+                 | otherwise = <span id="resetlink"><% nbsp %><a href=u>reset</a></span>+                 where u = dropWhile (=='/') $ Hack.Contrib.Request.path env+   <form action="" id="searchform">+      <% nbsp %>search for:<% nbsp %><input name="a" size="20" value=a+      /><% help "filter-patterns"+      %><% nbsp %><% nbsp %>in reporting period:<% nbsp %><input name="p" size="20" value=p+      /><% help "period-expressions"+      %><input type="submit" name="submit" value="filter" style="display:none" />+      <% resetlink %>+    </form>++addform :: Hack.Env -> HSP XML+addform env = do+  today <- io $ liftM showDate $ getCurrentDay+  let inputs = Hack.Contrib.Request.inputs env+      date  = decodeString $ fromMaybe today $ lookup "date"  inputs+      desc  = decodeString $ fromMaybe "" $ lookup "desc"  inputs+  <div>+   <div id="addform">+   <form action="" method="POST">+    <table border="0">+      <tr>+        <td>+          Date: <input size="15" name="date" value=date /><% help "dates" %><% nbsp %>+          Description: <input size="35" name="desc" value=desc /><% nbsp %>+        </td>+      </tr>+      <% transactionfields 1 env %>+      <% transactionfields 2 env %>+      <tr id="addbuttonrow"><td><input type="submit" value="add transaction" +      /><% help "file-format" %></td></tr>+    </table>+   </form>+   </div>+   <br clear="all" />+   </div>++help :: String -> HSP XML+help topic = <a href=u>?</a>+    where u = printf "http://hledger.org/MANUAL.html%s" l :: String+          l | null topic = ""+            | otherwise = '#':topic++transactionfields :: Int -> Hack.Env -> HSP XML+transactionfields n env = do+  let inputs = Hack.Contrib.Request.inputs env+      acct = decodeString $ fromMaybe "" $ lookup acctvar inputs+      amt  = decodeString $ fromMaybe "" $ lookup amtvar  inputs+  <tr>+    <td>+    <% nbsp %><% nbsp %>+      Account: <input size="35" name=acctvar value=acct /><% nbsp %>+      Amount: <input size="15" name=amtvar value=amt /><% nbsp %>+    </td>+   </tr>+    where+      numbered = (++ show n)+      acctvar = numbered "acct"+      amtvar = numbered "amt"++handleAddform :: Journal -> AppUnit+handleAddform j = do+  env <- getenv+  d <- io getCurrentDay+  t <- io getCurrentLocalTime+  handle t $ validate env d+  where+    validate :: Hack.Env -> Day -> Failing Transaction+    validate env today =+        let inputs = Hack.Contrib.Request.inputs env+            date  = decodeString $ fromMaybe "today" $ lookup "date"  inputs+            desc  = decodeString $ fromMaybe "" $ lookup "desc"  inputs+            acct1 = decodeString $ fromMaybe "" $ lookup "acct1" inputs+            amt1  = decodeString $ fromMaybe "" $ lookup "amt1"  inputs+            acct2 = decodeString $ fromMaybe "" $ lookup "acct2" inputs+            amt2  = decodeString $ fromMaybe "" $ lookup "amt2"  inputs+            validateDate ""  = ["missing date"]+            validateDate _   = []+            validateDesc ""  = ["missing description"]+            validateDesc _   = []+            validateAcct1 "" = ["missing account 1"]+            validateAcct1 _  = []+            validateAmt1 ""  = ["missing amount 1"]+            validateAmt1 _   = []+            validateAcct2 "" = ["missing account 2"]+            validateAcct2 _  = []+            validateAmt2 _   = []+            amt1' = either (const missingamt) id $ parse someamount "" amt1+            amt2' = either (const missingamt) id $ parse someamount "" amt2+            (date', dateparseerr) = case fixSmartDateStrEither today date of+                                      Right d -> (d, [])+                                      Left e -> ("1900/01/01", [showDateParseError e])+            t = Transaction {+                            tdate = parsedate date' -- date' must be parseable+                           ,teffectivedate=Nothing+                           ,tstatus=False+                           ,tcode=""+                           ,tdescription=desc+                           ,tcomment=""+                           ,tpostings=[+                             Posting False acct1 amt1' "" RegularPosting (Just t')+                            ,Posting False acct2 amt2' "" RegularPosting (Just t')+                            ]+                           ,tpreceding_comment_lines=""+                           }+            (t', balanceerr) = case balanceTransaction t of+                           Right t'' -> (t'', [])+                           Left e -> (t, [head $ lines e]) -- show just the error not the transaction+            errs = concat [+                    validateDate date+                   ,dateparseerr+                   ,validateDesc desc+                   ,validateAcct1 acct1+                   ,validateAmt1 amt1+                   ,validateAcct2 acct2+                   ,validateAmt2 amt2+                   ,balanceerr+                   ]+        in+        case null errs of+          False -> Failure errs+          True  -> Success t'++    handle :: LocalTime -> Failing Transaction -> AppUnit+    handle _ (Failure errs) = hsp errs addform+    handle ti (Success t)   = do+                    io $ journalAddTransaction j t >> reload j+                    ledgerpage [msg] j (showTransactions (optsToFilterSpec [] [] ti))+       where msg = printf "Added transaction:\n%s" (show t)++nbsp :: XML+nbsp = cdata "&nbsp;"

@@ -0,0 +1,80 @@+{-# LANGUAGE CPP #-}+{-|+hledger - a ledger-compatible accounting tool.+Copyright (c) 2007-2010 Simon Michael <simon@joyful.com>+Released under GPL version 3 or later.++hledger is a partial haskell clone of John Wiegley's "ledger".  It+generates ledger-compatible register & balance reports from a plain text+journal, and demonstrates a functional implementation of ledger.+For more information, see http:\/\/hledger.org .++This module provides the main function for the hledger command-line+executable. It is exposed here so that it can be imported by eg benchmark+scripts.++You can use the command line:++> $ hledger --help++or ghci:++> $ ghci hledger+> > j <- readJournal "data/sample.journal"+> > register [] ["income","expenses"] j+> 2008/01/01 income               income:salary                   $-1          $-1+> 2008/06/01 gift                 income:gifts                    $-1          $-2+> 2008/06/03 eat & shop           expenses:food                    $1          $-1+>                                 expenses:supplies                $1            0+> > balance [Depth "1"] [] l+>                  $-1  assets+>                   $2  expenses+>                  $-2  income+>                   $1  liabilities+> > l <- myLedger+> > t <- myTimelog++See "Hledger.Data.Ledger" for more examples.++-}++module Hledger.Cli.Main where+#if __GLASGOW_HASKELL__ <= 610+import Prelude hiding (putStr, putStrLn)+import System.IO.UTF8+#endif++import Hledger.Cli.Commands.All+import Hledger.Data+import Hledger.Cli.Options+import Hledger.Cli.Tests+import Hledger.Cli.Utils (withJournalDo)+import Hledger.Cli.Version (versionmsg, binaryfilename)++main :: IO ()+main = do+  (opts, cmd, args) <- parseArguments+  run cmd opts args+    where+      run cmd opts args+       | Help `elem` opts             = putStr usage+       | Version `elem` opts          = putStrLn versionmsg+       | BinaryFilename `elem` opts   = putStrLn binaryfilename+       | cmd `isPrefixOf` "balance"   = withJournalDo opts args cmd balance+       | cmd `isPrefixOf` "convert"   = withJournalDo opts args cmd convert+       | cmd `isPrefixOf` "print"     = withJournalDo opts args cmd print'+       | cmd `isPrefixOf` "register"  = withJournalDo opts args cmd register+       | cmd `isPrefixOf` "histogram" = withJournalDo opts args cmd histogram+       | cmd `isPrefixOf` "add"       = withJournalDo opts args cmd add+       | cmd `isPrefixOf` "stats"     = withJournalDo opts args cmd stats+#ifdef VTY+       | cmd `isPrefixOf` "vty"       = withJournalDo opts args cmd vty+#endif+#if defined(WEB) || defined(WEBHAPPSTACK)+       | cmd `isPrefixOf` "web"       = withJournalDo opts args cmd web+#endif+#ifdef CHART+       | cmd `isPrefixOf` "chart"       = withJournalDo opts args cmd chart+#endif+       | cmd `isPrefixOf` "test"      = runtests opts args >> return ()+       | otherwise                    = putStr usage

@@ -0,0 +1,269 @@+{-# LANGUAGE CPP #-}+{-|+Command-line options for the application.+-}++module Hledger.Cli.Options+where+import System.Console.GetOpt+import System.Environment+import Hledger.Cli.Version (timeprogname)+import Hledger.Data.IO (myLedgerPath,myTimelogPath)+import Hledger.Data.Utils+import Hledger.Data.Types+import Hledger.Data.Dates+import Codec.Binary.UTF8.String (decodeString)++#ifdef CHART+chartoutput   = "hledger.png"+chartitems    = 10+chartsize     = "600x400"+#endif++usagehdr =+  "Usage: hledger [OPTIONS] [COMMAND [PATTERNS]]\n" +++  "       hledger [OPTIONS] convert CSVFILE\n" +++  "       hledger [OPTIONS] stats\n" +++  "\n" +++  "hledger uses your ~/.ledger or $LEDGER file, or another specified with -f\n" +++  "\n" +++  "COMMAND is one of (may be abbreviated):\n" +++  "  add       - prompt for new transactions and add them to the ledger\n" +++  "  balance   - show accounts, with balances\n" +++  "  convert   - read CSV bank data and display in ledger format\n" +++  "  histogram - show a barchart of transactions per day or other interval\n" +++  "  print     - show transactions in ledger format\n" +++  "  register  - show transactions as a register with running balance\n" +++  "  stats     - show various statistics for a ledger\n" +++#ifdef VTY+  "  vty       - run a simple curses-style UI\n" +++#endif+#ifdef WEB+  "  web       - run a simple web-based UI\n" +++#endif+#ifdef CHART+  "  chart     - generate balances pie chart\n" +++#endif+  "  test      - run self-tests\n" +++  "\n" +++  "PATTERNS are regular expressions which filter by account name.\n" +++  "Prefix with desc: to filter by transaction description instead.\n" +++  "Prefix with not: to negate a pattern. When using both, not: comes last.\n" +++  "\n" +++  "DATES can be y/m/d or ledger-style smart dates like \"last month\".\n" +++  "\n" +++  "Options:"++usageftr = ""+usage = usageInfo usagehdr options ++ usageftr++-- | Command-line options we accept.+options :: [OptDescr Opt]+options = [+  Option "f" ["file"]         (ReqArg File "FILE")   "use a different ledger/timelog file; - means stdin"+ ,Option ""  ["no-new-accounts"] (NoArg NoNewAccts)   "don't allow to create new accounts"+ ,Option "b" ["begin"]        (ReqArg Begin "DATE")  "report on transactions on or after this date"+ ,Option "e" ["end"]          (ReqArg End "DATE")    "report on transactions before this date"+ ,Option "p" ["period"]       (ReqArg Period "EXPR") ("report on transactions during the specified period\n" +++                                                       "and/or with the specified reporting interval\n")+ ,Option "C" ["cleared"]      (NoArg  Cleared)       "report only on cleared transactions"+ ,Option "U" ["uncleared"]    (NoArg  UnCleared)     "report only on uncleared transactions"+ ,Option "B" ["cost","basis"] (NoArg  CostBasis)     "report cost of commodities"+ ,Option ""    ["depth"]        (ReqArg Depth "N")     "hide accounts/transactions deeper than this"+ ,Option "d" ["display"]      (ReqArg Display "EXPR") ("show only transactions matching EXPR (where\n" +++                                                        "EXPR is 'dOP[DATE]' and OP is <, <=, =, >=, >)")+ ,Option ""    ["effective"]    (NoArg  Effective)     "use transactions' effective dates, if any"+ ,Option "E" ["empty"]        (NoArg  Empty)         "show empty/zero things which are normally elided"+ ,Option "R" ["real"]         (NoArg  Real)          "report only on real (non-virtual) transactions"+ ,Option ""    ["no-total"]     (NoArg  NoTotal)       "balance report: hide the final total"+-- ,Option "s" ["subtotal"]     (NoArg  SubTotal)      "balance report: show subaccounts"+ ,Option "W" ["weekly"]       (NoArg  WeeklyOpt)     "register report: show weekly summary"+ ,Option "M" ["monthly"]      (NoArg  MonthlyOpt)    "register report: show monthly summary"+ ,Option "Q" ["quarterly"]    (NoArg  QuarterlyOpt)  "register report: show quarterly summary"+ ,Option "Y" ["yearly"]       (NoArg  YearlyOpt)     "register report: show yearly summary"+ ,Option "h" ["help"] (NoArg  Help)                  "show this help"+ ,Option "V" ["version"]      (NoArg  Version)       "show version information"+ ,Option "v" ["verbose"]      (NoArg  Verbose)       "show verbose test output"+ ,Option ""    ["binary-filename"] (NoArg BinaryFilename) "show the download filename for this hledger build"+ ,Option ""    ["debug"]        (NoArg  Debug)         "show extra debug output; implies verbose"+ ,Option ""    ["debug-vty"]  (NoArg  DebugVty)     "run vty command with no vty output, showing console"+#ifdef CHART+ ,Option "o" ["output"]  (ReqArg ChartOutput "FILE")    ("chart: output filename (default: "++chartoutput++")")+ ,Option ""  ["items"]  (ReqArg ChartItems "N")         ("chart: number of accounts to show (default: "++show chartitems++")")+ ,Option ""  ["size"] (ReqArg ChartSize "WIDTHxHEIGHT") ("chart: image size (default: "++chartsize++")")+#endif+ ]++-- | An option value from a command-line flag.+data Opt = +    File    {value::String} | +    NoNewAccts |+    Begin   {value::String} | +    End     {value::String} | +    Period  {value::String} | +    Cleared | +    UnCleared | +    CostBasis | +    Depth   {value::String} | +    Display {value::String} | +    Effective | +    Empty | +    Real | +    NoTotal |+    SubTotal |+    WeeklyOpt |+    MonthlyOpt |+    QuarterlyOpt |+    YearlyOpt |+    Help |+    Verbose |+    Version+    | BinaryFilename+    | Debug+    | DebugVty+#ifdef CHART+    | ChartOutput {value::String}+    | ChartItems  {value::String}+    | ChartSize   {value::String}+#endif+    deriving (Show,Eq)++-- these make me nervous+optsWithConstructor f opts = concatMap get opts+    where get o = [o | f v == o] where v = value o++optsWithConstructors fs opts = concatMap get opts+    where get o = [o | any (== o) fs]++optValuesForConstructor f opts = concatMap get opts+    where get o = [v | f v == o] where v = value o++optValuesForConstructors fs opts = concatMap get opts+    where get o = [v | any (\f -> f v == o) fs] where v = value o++-- | Parse the command-line arguments into options, command name, and+-- command arguments. Any dates in the options are converted to explicit+-- YYYY/MM/DD format based on the current time.+parseArguments :: IO ([Opt], String, [String])+parseArguments = do+  args <- liftM (map decodeString) getArgs+  let (os,as,es) = getOpt Permute options args+--  istimequery <- usingTimeProgramName+--  let os' = if istimequery then (Period "today"):os else os+  os' <- fixOptDates os+  let os'' = if Debug `elem` os' then Verbose:os' else os'+  case (as,es) of+    (cmd:args,[])   -> return (os'',cmd,args)+    ([],[])         -> return (os'',"",[])+    (_,errs)        -> ioError (userError (concat errs ++ usage))++-- | Convert any fuzzy dates within these option values to explicit ones,+-- based on today's date.+fixOptDates :: [Opt] -> IO [Opt]+fixOptDates opts = do+  d <- getCurrentDay+  return $ map (fixopt d) opts+  where+    fixopt d (Begin s)   = Begin $ fixSmartDateStr d s+    fixopt d (End s)     = End $ fixSmartDateStr d s+    fixopt d (Display s) = -- hacky+        Display $ gsubRegexPRBy "\\[.+?\\]" fixbracketeddatestr s+        where fixbracketeddatestr s = "[" ++ fixSmartDateStr d (init $ tail s) ++ "]"+    fixopt _ o            = o++-- | Figure out the overall date span we should report on, based on any+-- begin/end/period options provided. If there is a period option, the+-- others are ignored.+dateSpanFromOpts :: Day -> [Opt] -> DateSpan+dateSpanFromOpts refdate opts+    | not $ null popts = snd $ parsePeriodExpr refdate $ last popts+    | otherwise = DateSpan lastb laste+    where+      popts = optValuesForConstructor Period opts+      bopts = optValuesForConstructor Begin opts+      eopts = optValuesForConstructor End opts+      lastb = listtomaybeday bopts+      laste = listtomaybeday eopts+      listtomaybeday vs = if null vs then Nothing else Just $ parse $ last vs+          where parse = parsedate . fixSmartDateStr refdate++-- | Figure out the reporting interval, if any, specified by the options.+-- If there is a period option, the others are ignored.+intervalFromOpts :: [Opt] -> Interval+intervalFromOpts opts =+    case (periodopts, intervalopts) of+      ((p:_), _)            -> fst $ parsePeriodExpr d p where d = parsedate "0001/01/01" -- unused+      (_, (WeeklyOpt:_))    -> Weekly+      (_, (MonthlyOpt:_))   -> Monthly+      (_, (QuarterlyOpt:_)) -> Quarterly+      (_, (YearlyOpt:_))    -> Yearly+      (_, _)                -> NoInterval+    where+      periodopts   = reverse $ optValuesForConstructor Period opts+      intervalopts = reverse $ filter (`elem` [WeeklyOpt,MonthlyOpt,QuarterlyOpt,YearlyOpt]) opts++-- | Get the value of the (last) depth option, if any, otherwise a large number.+depthFromOpts :: [Opt] -> Maybe Int+depthFromOpts opts = listtomaybeint $ optValuesForConstructor Depth opts+    where+      listtomaybeint [] = Nothing+      listtomaybeint vs = Just $ read $ last vs++-- | Get the value of the (last) display option, if any.+displayExprFromOpts :: [Opt] -> Maybe String+displayExprFromOpts opts = listtomaybe $ optValuesForConstructor Display opts+    where+      listtomaybe [] = Nothing+      listtomaybe vs = Just $ last vs++-- | Get a maybe boolean representing the last cleared/uncleared option if any.+clearedValueFromOpts opts | null os = Nothing+                          | last os == Cleared = Just True+                          | otherwise = Just False+    where os = optsWithConstructors [Cleared,UnCleared] opts++-- | Was the program invoked via the \"hours\" alias ?+usingTimeProgramName :: IO Bool+usingTimeProgramName = do+  progname <- getProgName+  return $ map toLower progname == timeprogname++-- | Get the journal file path from options, an environment variable, or a default+journalFilePathFromOpts :: [Opt] -> IO String+journalFilePathFromOpts opts = do+  istimequery <- usingTimeProgramName+  f <- if istimequery then myTimelogPath else myLedgerPath+  return $ last $ f : optValuesForConstructor File opts++-- | Gather filter pattern arguments into a list of account patterns and a+-- list of description patterns. We interpret pattern arguments as+-- follows: those prefixed with "desc:" are description patterns, all+-- others are account patterns; also patterns prefixed with "not:" are+-- negated. not: should come after desc: if both are used.+parsePatternArgs :: [String] -> ([String],[String])+parsePatternArgs args = (as, ds')+    where+      descprefix = "desc:"+      (ds, as) = partition (descprefix `isPrefixOf`) args+      ds' = map (drop (length descprefix)) ds++-- | Convert application options to the library's generic filter specification.+optsToFilterSpec :: [Opt] -> [String] -> LocalTime -> FilterSpec+optsToFilterSpec opts args t = FilterSpec {+                                datespan=dateSpanFromOpts (localDay t) opts+                               ,cleared=clearedValueFromOpts opts+                               ,real=Real `elem` opts+                               ,empty=Empty `elem` opts+                               ,costbasis=CostBasis `elem` opts+                               ,acctpats=apats+                               ,descpats=dpats+                               ,whichdate = if Effective `elem` opts then EffectiveDate else ActualDate+                               ,depth = depthFromOpts opts+                               }+    where (apats,dpats) = parsePatternArgs args++-- currentLocalTimeFromOpts opts = listtomaybe $ optValuesForConstructor CurrentLocalTime opts+--     where+--       listtomaybe [] = Nothing+--       listtomaybe vs = Just $ last vs+

@@ -0,0 +1,1082 @@+{- |++This module contains hledger's unit tests. These are built in to hledger,+and can be run at any time by doing @hledger test@ (or, with a few more+options, by doing @make unittest@ in the hledger source tree.)++Other kinds of tests:++hledger's functional tests are a set of shell/command-line tests defined+by .test files in the tests\/ subdirectory. These can be run by doing+@make functest@ in the hledger source tree.++hledger's doctests are shell tests defined in literal blocks in haddock+documentation in the source, run by doing @make doctest@ in the hledger+source tree. They are no longer used, but here is an example:++@+$ hledger -f sample.ledger balance o+                  $1  expenses:food+                 $-2  income+                 $-1    gifts+                 $-1    salary+--------------------+                 $-1+@++-}++module Hledger.Cli.Tests+where+import qualified Data.Map as Map+import Test.HUnit.Tools (runVerboseTests)+import System.Exit (exitFailure, exitWith, ExitCode(ExitSuccess)) -- base 3 compatible+import System.Time (ClockTime(TOD))++import Hledger.Cli.Commands.All+import Hledger.Data  -- including testing utils in Hledger.Data.Utils+import Hledger.Cli.Options+import Hledger.Cli.Utils+++-- | Run unit tests.+runtests :: [Opt] -> [String] -> IO ()+runtests opts args = do+  (counts,_) <- runner ts+  if errors counts > 0 || (failures counts > 0)+   then exitFailure+   else exitWith ExitSuccess+    where+      runner | Verbose `elem` opts = runVerboseTests+             | otherwise = liftM (flip (,) 0) . runTestTT+      ts = TestList $ filter matchname $ tflatten tests  -- show flat test names+      -- ts = tfilter matchname $ TestList tests -- show hierarchical test names+      matchname = matchpats args . tname++-- | unit tests, augmenting the ones defined in each module. Where that is+-- inconvenient due to import cycles or whatever, we define them here.+tests :: Test+tests = TestList [+   tests_Hledger_Data,+   tests_Hledger_Commands,++   "account directive" ~:+   let sameParse str1 str2 = do j1 <- journalFromString str1+                                j2 <- journalFromString str2+                                j1 `is` j2{filereadtime=filereadtime j1, jtext=jtext j1}+   in TestList+   [+    "account directive 1" ~: sameParse +                          "2008/12/07 One\n  test:from  $-1\n  test:to  $1\n"+                          "!account test\n2008/12/07 One\n  from  $-1\n  to  $1\n"++   ,"account directive 2" ~: sameParse +                           "2008/12/07 One\n  test:foo:from  $-1\n  test:foo:to  $1\n"+                           "!account test\n!account foo\n2008/12/07 One\n  from  $-1\n  to  $1\n"++   ,"account directive 3" ~: sameParse +                           "2008/12/07 One\n  test:from  $-1\n  test:to  $1\n"+                           "!account test\n!account foo\n!end\n2008/12/07 One\n  from  $-1\n  to  $1\n"++   ,"account directive 4" ~: sameParse +                           ("2008/12/07 One\n  alpha  $-1\n  beta  $1\n" +++                            "!account outer\n2008/12/07 Two\n  aigh  $-2\n  bee  $2\n" +++                            "!account inner\n2008/12/07 Three\n  gamma  $-3\n  delta  $3\n" +++                            "!end\n2008/12/07 Four\n  why  $-4\n  zed  $4\n" +++                            "!end\n2008/12/07 Five\n  foo  $-5\n  bar  $5\n"+                           )+                           ("2008/12/07 One\n  alpha  $-1\n  beta  $1\n" +++                            "2008/12/07 Two\n  outer:aigh  $-2\n  outer:bee  $2\n" +++                            "2008/12/07 Three\n  outer:inner:gamma  $-3\n  outer:inner:delta  $3\n" +++                            "2008/12/07 Four\n  outer:why  $-4\n  outer:zed  $4\n" +++                            "2008/12/07 Five\n  foo  $-5\n  bar  $5\n"+                           )+   ]++  ,"accountnames" ~:+    accountnames ledger7 `is`+     ["assets","assets:cash","assets:checking","assets:saving","equity","equity:opening balances",+      "expenses","expenses:food","expenses:food:dining","expenses:phone","expenses:vacation",+      "liabilities","liabilities:credit cards","liabilities:credit cards:discover"]++  ,"accountNameTreeFrom" ~: do+    accountNameTreeFrom ["a"]       `is` Node "top" [Node "a" []]+    accountNameTreeFrom ["a","b"]   `is` Node "top" [Node "a" [], Node "b" []]+    accountNameTreeFrom ["a","a:b"] `is` Node "top" [Node "a" [Node "a:b" []]]+    accountNameTreeFrom ["a:b:c"]   `is` Node "top" [Node "a" [Node "a:b" [Node "a:b:c" []]]]++  ,"balance report tests" ~:+   let (opts,args) `gives` es = do +        l <- sampleledgerwithopts opts args+        t <- getCurrentLocalTime+        showBalanceReport opts (optsToFilterSpec opts args t) l `is` unlines es+   in TestList+   [++    "balance report with no args" ~:+    ([], []) `gives`+    ["                 $-1  assets"+    ,"                  $1    bank:saving"+    ,"                 $-2    cash"+    ,"                  $2  expenses"+    ,"                  $1    food"+    ,"                  $1    supplies"+    ,"                 $-2  income"+    ,"                 $-1    gifts"+    ,"                 $-1    salary"+    ,"                  $1  liabilities:debts"+    ]++   ,"balance report can be limited with --depth" ~:+    ([Depth "1"], []) `gives`+    ["                 $-1  assets"+    ,"                  $2  expenses"+    ,"                 $-2  income"+    ,"                  $1  liabilities"+    ]+    +   ,"balance report with account pattern o" ~:+    ([SubTotal], ["o"]) `gives`+    ["                  $1  expenses:food"+    ,"                 $-2  income"+    ,"                 $-1    gifts"+    ,"                 $-1    salary"+    ,"--------------------"+    ,"                 $-1"+    ]++   ,"balance report with account pattern o and --depth 1" ~:+    ([Depth "1"], ["o"]) `gives`+    ["                  $1  expenses"+    ,"                 $-2  income"+    ,"--------------------"+    ,"                 $-1"+    ]++   ,"balance report with account pattern a" ~:+    ([], ["a"]) `gives`+    ["                 $-1  assets"+    ,"                  $1    bank:saving"+    ,"                 $-2    cash"+    ,"                 $-1  income:salary"+    ,"                  $1  liabilities:debts"+    ,"--------------------"+    ,"                 $-1"+    ]++   ,"balance report with account pattern e" ~:+    ([], ["e"]) `gives`+    ["                 $-1  assets"+    ,"                  $1    bank:saving"+    ,"                 $-2    cash"+    ,"                  $2  expenses"+    ,"                  $1    food"+    ,"                  $1    supplies"+    ,"                 $-2  income"+    ,"                 $-1    gifts"+    ,"                 $-1    salary"+    ,"                  $1  liabilities:debts"+    ]++   ,"balance report with unmatched parent of two matched subaccounts" ~: +    ([], ["cash","saving"]) `gives`+    ["                 $-1  assets"+    ,"                  $1    bank:saving"+    ,"                 $-2    cash"+    ,"--------------------"+    ,"                 $-1"+    ]++   ,"balance report with multi-part account name" ~: +    ([], ["expenses:food"]) `gives`+    ["                  $1  expenses:food"+    ,"--------------------"+    ,"                  $1"+    ]++   ,"balance report with negative account pattern" ~:+    ([], ["not:assets"]) `gives`+    ["                  $2  expenses"+    ,"                  $1    food"+    ,"                  $1    supplies"+    ,"                 $-2  income"+    ,"                 $-1    gifts"+    ,"                 $-1    salary"+    ,"                  $1  liabilities:debts"+    ,"--------------------"+    ,"                  $1"+    ]++   ,"balance report negative account pattern always matches full name" ~: +    ([], ["not:e"]) `gives` []++   ,"balance report negative patterns affect totals" ~: +    ([], ["expenses","not:food"]) `gives`+    ["                  $1  expenses:supplies"+    ,"--------------------"+    ,"                  $1"+    ]++   ,"balance report with -E shows zero-balance accounts" ~:+    ([SubTotal,Empty], ["assets"]) `gives`+    ["                 $-1  assets"+    ,"                  $1    bank"+    ,"                  $0      checking"+    ,"                  $1      saving"+    ,"                 $-2    cash"+    ,"--------------------"+    ,"                 $-1"+    ]++   ,"balance report with cost basis" ~: do+      j <- journalFromString $ unlines+             [""+             ,"2008/1/1 test           "+             ,"  a:b          10h @ $50"+             ,"  c:d                   "+             ,""+             ]+      let j' = journalCanonicaliseAmounts $ journalConvertAmountsToCost j -- enable cost basis adjustment+      showBalanceReport [] nullfilterspec j' `is`+       unlines+        ["                $500  a:b"+        ,"               $-500  c:d"+        ]++   ,"balance report elides zero-balance root account(s)" ~: do+      l <- journalFromStringWithOpts []+             (unlines+              ["2008/1/1 one"+              ,"  test:a  1"+              ,"  test:b"+              ])+      showBalanceReport [] nullfilterspec l `is`+       unlines+        ["                   1  test:a"+        ,"                  -1  test:b"+        ]++   ]++  ,"balanceTransaction" ~: do+     assertBool "detect unbalanced entry, sign error"+                    (isLeft $ balanceTransaction+                           (Transaction (parsedate "2007/01/28") Nothing False "" "test" ""+                            [Posting False "a" (Mixed [dollars 1]) "" RegularPosting Nothing, +                             Posting False "b" (Mixed [dollars 1]) "" RegularPosting Nothing+                            ] ""))+     assertBool "detect unbalanced entry, multiple missing amounts"+                    (isLeft $ balanceTransaction+                           (Transaction (parsedate "2007/01/28") Nothing False "" "test" ""+                            [Posting False "a" missingamt "" RegularPosting Nothing, +                             Posting False "b" missingamt "" RegularPosting Nothing+                            ] ""))+     let e = balanceTransaction (Transaction (parsedate "2007/01/28") Nothing False "" "test" ""+                           [Posting False "a" (Mixed [dollars 1]) "" RegularPosting Nothing, +                            Posting False "b" missingamt "" RegularPosting Nothing+                           ] "")+     assertBool "one missing amount should be ok" (isRight e)+     assertEqual "balancing amount is added" +                     (Mixed [dollars (-1)])+                     (case e of+                        Right e' -> (pamount $ last $ tpostings e')+                        Left _ -> error "should not happen")++  ,"journalCanonicaliseAmounts" ~:+   "use the greatest precision" ~:+    (map precision $ journalAmountAndPriceCommodities $ journalCanonicaliseAmounts $ journalWithAmounts ["1","2.00"]) `is` [2,2]++  ,"commodities" ~:+    Map.elems (commodities ledger7) `is` [Commodity {symbol="$", side=L, spaced=False, comma=False, precision=2}]++  ,"dateSpanFromOpts" ~: do+    let todaysdate = parsedate "2008/11/26"+    let gives = is . show . dateSpanFromOpts todaysdate+    [] `gives` "DateSpan Nothing Nothing"+    [Begin "2008", End "2009"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"+    [Period "in 2008"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"+    [Begin "2005", End "2007",Period "in 2008"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"++  -- don't know what this should do+  -- ,"elideAccountName" ~: do+  --    (elideAccountName 50 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa"+  --     `is` "aa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa")+  --    (elideAccountName 20 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa"+  --     `is` "aa:aa:aaaaaaaaaaaaaa")++  ,"expandAccountNames" ~:+    expandAccountNames ["assets:cash","assets:checking","expenses:vacation"] `is`+     ["assets","assets:cash","assets:checking","expenses","expenses:vacation"]++  ,"intervalFromOpts" ~: do+    let gives = is . intervalFromOpts+    [] `gives` NoInterval+    [WeeklyOpt] `gives` Weekly+    [MonthlyOpt] `gives` Monthly+    [QuarterlyOpt] `gives` Quarterly+    [YearlyOpt] `gives` Yearly+    [Period "weekly"] `gives` Weekly+    [Period "monthly"] `gives` Monthly+    [Period "quarterly"] `gives` Quarterly+    [WeeklyOpt, Period "yearly"] `gives` Yearly++  ,"isAccountNamePrefixOf" ~: do+    "assets" `isAccountNamePrefixOf` "assets" `is` False+    "assets" `isAccountNamePrefixOf` "assets:bank" `is` True+    "assets" `isAccountNamePrefixOf` "assets:bank:checking" `is` True+    "my assets" `isAccountNamePrefixOf` "assets:bank" `is` False++  ,"isTransactionBalanced" ~: do+     let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""+             [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting (Just t)+             ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting (Just t)+             ] ""+     assertBool "detect balanced" (isTransactionBalanced t)+     let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""+             [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting (Just t)+             ,Posting False "c" (Mixed [dollars (-1.01)]) "" RegularPosting (Just t)+             ] ""+     assertBool "detect unbalanced" (not $ isTransactionBalanced t)+     let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""+             [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting (Just t)+             ] ""+     assertBool "detect unbalanced, one posting" (not $ isTransactionBalanced t)+     let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""+             [Posting False "b" (Mixed [dollars 0]) "" RegularPosting (Just t)+             ] ""+     assertBool "one zero posting is considered balanced for now" (isTransactionBalanced t)+     let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""+             [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting (Just t)+             ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting (Just t)+             ,Posting False "d" (Mixed [dollars 100]) "" VirtualPosting (Just t)+             ] ""+     assertBool "virtual postings don't need to balance" (isTransactionBalanced t)+     let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""+             [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting (Just t)+             ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting (Just t)+             ,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting (Just t)+             ] ""+     assertBool "balanced virtual postings need to balance among themselves" (not $ isTransactionBalanced t)+     let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""+             [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting (Just t)+             ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting (Just t)+             ,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting (Just t)+             ,Posting False "e" (Mixed [dollars (-100)]) "" BalancedVirtualPosting (Just t)+             ] ""+     assertBool "balanced virtual postings need to balance among themselves (2)" (isTransactionBalanced t)++  ,"isSubAccountNameOf" ~: do+    "assets" `isSubAccountNameOf` "assets" `is` False+    "assets:bank" `isSubAccountNameOf` "assets" `is` True+    "assets:bank:checking" `isSubAccountNameOf` "assets" `is` False+    "assets:bank" `isSubAccountNameOf` "my assets" `is` False++  ,"default year" ~: do+    rl <- journalFromString defaultyear_ledger_str+    tdate (head $ jtxns rl) `is` fromGregorian 2009 1 1+    return ()++  ,"ledgerFile" ~: do+    assertBool "ledgerFile should parse an empty file" (isRight $ parseWithCtx emptyCtx ledgerFile "")+    r <- journalFromString "" -- don't know how to get it from ledgerFile+    assertBool "ledgerFile parsing an empty file should give an empty ledger" $ null $ jtxns r++  ,"normaliseMixedAmount" ~: do+     normaliseMixedAmount (Mixed []) ~?= Mixed [nullamt]++  ,"parsedate" ~: do+    parsedate "2008/02/03" `is` parsetimewith "%Y/%m/%d" "2008/02/03" date1+    parsedate "2008-02-03" `is` parsetimewith "%Y/%m/%d" "2008/02/03" date1++  ,"period expressions" ~: do+    let todaysdate = parsedate "2008/11/26"+    let str `gives` result = show (parsewith (periodexpr todaysdate) str) `is` ("Right " ++ result)+    "from aug to oct"           `gives` "(NoInterval,DateSpan (Just 2008-08-01) (Just 2008-10-01))"+    "aug to oct"                `gives` "(NoInterval,DateSpan (Just 2008-08-01) (Just 2008-10-01))"+    "every day from aug to oct" `gives` "(Daily,DateSpan (Just 2008-08-01) (Just 2008-10-01))"+    "daily from aug"            `gives` "(Daily,DateSpan (Just 2008-08-01) Nothing)"+    "every week to 2009"        `gives` "(Weekly,DateSpan Nothing (Just 2009-01-01))"++  ,"print report tests" ~: TestList+  [++   "print expenses" ~:+   do +    let args = ["expenses"]+    l <- sampleledgerwithopts [] args+    t <- getCurrentLocalTime+    showTransactions (optsToFilterSpec [] args t) l `is` unlines+     ["2008/06/03 * eat & shop"+     ,"    expenses:food                $1"+     ,"    expenses:supplies            $1"+     ,"    assets:cash                 $-2"+     ,""+     ]++  , "print report with depth arg" ~:+   do +    l <- sampleledger+    t <- getCurrentLocalTime+    showTransactions (optsToFilterSpec [Depth "2"] [] t) l `is` unlines+      ["2008/01/01 income"+      ,"    income:salary           $-1"+      ,""+      ,"2008/06/01 gift"+      ,"    income:gifts           $-1"+      ,""+      ,"2008/06/03 * eat & shop"+      ,"    expenses:food                $1"+      ,"    expenses:supplies            $1"+      ,"    assets:cash                 $-2"+      ,""+      ,"2008/12/31 * pay off"+      ,"    liabilities:debts            $1"+      ,""+      ]++  ]++  ,"punctuatethousands 1" ~: punctuatethousands "" `is` ""++  ,"punctuatethousands 2" ~: punctuatethousands "1234567.8901" `is` "1,234,567.8901"++  ,"punctuatethousands 3" ~: punctuatethousands "-100" `is` "-100"++  ,"register report tests" ~:+  let registerdates = filter (not . null) .  map (strip . take 10) . lines+  in+  TestList+  [++   "register report with no args" ~:+   do +    l <- sampleledger+    showRegisterReport [] (optsToFilterSpec [] [] t1) l `is` unlines+     ["2008/01/01 income               assets:bank:checking             $1           $1"+     ,"                                income:salary                   $-1            0"+     ,"2008/06/01 gift                 assets:bank:checking             $1           $1"+     ,"                                income:gifts                    $-1            0"+     ,"2008/06/02 save                 assets:bank:saving               $1           $1"+     ,"                                assets:bank:checking            $-1            0"+     ,"2008/06/03 eat & shop           expenses:food                    $1           $1"+     ,"                                expenses:supplies                $1           $2"+     ,"                                assets:cash                     $-2            0"+     ,"2008/12/31 pay off              liabilities:debts                $1           $1"+     ,"                                assets:bank:checking            $-1            0"+     ]++  ,"register report with cleared option" ~:+   do +    let opts = [Cleared]+    l <- journalFromStringWithOpts opts sample_ledger_str+    showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines+     ["2008/06/03 eat & shop           expenses:food                    $1           $1"+     ,"                                expenses:supplies                $1           $2"+     ,"                                assets:cash                     $-2            0"+     ,"2008/12/31 pay off              liabilities:debts                $1           $1"+     ,"                                assets:bank:checking            $-1            0"+     ]++  ,"register report with uncleared option" ~:+   do +    let opts = [UnCleared]+    l <- journalFromStringWithOpts opts sample_ledger_str+    showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines+     ["2008/01/01 income               assets:bank:checking             $1           $1"+     ,"                                income:salary                   $-1            0"+     ,"2008/06/01 gift                 assets:bank:checking             $1           $1"+     ,"                                income:gifts                    $-1            0"+     ,"2008/06/02 save                 assets:bank:saving               $1           $1"+     ,"                                assets:bank:checking            $-1            0"+     ]++  ,"register report sorts by date" ~:+   do +    l <- journalFromStringWithOpts [] $ unlines+        ["2008/02/02 a"+        ,"  b  1"+        ,"  c"+        ,""+        ,"2008/01/01 d"+        ,"  e  1"+        ,"  f"+        ]+    registerdates (showRegisterReport [] (optsToFilterSpec [] [] t1) l) `is` ["2008/01/01","2008/02/02"]++  ,"register report with account pattern" ~:+   do+    l <- sampleledger+    showRegisterReport [] (optsToFilterSpec [] ["cash"] t1) l `is` unlines+     ["2008/06/03 eat & shop           assets:cash                     $-2          $-2"+     ]++  ,"register report with account pattern, case insensitive" ~:+   do +    l <- sampleledger+    showRegisterReport [] (optsToFilterSpec [] ["cAsH"] t1) l `is` unlines+     ["2008/06/03 eat & shop           assets:cash                     $-2          $-2"+     ]++  ,"register report with display expression" ~:+   do +    l <- sampleledger+    let gives displayexpr = +            (registerdates (showRegisterReport opts (optsToFilterSpec opts [] t1) l) `is`)+                where opts = [Display displayexpr]+    "d<[2008/6/2]"  `gives` ["2008/01/01","2008/06/01"]+    "d<=[2008/6/2]" `gives` ["2008/01/01","2008/06/01","2008/06/02"]+    "d=[2008/6/2]"  `gives` ["2008/06/02"]+    "d>=[2008/6/2]" `gives` ["2008/06/02","2008/06/03","2008/12/31"]+    "d>[2008/6/2]"  `gives` ["2008/06/03","2008/12/31"]++  ,"register report with period expression" ~:+   do +    l <- sampleledger    +    let periodexpr `gives` dates = do+          l' <- sampleledgerwithopts opts []+          registerdates (showRegisterReport opts (optsToFilterSpec opts [] t1) l') `is` dates+              where opts = [Period periodexpr]+    ""     `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]+    "2008" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]+    "2007" `gives` []+    "june" `gives` ["2008/06/01","2008/06/02","2008/06/03"]+    "monthly" `gives` ["2008/01/01","2008/06/01","2008/12/01"]+    "quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"]+    let opts = [Period "yearly"]+    showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines+     ["2008/01/01 - 2008/12/31         assets:bank:saving               $1           $1"+     ,"                                assets:cash                     $-2          $-1"+     ,"                                expenses:food                    $1            0"+     ,"                                expenses:supplies                $1           $1"+     ,"                                income:gifts                    $-1            0"+     ,"                                income:salary                   $-1          $-1"+     ,"                                liabilities:debts                $1            0"+     ]+    let opts = [Period "quarterly"]+    registerdates (showRegisterReport opts (optsToFilterSpec opts [] t1) l) `is` ["2008/01/01","2008/04/01","2008/10/01"]+    let opts = [Period "quarterly",Empty]+    registerdates (showRegisterReport opts (optsToFilterSpec opts [] t1) l) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"]++  ]++  , "register report with depth arg" ~:+   do +    l <- sampleledger+    let opts = [Depth "2"]+    showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines+     ["2008/01/01 income               income:salary                   $-1          $-1"+     ,"2008/06/01 gift                 income:gifts                    $-1          $-2"+     ,"2008/06/03 eat & shop           expenses:food                    $1          $-1"+     ,"                                expenses:supplies                $1            0"+     ,"                                assets:cash                     $-2          $-2"+     ,"2008/12/31 pay off              liabilities:debts                $1          $-1"+     ]++  ,"show dollars" ~: show (dollars 1) ~?= "$1.00"++  ,"show hours" ~: show (hours 1) ~?= "1.0h"++  ,"unicode in balance layout" ~: do+    l <- journalFromStringWithOpts []+      "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"+    showBalanceReport [] (optsToFilterSpec [] [] t1) l `is` unlines+      ["                -100  актив:наличные"+      ,"                 100  расходы:покупки"]++  ,"unicode in register layout" ~: do+    l <- journalFromStringWithOpts []+      "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"+    showRegisterReport [] (optsToFilterSpec [] [] t1) l `is` unlines+      ["2009/01/01 медвежья шкура       расходы:покупки                 100          100"+      ,"                                актив:наличные                 -100            0"]++  ,"fixSmartDateStr" ~: do+    let gives = is . fixSmartDateStr (parsedate "2008/11/26")+    "1999-12-02"   `gives` "1999/12/02"+    "1999.12.02"   `gives` "1999/12/02"+    "1999/3/2"     `gives` "1999/03/02"+    "19990302"     `gives` "1999/03/02"+    "2008/2"       `gives` "2008/02/01"+    "0020/2"       `gives` "0020/02/01"+    "1000"         `gives` "1000/01/01"+    "4/2"          `gives` "2008/04/02"+    "2"            `gives` "2008/11/02"+    "January"      `gives` "2008/01/01"+    "feb"          `gives` "2008/02/01"+    "today"        `gives` "2008/11/26"+    "yesterday"    `gives` "2008/11/25"+    "tomorrow"     `gives` "2008/11/27"+    "this day"     `gives` "2008/11/26"+    "last day"     `gives` "2008/11/25"+    "next day"     `gives` "2008/11/27"+    "this week"    `gives` "2008/11/24" -- last monday+    "last week"    `gives` "2008/11/17" -- previous monday+    "next week"    `gives` "2008/12/01" -- next monday+    "this month"   `gives` "2008/11/01"+    "last month"   `gives` "2008/10/01"+    "next month"   `gives` "2008/12/01"+    "this quarter" `gives` "2008/10/01"+    "last quarter" `gives` "2008/07/01"+    "next quarter" `gives` "2009/01/01"+    "this year"    `gives` "2008/01/01"+    "last year"    `gives` "2007/01/01"+    "next year"    `gives` "2009/01/01"+--     "last wed"     `gives` "2008/11/19"+--     "next friday"  `gives` "2008/11/28"+--     "next january" `gives` "2009/01/01"++  ,"subAccounts" ~: do+    l <- liftM (journalToLedger nullfilterspec) sampleledger+    let a = ledgerAccount l "assets"+    map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"]++  -- ,"summarisePostingsInDateSpan" ~: do+  --   let gives (b,e,depth,showempty,ps) =+  --           (summarisePostingsInDateSpan (mkdatespan b e) depth showempty ps `is`)+  --   let ps =+  --           [+  --            nullposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=Mixed [dollars 1]}+  --           ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining",   lpamount=Mixed [dollars 2]}+  --           ,nullposting{lpdescription="desc",lpaccount="expenses:food",          lpamount=Mixed [dollars 4]}+  --           ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining",   lpamount=Mixed [dollars 8]}+  --           ]+  --   ("2008/01/01","2009/01/01",0,9999,False,[]) `gives` +  --    []+  --   ("2008/01/01","2009/01/01",0,9999,True,[]) `gives` +  --    [+  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31"}+  --    ]+  --   ("2008/01/01","2009/01/01",0,9999,False,ts) `gives` +  --    [+  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food",          lpamount=Mixed [dollars 4]}+  --    ,nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:dining",   lpamount=Mixed [dollars 10]}+  --    ,nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:groceries",lpamount=Mixed [dollars 1]}+  --    ]+  --   ("2008/01/01","2009/01/01",0,2,False,ts) `gives` +  --    [+  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food",lpamount=Mixed [dollars 15]}+  --    ]+  --   ("2008/01/01","2009/01/01",0,1,False,ts) `gives` +  --    [+  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses",lpamount=Mixed [dollars 15]}+  --    ]+  --   ("2008/01/01","2009/01/01",0,0,False,ts) `gives` +  --    [+  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="",lpamount=Mixed [dollars 15]}+  --    ]++  ]++  +-- fixtures/test data++date1 = parsedate "2008/11/26"+t1 = LocalTime date1 midday++sampleledger = journalFromStringWithOpts [] sample_ledger_str+sampleledgerwithopts opts _ = journalFromStringWithOpts opts sample_ledger_str++sample_ledger_str = unlines+ ["; A sample ledger file."+ ,";"+ ,"; Sets up this account tree:"+ ,"; assets"+ ,";   bank"+ ,";     checking"+ ,";     saving"+ ,";   cash"+ ,"; expenses"+ ,";   food"+ ,";   supplies"+ ,"; income"+ ,";   gifts"+ ,";   salary"+ ,"; liabilities"+ ,";   debts"+ ,""+ ,"2008/01/01 income"+ ,"    assets:bank:checking  $1"+ ,"    income:salary"+ ,""+ ,"2008/06/01 gift"+ ,"    assets:bank:checking  $1"+ ,"    income:gifts"+ ,""+ ,"2008/06/02 save"+ ,"    assets:bank:saving  $1"+ ,"    assets:bank:checking"+ ,""+ ,"2008/06/03 * eat & shop"+ ,"    expenses:food      $1"+ ,"    expenses:supplies  $1"+ ,"    assets:cash"+ ,""+ ,"2008/12/31 * pay off"+ ,"    liabilities:debts  $1"+ ,"    assets:bank:checking"+ ,""+ ,""+ ,";final comment"+ ]++defaultyear_ledger_str = unlines+ ["Y2009"+ ,""+ ,"01/01 A"+ ,"    a  $1"+ ,"    b"+ ]++write_sample_ledger = writeFile "sample.ledger" sample_ledger_str++entry2_str = unlines+ ["2007/01/27 * joes diner"+ ,"    expenses:food:dining                      $10.00"+ ,"    expenses:gifts                            $10.00"+ ,"    assets:checking                          $-20.00"+ ,""+ ]++entry3_str = unlines+ ["2007/01/01 * opening balance"+ ,"    assets:cash                                $4.82"+ ,"    equity:opening balances"+ ,""+ ,"2007/01/01 * opening balance"+ ,"    assets:cash                                $4.82"+ ,"    equity:opening balances"+ ,""+ ,"2007/01/28 coopportunity"+ ,"  expenses:food:groceries                 $47.18"+ ,"  assets:checking"+ ,""+ ]++periodic_entry1_str = unlines+ ["~ monthly from 2007/2/2"+ ,"  assets:saving            $200.00"+ ,"  assets:checking"+ ,""+ ]++periodic_entry2_str = unlines+ ["~ monthly from 2007/2/2"+ ,"  assets:saving            $200.00         ;auto savings"+ ,"  assets:checking"+ ,""+ ]++periodic_entry3_str = unlines+ ["~ monthly from 2007/01/01"+ ,"    assets:cash                                $4.82"+ ,"    equity:opening balances"+ ,""+ ,"~ monthly from 2007/01/01"+ ,"    assets:cash                                $4.82"+ ,"    equity:opening balances"+ ,""+ ]++ledger1_str = unlines+ [""+ ,"2007/01/27 * joes diner"+ ,"  expenses:food:dining                    $10.00"+ ,"  expenses:gifts                          $10.00"+ ,"  assets:checking                        $-20.00"+ ,""+ ,""+ ,"2007/01/28 coopportunity"+ ,"  expenses:food:groceries                 $47.18"+ ,"  assets:checking                        $-47.18"+ ,""+ ,""+ ]++ledger2_str = unlines+ [";comment"+ ,"2007/01/27 * joes diner"+ ,"  expenses:food:dining                    $10.00"+ ,"  assets:checking                        $-47.18"+ ,""+ ]++ledger3_str = unlines+ ["2007/01/27 * joes diner"+ ,"  expenses:food:dining                    $10.00"+ ,";intra-entry comment"+ ,"  assets:checking                        $-47.18"+ ,""+ ]++ledger4_str = unlines+ ["!include \"somefile\""+ ,"2007/01/27 * joes diner"+ ,"  expenses:food:dining                    $10.00"+ ,"  assets:checking                        $-47.18"+ ,""+ ]++ledger5_str = ""++ledger6_str = unlines+ ["~ monthly from 2007/1/21"+ ,"    expenses:entertainment  $16.23        ;netflix"+ ,"    assets:checking"+ ,""+ ,"; 2007/01/01 * opening balance"+ ,";     assets:saving                            $200.04"+ ,";     equity:opening balances                         "+ ,""+ ]++ledger7_str = unlines+ ["2007/01/01 * opening balance"+ ,"    assets:cash                                $4.82"+ ,"    equity:opening balances                         "+ ,""+ ,"2007/01/01 * opening balance"+ ,"    income:interest                                $-4.82"+ ,"    equity:opening balances                         "+ ,""+ ,"2007/01/02 * ayres suites"+ ,"    expenses:vacation                        $179.92"+ ,"    assets:checking                                 "+ ,""+ ,"2007/01/02 * auto transfer to savings"+ ,"    assets:saving                            $200.00"+ ,"    assets:checking                                 "+ ,""+ ,"2007/01/03 * poquito mas"+ ,"    expenses:food:dining                       $4.82"+ ,"    assets:cash                                     "+ ,""+ ,"2007/01/03 * verizon"+ ,"    expenses:phone                            $95.11"+ ,"    assets:checking                                 "+ ,""+ ,"2007/01/03 * discover"+ ,"    liabilities:credit cards:discover         $80.00"+ ,"    assets:checking                                 "+ ,""+ ,"2007/01/04 * blue cross"+ ,"    expenses:health:insurance                 $90.00"+ ,"    assets:checking                                 "+ ,""+ ,"2007/01/05 * village market liquor"+ ,"    expenses:food:dining                       $6.48"+ ,"    assets:checking                                 "+ ,""+ ]++journal7 = Journal+          [] +          [] +          [+           txnTieKnot $ Transaction {+             tdate=parsedate "2007/01/01",+             teffectivedate=Nothing,+             tstatus=False,+             tcode="*",+             tdescription="opening balance",+             tcomment="",+             tpostings=[+              Posting {+                pstatus=False,+                paccount="assets:cash",+                pamount=(Mixed [dollars 4.82]),+                pcomment="",+                ptype=RegularPosting,+                ptransaction=Nothing+              },+              Posting {+                pstatus=False,+                paccount="equity:opening balances",+                pamount=(Mixed [dollars (-4.82)]),+                pcomment="",+                ptype=RegularPosting,+                ptransaction=Nothing+              }+             ],+             tpreceding_comment_lines=""+           }+          ,+           txnTieKnot $ Transaction {+             tdate=parsedate "2007/02/01",+             teffectivedate=Nothing,+             tstatus=False,+             tcode="*",+             tdescription="ayres suites",+             tcomment="",+             tpostings=[+              Posting {+                pstatus=False,+                paccount="expenses:vacation",+                pamount=(Mixed [dollars 179.92]),+                pcomment="",+                ptype=RegularPosting,+                ptransaction=Nothing+              },+              Posting {+                pstatus=False,+                paccount="assets:checking",+                pamount=(Mixed [dollars (-179.92)]),+                pcomment="",+                ptype=RegularPosting,+                ptransaction=Nothing+              }+             ],+             tpreceding_comment_lines=""+           }+          ,+           txnTieKnot $ Transaction {+             tdate=parsedate "2007/01/02",+             teffectivedate=Nothing,+             tstatus=False,+             tcode="*",+             tdescription="auto transfer to savings",+             tcomment="",+             tpostings=[+              Posting {+                pstatus=False,+                paccount="assets:saving",+                pamount=(Mixed [dollars 200]),+                pcomment="",+                ptype=RegularPosting,+                ptransaction=Nothing+              },+              Posting {+                pstatus=False,+                paccount="assets:checking",+                pamount=(Mixed [dollars (-200)]),+                pcomment="",+                ptype=RegularPosting,+                ptransaction=Nothing+              }+             ],+             tpreceding_comment_lines=""+           }+          ,+           txnTieKnot $ Transaction {+             tdate=parsedate "2007/01/03",+             teffectivedate=Nothing,+             tstatus=False,+             tcode="*",+             tdescription="poquito mas",+             tcomment="",+             tpostings=[+              Posting {+                pstatus=False,+                paccount="expenses:food:dining",+                pamount=(Mixed [dollars 4.82]),+                pcomment="",+                ptype=RegularPosting,+                ptransaction=Nothing+              },+              Posting {+                pstatus=False,+                paccount="assets:cash",+                pamount=(Mixed [dollars (-4.82)]),+                pcomment="",+                ptype=RegularPosting,+                ptransaction=Nothing+              }+             ],+             tpreceding_comment_lines=""+           }+          ,+           txnTieKnot $ Transaction {+             tdate=parsedate "2007/01/03",+             teffectivedate=Nothing,+             tstatus=False,+             tcode="*",+             tdescription="verizon",+             tcomment="",+             tpostings=[+              Posting {+                pstatus=False,+                paccount="expenses:phone",+                pamount=(Mixed [dollars 95.11]),+                pcomment="",+                ptype=RegularPosting,+                ptransaction=Nothing+              },+              Posting {+                pstatus=False,+                paccount="assets:checking",+                pamount=(Mixed [dollars (-95.11)]),+                pcomment="",+                ptype=RegularPosting,+                ptransaction=Nothing+              }+             ],+             tpreceding_comment_lines=""+           }+          ,+           txnTieKnot $ Transaction {+             tdate=parsedate "2007/01/03",+             teffectivedate=Nothing,+             tstatus=False,+             tcode="*",+             tdescription="discover",+             tcomment="",+             tpostings=[+              Posting {+                pstatus=False,+                paccount="liabilities:credit cards:discover",+                pamount=(Mixed [dollars 80]),+                pcomment="",+                ptype=RegularPosting,+                ptransaction=Nothing+              },+              Posting {+                pstatus=False,+                paccount="assets:checking",+                pamount=(Mixed [dollars (-80)]),+                pcomment="",+                ptype=RegularPosting,+                ptransaction=Nothing+              }+             ],+             tpreceding_comment_lines=""+           }+          ]+          []+          []+          ""+          ""+          (TOD 0 0)+          ""++ledger7 = journalToLedger nullfilterspec journal7++ledger8_str = unlines+ ["2008/1/1 test           "+ ,"  a:b          10h @ $40"+ ,"  c:d                   "+ ,""+ ]++timelogentry1_str  = "i 2007/03/11 16:19:00 hledger\n"+timelogentry1 = TimeLogEntry In (parsedatetime "2007/03/11 16:19:00") "hledger"++timelogentry2_str  = "o 2007/03/11 16:30:00\n"+timelogentry2 = TimeLogEntry Out (parsedatetime "2007/03/11 16:30:00") ""++a1 = Mixed [(hours 1){price=Just $ Mixed [Amount (comm "$") 10 Nothing]}]+a2 = Mixed [(hours 2){price=Just $ Mixed [Amount (comm "EUR") 10 Nothing]}]+a3 = Mixed $ amounts a1 ++ amounts a2++journalWithAmounts :: [String] -> Journal+journalWithAmounts as =+        Journal+        []+        []+        [t | a <- as, let t = nulltransaction{tdescription=a,tpostings=[nullposting{pamount=parse a,ptransaction=Just t}]}]+        []+        []+        ""+        ""+        (TOD 0 0)+        ""+    where parse = fromparse . parseWithCtx emptyCtx postingamount . (" "++)+

@@ -0,0 +1,77 @@+{-# LANGUAGE CPP #-}+{-|++Utilities for top-level modules and ghci. See also Hledger.Data.IO and+Hledger.Data.Utils.++-}++module Hledger.Cli.Utils+    (+     withJournalDo,+     journalFromStringWithOpts,+     openBrowserOn+    )+where+import Control.Monad.Error+import Hledger.Data+import Hledger.Cli.Options (Opt(..),journalFilePathFromOpts) -- ,optsToFilterSpec)+import System.Directory (doesFileExist)+import System.IO (stderr)+#if __GLASGOW_HASKELL__ <= 610+import System.IO.UTF8 (hPutStrLn)+#else+import System.IO (hPutStrLn)+#endif+import System.Exit+import System.Process (readProcessWithExitCode)+import System.Info (os)+++-- | Parse the user's specified journal file and run a hledger command on+-- it, or report a parse error. This function makes the whole thing go.+withJournalDo :: [Opt] -> [String] -> String -> ([Opt] -> [String] -> Journal -> IO ()) -> IO ()+withJournalDo opts args cmdname cmd = do+  -- We kludgily read the file before parsing to grab the full text, unless+  -- it's stdin, or it doesn't exist and we are adding. We read it strictly+  -- to let the add command work.+  f <- journalFilePathFromOpts opts+  fileexists <- doesFileExist f+  let creating = not fileexists && cmdname == "add"+      costify = (if CostBasis `elem` opts then journalConvertAmountsToCost else id)+      runcmd = cmd opts args . costify+  if creating+   then runcmd nulljournal+   else (runErrorT . parseJournalFile) f >>= either parseerror runcmd+    where parseerror e = hPutStrLn stderr e >> exitWith (ExitFailure 1)++-- | Get a journal from the given string and options, or throw an error.+journalFromStringWithOpts :: [Opt] -> String -> IO Journal+journalFromStringWithOpts opts s = do+    j <- journalFromString s+    let cost = CostBasis `elem` opts+    return $ (if cost then journalConvertAmountsToCost else id) j++-- | Attempt to open a web browser on the given url, all platforms.+openBrowserOn :: String -> IO ExitCode+openBrowserOn u = trybrowsers browsers u+    where+      trybrowsers (b:bs) u = do+        (e,_,_) <- readProcessWithExitCode b [u] ""+        case e of+          ExitSuccess -> return ExitSuccess+          ExitFailure _ -> trybrowsers bs u+      trybrowsers [] u = do+        putStrLn $ printf "Sorry, I could not start a browser (tried: %s)" $ intercalate ", " browsers+        putStrLn $ printf "Please open your browser and visit %s" u+        return $ ExitFailure 127+      browsers | os=="darwin"  = ["open"]+               | os=="mingw32" = ["start"]+               | otherwise     = ["sensible-browser","gnome-www-browser","firefox"]+    -- jeffz: write a ffi binding for it using the Win32 package as a basis+    -- start by adding System/Win32/Shell.hsc and follow the style of any+    -- other module in that directory for types, headers, error handling and+    -- what not.+    -- ::ShellExecute(NULL, "open", "www.somepage.com", NULL, NULL, SW_SHOWNORMAL);+    -- ::ShellExecute(NULL, "open", "firefox.exe", "www.somepage.com" NULL, SW_SHOWNORMAL);+

@@ -0,0 +1,77 @@+{-# LANGUAGE CPP #-}+{-+Version-related utilities. See the Makefile for details of our version+numbering policy.+-}++module Hledger.Cli.Version+where+import System.Info (os, arch)+import Hledger.Data.Utils++-- version and PATCHLEVEL are set by the makefile+version       = "0.10.0"++#ifdef PATCHLEVEL+patchlevel = "." ++ show PATCHLEVEL -- must be numeric !+#else+patchlevel = ""+#endif++progname      = "hledger"+timeprogname  = "hours"++buildversion  = version ++ patchlevel :: String++binaryfilename = prettify $ splitAtElement '.' buildversion :: String+                where+                  prettify (major:minor:bugfix:patches:[]) =+                      printf "hledger-%s.%s%s%s-%s-%s%s" major minor bugfix' patches' os' arch suffix+                          where+                            bugfix'+                                | bugfix `elem` ["0"{-,"98","99"-}] = ""+                                | otherwise = '.' : bugfix+                            patches'+                                | patches/="0" = '+' : patches+                                | otherwise = ""+                            (os',suffix)+                                | os == "darwin"  = ("mac","")+                                | os == "mingw32" = ("windows",".exe")+                                | otherwise       = (os,"")+                  prettify (major:minor:bugfix:[]) = prettify [major,minor,bugfix,"0"]+                  prettify (major:minor:[])        = prettify [major,minor,"0","0"]+                  prettify (major:[])              = prettify [major,"0","0","0"]+                  prettify []                      = error "VERSION is empty, please fix"+                  prettify _                       = error "VERSION has too many components, please fix"++versionstr    = prettify $ splitAtElement '.' buildversion :: String+                where+                  prettify (major:minor:bugfix:patches:[]) =+                      printf "%s.%s%s%s" major minor bugfix' patches'+                          where+                            bugfix'+                                | bugfix `elem` ["0"{-,"98","99"-}] = ""+                                | otherwise = '.' : bugfix+                            patches'+                                | patches/="0" = "+"++patches+                                | otherwise = ""+                  prettify s = intercalate "." s++versionmsg    = progname ++ "-" ++ versionstr ++ configmsg :: String+    where configmsg+              | null configflags = " with no extras"+              | otherwise = " with " ++ intercalate ", " configflags++configflags   = tail [""+#ifdef CHART+  ,"chart"+#endif+#ifdef VTY+  ,"vty"+#endif+#if defined(WEB)+  ,"web (using simpleserver)"+#elif defined(WEBHAPPSTACK)+  ,"web (using happstack)"+#endif+ ]

@@ -1,47 +0,0 @@-{-# LANGUAGE CPP #-}-{-|-The main function is in this separate module so it can be imported by-benchmark scripts. As a side benefit, this avoids a weakness of sp, which-doesn't allow both #! and \{\-\# lines.--}--module HledgerMain where-#if __GLASGOW_HASKELL__ <= 610-import Prelude hiding (putStr, putStrLn)-import System.IO.UTF8-#endif--import Commands.All-import Ledger-import Options-import Tests-import Utils (withLedgerDo)-import Version (versionmsg, binaryfilename)--main :: IO ()-main = do-  (opts, cmd, args) <- parseArguments-  run cmd opts args-    where-      run cmd opts args-       | Help `elem` opts             = putStr usage-       | Version `elem` opts          = putStrLn versionmsg-       | BinaryFilename `elem` opts   = putStrLn binaryfilename-       | cmd `isPrefixOf` "balance"   = withLedgerDo opts args cmd balance-       | cmd `isPrefixOf` "convert"   = withLedgerDo opts args cmd convert-       | cmd `isPrefixOf` "print"     = withLedgerDo opts args cmd print'-       | cmd `isPrefixOf` "register"  = withLedgerDo opts args cmd register-       | cmd `isPrefixOf` "histogram" = withLedgerDo opts args cmd histogram-       | cmd `isPrefixOf` "add"       = withLedgerDo opts args cmd add-       | cmd `isPrefixOf` "stats"     = withLedgerDo opts args cmd stats-#ifdef VTY-       | cmd `isPrefixOf` "ui"        = withLedgerDo opts args cmd ui-#endif-#if defined(WEB) || defined(WEBHAPPSTACK)-       | cmd `isPrefixOf` "web"       = withLedgerDo opts args cmd web-#endif-#ifdef CHART-       | cmd `isPrefixOf` "chart"       = withLedgerDo opts args cmd chart-#endif-       | cmd `isPrefixOf` "test"      = runtests opts args >> return ()-       | otherwise                    = putStr usage

@@ -0,0 +1,903 @@+---+title: hledger manual+---++# hledger manual++This is the official hledger manual. You may also want to visit the+[http://hledger.org](http://hledger.org) home page, the+[hledger for techies](README2.html) page, and for background,+[c++ ledger's manual](http://joyful.com/repos/ledger/doc/ledger.html).++## User Guide++### Introduction++hledger is a program for tracking money, time, or any other commodity,+using a plain text file format and the simple but powerful principles of+double-entry accounting.++It is modelled closely on+[John Wiegley's ledger](http://wiki.github.com/jwiegley/ledger) (aka "c+++ledger"), with some features removed and some new ones added. I wrote+hledger because I wanted to build financial tools in the Haskell+programming language rather than in C++.++hledger's basic function is to generate register and balance reports from+a plain text ledger file, at the command line or via the web or curses+interface. You can use it to, eg,++-   track spending and income+-   see time reports by day/week/month/project+-   get accurate numbers for client billing and tax filing+-   track invoices++hledger aims to help both computer experts and every-day users gain+clarity in their finances and time management. For now though, it is most+useful to technically-minded folks who are comfortable with command-line+tools.++hledger is copyright (c) 2007-2009 Simon Michael+<[simon@joyful.com](mailto:simon@joyful.com)\> and contributors and+released as Free Software under GPL version 3 or later.++### Installing++hledger works on all major platforms; here are the [release+notes](http://hledger.org/NEWS.html). One of these pre-built+[binaries](http://hledger.org/binaries/) might work for you, but at+present these are not very up-to-date, so the usual thing is to build+with the cabal-install tool:++1. If you don't already have the Glasgow Haskell Compiler and+   cabal-install, download and install the+   [Haskell Platform](http://hackage.haskell.org/platform/).  Or, you may+   be able to use platform packages; eg on Ubuntu Lucid, do `apt-get+   install ghc6 cabal-install happy`.++2. Make sure ~/.cabal/bin is in your path. This is useful so that you can+   run hledger by just typing "hledger", and necessary if (eg) you install+   with -fweb, to avoid an installation failure..++3. Install hledger with cabal-install:++        cabal update+        cabal install hledger++    You can add the following options to the install command to include extra features+    (these are not enabled by default as they are harder to build):++    - `-fvty` - builds the [ui](#ui) command. (Not available on microsoft+        windows.)++    - `-fweb` - builds the [web](#web) command.++    - `-fchart` builds the [chart](#chart) command. This requires+        [gtk2hs](http://www.haskell.org/gtk2hs/download/), which you'll+        need to install yourself as it's not yet provided by the haskell+        platform or cabal.++#### Installation Problems++The above builds a lot of software, and it's not always smooth sailing.+Here are some known issues and things to try:++- **Ask for help on [#hledger](irc://freenode.net/#hledger) or [#haskell](irc://freenode.net/#haskell)**++- **cabal update.** If you didn't already, ``cabal update`` and try again.++- **Do you have a new enough version of GHC ?** As of 2010, 6.10 and 6.12+    are supported, 6.8 might or might not work.++- **Do you have a new enough version of cabal-install ?**+  Newer versions tend to be better at resolving problems. 0.6.2 has been+  known to fail where newer versions succeed.++- **Installation fails, reporting problems with a hledger package.**+  That hledger release might have a coding error (heavens), or+  compatibility problems have been revealed as dependencies have been+  updated.  You could try installing the [previous hledger+  version](http://hackage.haskell.org/package/hledger) (``cabal+  install hledger-0.x``) or, preferably, the latest hledger+  development code, which is likely to work best.  In a nutshell,+  install [darcs](http://darcs.net) and:++        darcs get --lazy http://joyful.com/repos/hledger+        cd hledger/hledger-lib; cabal install+        cd ..; cabal install [-fweb] [-fvty]++- **Installation fails, reporting problems with packages A, B and C.**+  Resolve the problem packages one at a time. Eg, cabal install A.  Look+  for the cause of the failure near the end of the output. If it's not+  apparent, try again with `-v2` or `-v3` for more verbose output.++- **Could not run trhsx.**+  You are installing -fweb, which needs to run the ``trhsx`` executable.+  It is usually installed in ~/.cabal/bin, which may not be in your path.++- **Could not run happy.**+  A package (eg haskell-src-exts) needs to run the ``happy`` executable.+  If not using the haskell platform, install the appropriate platform+  package which provides it (eg apt-get install happy).++- **A ghc panic while building** might be due to+    [http://hackage.haskell.org/trac/ghc/ticket/3862](http://hackage.haskell.org/trac/ghc/ticket/3862)++- **cabal could not reconcile dependencies**+  In some cases, especially if you have installed/updated many packages or+  GHC itself, cabal may not be able to figure out the installation.  This+  can also arise due to non-optimal dependency information configured in+  hledger or its dependencies. You can sometimes work around this by using+  cabal's `--constraint` option.++### Basic usage++Basic usage is:++    hledger [OPTIONS] [COMMAND [PATTERNS]]++[OPTIONS](#overview) may appear anywhere on the command line.+[COMMAND](#commands) is one of: add, balance, chart, convert, histogram,+print, register, stats, ui, web, test (defaulting to balance). The+optional [PATTERNS](#filter-patterns) are regular expressions which select+a subset of the ledger data.++hledger looks for data in a ledger file, usually `.ledger` in your home+directory. You can specify a different file with the -f option (use - for+standard input) or `LEDGER` environment variable.++To get started, make yourself a ledger file containing some+transactions. You can copy the sample file below (or+[sample.ledger](http://joyful.com/repos/hledger/sample.ledger)) and save+it as `.ledger` in your home directory. Or, just run `hledger add` and+enter a few transactions. Now you can try some of these commands, or read+on:++    hledger --help                        # show command-line help+    hledger balance                       # all accounts with aggregated balances+    hledger bal --depth 1                 # only top-level accounts+    hledger register                      # transaction register+    hledger reg income                    # transactions to/from an income account+    hledger reg checking                  # checking transactions+    hledger reg desc:shop                 # transactions with shop in the description+    hledger histogram                     # transactions per day, or other interval+    hledger add                           # add some new transactions to the ledger file+    hledger ui                            # curses ui, if installed with -fvty+    hledger web                           # web ui, if installed with -fweb+    hledger chart                         # make a balance chart, if installed with -fchart++You'll find more examples below.++### File format++hledger's data file, aka the ledger, is a plain text representation of a+standard accounting journal. It contains a number of transactions, each+describing a transfer of money (or another commodity) between two or more+named accounts. Here's an example:++    ; A sample ledger file. This is a comment.+    +    2008/01/01 income               ; <- transaction's first line starts in column 0, contains date and description+        assets:bank:checking  $1    ; <- posting lines start with whitespace, each contains an account name+        income:salary        $-1    ;    followed by at least two spaces and an amount+    +    2008/06/01 gift+        assets:bank:checking  $1    ; <- at least two postings in a transaction+        income:gifts         $-1    ; <- their amounts must balance to 0+    +    2008/06/02 save+        assets:bank:saving    $1+        assets:bank:checking        ; <- one amount may be omitted; here $-1 is inferred+    +    2008/06/03 eat & shop           ; <- description can be anything+        expenses:food         $1+        expenses:supplies     $1    ; <- this transaction debits two expense accounts+        assets:cash                 ; <- $-2 inferred+    +    2008/12/31 * pay off            ; <- an optional * after the date means "cleared" (or anything you want)+        liabilities:debts     $1+        assets:bank:checking++Each transaction has a date, description, and two or more postings (of+some amount to some account) which must balance to 0. As a convenience,+one posting's amount may be left blank and will be inferred.++Note that account names may contain single spaces, while the amount must+be separated from the account name by at least two spaces.++An amount is a number, with an optional currency/commodity symbol or word+on either the left or right. Note: when writing a negative amount with a+left-side currency symbol, the minus goes after the symbol, eg `$-1`.++This file format is also compatible with c++ ledger, so you can use both+tools. For more details, see+[File format compatibility](#file-format-compatibility).++## Reference++### Overview++This version of hledger mimics a subset of ledger 3.x, and adds some+features of its own. We currently support regular ledger entries, timelog+entries, multiple commodities, (fixed) price history, virtual postings,+filtering by account and description, the familiar print, register &+balance commands and several new commands. We handle (almost) the full+period expression syntax, and very limited display expressions consisting+of a simple date predicate.++Here is the command-line help:++    Usage: hledger [OPTIONS] [COMMAND [PATTERNS]]+           hledger [OPTIONS] convert CSVFILE+           hledger [OPTIONS] stats+    +    hledger uses your ~/.ledger or $LEDGER file, or another specified with -f+    +    COMMAND is one of (may be abbreviated):+     add       - prompt for new transactions and add them to the ledger+     balance   - show accounts, with balances+     convert   - read CSV bank data and display in ledger format+     histogram - show a barchart of transactions per day or other interval+     print     - show transactions in ledger format+     register  - show transactions as a register with running balance+     stats     - show various statistics for a ledger+     ui        - run a simple text-based UI+     web       - run a simple web-based UI+     chart     - generate balances pie chart+     test      - run self-tests+    +    PATTERNS are regular expressions which filter by account name.+    Prefix with desc: to filter by transaction description instead.+    Prefix with not: to negate a pattern. When using both, not: comes last.+    +    DATES can be y/m/d or ledger-style smart dates like "last month".+    +    Options:+     -f FILE  --file=FILE          use a different ledger/timelog file; - means stdin+              --no-new-accounts    don't allow to create new accounts+     -b DATE  --begin=DATE         report on transactions on or after this date+     -e DATE  --end=DATE           report on transactions before this date+     -p EXPR  --period=EXPR        report on transactions during the specified period+                                   and/or with the specified reporting interval+     -C       --cleared            report only on cleared transactions+     -U       --uncleared          report only on uncleared transactions+     -B       --cost, --basis      report cost of commodities+              --depth=N            hide accounts/transactions deeper than this+     -d EXPR  --display=EXPR       show only transactions matching EXPR (where+                                   EXPR is 'dOP[DATE]' and OP is <, <=, =, >=, >)+              --effective          use transactions' effective dates, if any+     -E       --empty              show empty/zero things which are normally elided+     -R       --real               report only on real (non-virtual) transactions+              --no-total           balance report: hide the final total+     -W       --weekly             register report: show weekly summary+     -M       --monthly            register report: show monthly summary+     -Q       --quarterly          register report: show quarterly summary+     -Y       --yearly             register report: show yearly summary+     -h       --help               show this help+     -V       --version            show version information+     -v       --verbose            show verbose test output+              --binary-filename    show the download filename for this hledger build+              --debug              show extra debug output; implies verbose+              --debug-no-ui        run ui commands with no output+     -o FILE  --output=FILE        chart: output filename (default: hledger.png)+              --items=N            chart: number of accounts to show (default: 10)+              --size=WIDTHxHEIGHT  chart: image size (default: 600x400)++### Commands++#### Reporting commands++These commands are read-only, that is they never modify your data.++##### print++The print command displays full transactions from the ledger file, tidily+formatted and showing all amounts explicitly. The output of print is+always valid ledger data.++hledger's print command also shows all unit prices in effect, or (with+-B/--cost) shows cost amounts.++Examples:++    $ hledger print+    $ hledger print employees:bob | hledger -f- register expenses++##### register++The register command displays postings, one per line, and their running+total. With a [reporting interval](#reporting-interval) it will aggregate+similar postings within each interval.++Examples:++    $ hledger register+    $ hledger register --monthly -E rent++##### balance++The balance command displays accounts and their balances.++Examples:++    $ hledger balance+    $ hledger balance food -p 'last month'+    $ for y in 2006 2007 2008 2009 2010; do echo; echo $y; hledger -f $y.ledger balance ^expenses --depth 2; done++##### chart++(optional feature)++The chart command saves a pie chart of your top account balances to an+image file (usually "hledger.png", or use -o/--output FILE). You can+adjust the image resolution with --size=WIDTHxHEIGHT, and the number of+accounts with --items=N.++Note that positive and negative balances will not be displayed together in+the same chart; any balances not matching the sign of the first one will+be omitted.++To show only accounts above a certain depth, use the --depth+option. Otherwise, the chart can include accounts at any depth. If a+parent and child account are both displayed, the parent's balance excludes+the child's.++Examples:++    $ hledger chart assets --depth 2+    $ hledger chart liabilities --depth 2+    $ hledger chart ^expenses -o balance.png --size 1000x600 --items 20+    $ for m in 01 02 03 04 05 06 07 08 09 10 11 12; do hledger -p 2009/$m chart ^expenses --depth 2 -o expenses-2009$m.png --size 400x300; done++##### histogram++The histogram command displays a quick bar chart showing transaction+counts, per day, week, month or other reporting interval. It is+experimental.++Examples:++    $ hledger histogram -p weekly dining++##### stats++The stats command displays quick summary information for the ledger.++Examples:++    $ hledger stats++##### ui++(optional feature)++The ui command starts hledger's curses (full-screen, text) user interface,+which allows interactive navigation of the print/register/balance+reports. This lets you browse around your numbers and get quick insights+with less typing.++Examples:++$ hledger ui $ hledger ui -BE food++#### Modifying commands++The following commands can alter your ledger file.++##### add++The add command prompts interactively for new transactions, and adds them+to the ledger. It is experimental.++Examples:++$ hledger add $ hledger add accounts:personal:bob++##### web++(optional feature)++The web command starts hledger's web interface, and tries to open a web+browser to view it (if this fails, you'll have to visit the indicated url+yourself.) The web ui combines the features of the print, register,+balance and add commands.++Examples:++    $ hledger web+    $ hledger web --debug -f demo.ledger -p thisyear++#### Other commands++##### convert++The convert command reads a+[CSV](http://en.wikipedia.org/wiki/Comma-separated_values) file you have+downloaded from your bank, and prints out the transactions in ledger+format, suitable for adding to your ledger. It does not alter your ledger+directly.++This can be a lot quicker than entering every transaction by hand.  (The+downside is that you are less likely to notice if your bank makes an+error!) Use it like this:++    $ hledger convert FILE.csv >FILE.ledger++where FILE.csv is your downloaded csv file. This will convert the csv data+using conversion rules defined in FILE.rules (auto-creating this file if+needed), and save the output into a temporary ledger file. Then you should+review FILE.ledger for problems; update the rules and convert again if+needed; and finally copy/paste transactions which are new into your main+ledger.++###### .rules file++convert requires a \*.rules file containing data definitions and rules for+assigning destination accounts to transactions; it will be auto-created if+missing. Typically you will have one csv file and one rules file per bank+account. Here's an example rules file for converting csv data from a Wells+Fargo checking account:++    base-account assets:bank:checking+    date-field 0+    description-field 4+    amount-field 1+    currency $+    +    # account-assigning rules+    +    SPECTRUM+    expenses:health:gym+    +    ITUNES+    BLKBSTR=BLOCKBUSTER+    expenses:entertainment+    +    (TO|FROM) SAVINGS+    assets:bank:savings++This says:++-   the ledger account corresponding to this csv file is+    assets:bank:checking+-   the first csv field is the date, the second is the amount, the+    fifth is the description+-   prepend a dollar sign to the amount field+-   if description contains SPECTRUM (case-insensitive), the+    transaction is a gym expense+-   if description contains ITUNES or BLKBSTR, the transaction is+    an entertainment expense; also rewrite BLKBSTR as BLOCKBUSTER+-   if description contains TO SAVINGS or FROM SAVINGS, the+    transaction is a savings transfer++Notes:++-   Lines beginning with \# or ; are ignored (but avoid using+    inside an account rule)++-   Definitions must come first, one per line, all in one+    paragraph. Each is a name and a value separated by whitespace.+    Supported names are: base-account, date-field, status-field,+    code-field, description-field, amount-field, currency-field,+    currency. All are optional and will use defaults if not specified.++-   The remainder of the file is account-assigning rules. Each is a+    paragraph consisting of one or more description-matching patterns+    (case-insensitive regular expressions), one per line, followed by+    the account name to use when the transaction's description matches+    any of these patterns.++-   A match pattern may be followed by a replacement pattern,+    separated by `=`, which rewrites the matched part of the+    description. Use this if you want to clean up messy bank data. To+    rewrite the entire description, use a match pattern like+    `.*PAT.*=REPL`. Within a replacement pattern, you can refer to the+    matched text with `\0` and any regex groups with `\1`, `\2` in the+    usual way.+++##### test++This command runs hledger's internal self-tests and displays a quick+report. The -v option shows more detail, and a pattern can be provided to+filter tests by name. It's mainly used in development, but it's also nice+to be able to run a sanity check at any time..++Examples:++    $ hledger test+    $ hledger test -v balance++### Other features++#### Filter patterns++Most commands accept one or more filter pattern arguments after the+command name, to select a subset of transactions or postings. There are+two kinds of pattern:++-   an account pattern, which is a regular expression. This is+    matched against postings' accounts. Optionally, it may be prefixed+    with `not:` in which case the match is negated.++-   a description pattern, like the above but prefixed with+    `desc:`. This is matched against transactions' descriptions. Note,+    when negating a desc: pattern, not: goes last, eg:+    `desc:not:someregexp`.+++When you specify multiple filter patterns, hledger generally selects the+transactions or postings which match (or negatively match)++> *any of the account patterns* AND+> *any of the description patterns*++The [print](#print) command selects transactions which++> *match any of the description patterns* AND+> *have any postings matching any of the positive account patterns*+> AND+> *have no postings matching any of the negative account patterns*++#### Dates++##### Simple dates++Within a ledger file, dates must follow a fairly simple year/month/day+format. Examples:++> `2010/01/31` or `2010/1/31` or `2010-1-31` or `2010.1.31`++The [add](#add) command and the [web](#web) add form, as well as some+other places, accept [smart dates](#smart-dates) - more about those below.++##### Default year++You can set a default year with a `Y` directive in the ledger, then+subsequent dates may be written as month/day. Eg:++    Y2009+    +    12/15 ...+    +    Y2010+    +    1/31 ...++##### Actual and effective dates++Frequently, a real-life transaction has two (or more) dates of+interest. For example, you might make a purchase on friday with a debit+card, and it might clear (take effect in your bank account) on+tuesday. It's sometimes useful to model this accurately, so that your+hledger balances match reality. So, you can specify two dates for a+transaction, the *actual* and *effective* date, separated by `=`. Eg:++    2010/2/19=2010/2/23 ...++Then you can use the `--effective` flag to prefer the effective (second)+date, if any, in reports. This is useful for, eg, seeing a more accurate+daily balance while reconciling a bank account.++So, what do *actual* and *effective* mean, exactly ? I always assumed that+the actual date comes first, and is "the date you enacted the+transaction", while the effective date comes second, and is optional, and+is "the date the transaction took effect" (showed up in your bank+balance).++Unfortunately, this is the reverse of c++ ledger's interpretation (cf+[differences](#other-differences)). However it's not *too* serious; just+remember that hledger requires the first date; allows an optional second+date which the `--effective` flag will select; and the meaning of "actual"+and "effective" is up to you.++The second date may omit the year if it is the same as the first's.++##### Smart dates++In [period expressions](#period-expressions), the `-b` and `-e` options,+the [add](#add) command and the [web](#web) add form, more flexible "smart+dates" are allowed. Here are some examples:++-   `2009/1/1`, `2009/01/01`, `2009-1-1`, `2009.1.1`, `2009/1`,+    `2009` (january 1, 2009)+-   `1/1`, `january`, `jan`, `this year` (january 1, this year)+-   `next year` (january 1, next year)+-   `this month` (the 1st of the current month)+-   `this week` (the most recent monday)+-   `last week` (the monday of the week before this one)+-   `today`, `yesterday`, `tomorrow`++Spaces are optional, so eg: `-p lastmonth` is valid.++#### Period expressions++hledger supports flexible "period expressions" with the `-p/--period`+option to select transactions within a period of time (like 2009) and/or+with a reporting interval (like weekly). hledger period expressions are+similar but not identical to c++ ledger's.++Here is a basic period expression specifying the first quarter of 2009+(start date is always included, end date is always excluded):++    -p "from 2009/1/1 to 2009/4/1"++Keywords like "from" and "to" are optional, and so are the spaces.  Just+don't run two dates together:++    -p2009/1/1to2009/4/1+    -p"2009/1/1 2009/4/1"++Dates are [smart dates](#smart-dates), so if the current year is 2009, the+above can also be written as:++    -p "1/1 to 4/1"+    -p "january to apr"+    -p "this year to 4/1"++If you specify only one date, the missing start or end date will be the+earliest or latest transaction in your ledger data:++    -p "from 2009/1/1"  (everything after january 1, 2009)+    -p "from 2009/1"    (the same)+    -p "from 2009"      (the same)+    -p "to 2009"        (everything before january 1, 2009)++A single date with no "from" or "to" defines both the start and end date+like so:++    -p "2009"           (the year 2009;    equivalent to "2009/1/1 to 2010/1/1")+    -p "2009/1"         (the month of jan; equivalent to "2009/1/1 to 2009/2/1")+    -p "2009/1/1"       (just that day;    equivalent to "2009/1/1 to 2009/1/2")++##### Reporting interval++You can also specify a reporting interval, which causes the "register"+command to summarise the transactions in each interval.  It goes before+the dates, and can be: "daily", "weekly", "monthly", "quarterly", or+"yearly". An "in" keyword is optional, and so are the dates:++    -p "weekly from 2009/1/1 to 2009/4/1"+    -p "monthly in 2008"+    -p "monthly from 2008"+    -p "quarterly"++A reporting interval may also be specified with the -W/--weekly,+-M/--monthly, -Q/--quarterly, and -Y/--yearly options. However..++##### -p overrides other flags++Note: any period option on the command line will override the -b, -e, -W,+-Q and -Y flags.++#### Display expressions++A display expression with the `-d/--display` option selects which+transactions will be displayed (unlike a+[period expression](#period-expressions), which selects the transactions+to be used for calculation).++hledger currently supports a very small subset of c++ ledger's display+expressions, namely: transactions before or after a date.  This is useful+for displaying your recent check register with an accurate running+total. Note the use of \>= here to include the first of the month:++    $ hledger register -d "d>=[this month]"++#### Depth limiting++With the `--depth N` option, reports will show only the uppermost accounts+in the account tree, down to level N. This is most useful with+[balance](#balance) (and [chart](#chart)). For example:++    $ hledger balance --depth 2++shows a more concise balance report displaying only the top two levels of+accounts. This example with [register](#register):++    $ hledger register --depth 1++would show only the postings to top-level accounts, which usually means+none.++#### Prices++You can specify a commodity's unit price, or exchange rate, in terms of+another commodity. There are two ways.++First, you can set the price explicitly for a single posting by writing `@+PRICE` after the amount. PRICE is another amount in a different+commodity. Eg, here one hundred euros was purchased at $1.35 per euro:++    2009/1/2 x+     expenses:foreign currency       €100 @ $1.35+     assets++Secondly, you can set the price for a commodity as of a certain date, by+entering a historical price record. These are lines beginning with "P",+appearing anywhere in the ledger between transactions. Eg, here we say the+exchange rate for 1 euro is $1.35 on 2009/1/1 (and thereafter, until a+newer price record is found):++    P 2009/1/1 € $1.35  ; <- historical price: P, date, commodity symbol, price in 2nd commodity (space-separated)+    +    2009/1/2 x+     expenses:foreign currency       €100+     assets++The print command shows any unit prices in effect. Either example above+will show:++    $ hledger print+    2009/01/02 x+        expenses:foreign currency  €100 @ $1.35+        assets                     €-100 @ $1.35++To see amounts converted to their total cost, use the `--cost/-B` flag+with any command:++    $ hledger print --cost+    2009/01/02 x+        expenses:foreign currency       $135.00+        assets                         $-135.00++The `--cost/-B` flag does only one lookup step, ie it will not look up the+price of a price's commodity.++Note hledger handles prices differently from c++ ledger in one important+respect: we assume unit prices do not vary over time.  This is good for+simple reporting of foreign currency transactions, but not for tracking+fluctuating-value investments or capital gains.++#### Timelog reporting++hledger will also read timelog files in timeclock.el format. As a+convenience, if you invoke hledger via an "hours" symlink or copy, it uses+your timelog file (\~/.timelog or $TIMELOG) by default, rather than your+ledger.++Timelog entries look like this:++    i 2009/03/31 22:21:45 some:project+    o 2009/04/01 02:00:34++The clockin description is treated as an account name. Here are some+queries to try (after downloading+[sample.timelog](http://joyful.com/repos/hledger/sample.timelog)):++    ln -s `which hledger` ~/bin/hours            # set up "hours" in your path+    export TIMELOG=sample.timelog+    hours                                        # show all time balances+    hours -p 'last week'                         # last week+    hours -p thismonth                           # the space is optional+    hours -p 'from 1/15' register project        # project sessions since jan 15+    hours -p 'weekly' reg --depth 1 -E           # weekly time summary++This is a useful feature, if you can find a way to efficiently record+timelog entries. The "ti" and "to" scripts may be available from the c+++ledger 2.x repository. I use+[timeclock-x.el](http://www.emacswiki.org/emacs/timeclock-x.el) and+[ledgerutils.el](http://joyful.com/repos/ledgertools/ledgerutils.el) in+emacs.++### Compatibility with c++ ledger++#### Implementation++Unlike c++ ledger, hledger is written in the Haskell programming+language. Haskell enables a coding style known as pure lazy functional+programming, which holds the promise of more robust and maintainable+software built with fewer lines of code. Haskell also provides a more+abstracted, portable platform which can make deployment and installation+easier in some cases. Haskell also brings some new challenges such as+managing memory growth.++#### File format compatibility++hledger's file format is mostly identical with that of c++ ledger version+2, with some features (like modifier and periodic entries) being accepted,+but ignored. There are also some subtle differences in parser behaviour+(eg comments may be permissible in different places.) C++ ledger version 3+has introduced additional syntax, which current hledger probably fails to+parse.++Generally, it's easy to keep a ledger file that works with both hledger+and c++ledger if you avoid the more esoteric syntax.  Occasionally you'll+need to make small edits to restore compatibility for one or the other.++#### Features not supported++c++ ledger features not currently supported include: modifier and periodic+entries, and the following c++ ledger options and commands:++    Basic options:+    -o, --output FILE      write output to FILE+    -i, --init-file FILE   initialize ledger using FILE (default: ~/.ledgerrc)+    -a, --account NAME     use NAME for the default account (useful with QIF)+    +    Report filtering:+    -c, --current          show only current and past entries (not future)+        --period-sort EXPR sort each report period's entries by EXPR+    -L, --actual           consider only actual (non-automated) transactions+    -r, --related          calculate report using related transactions+        --budget           generate budget entries based on periodic entries+        --add-budget       show all transactions plus the budget+        --unbudgeted       show only unbudgeted transactions+        --forecast EXPR    generate forecast entries while EXPR is true+    -l, --limit EXPR       calculate only transactions matching EXPR+    -t, --amount EXPR      use EXPR to calculate the displayed amount+    -T, --total EXPR       use EXPR to calculate the displayed total+    +    Output customization:+    -n, --collapse         Only show totals in the top-most accounts.+    -s, --subtotal         other: show subtotals+    -P, --by-payee         show summarized totals by payee+    -x, --comm-as-payee    set commodity name as the payee, for reporting+        --dow              show a days-of-the-week report+    -S, --sort EXPR        sort report according to the value expression EXPR+    -w, --wide             for the default register report, use 132 columns+        --head COUNT       show only the first COUNT entries (negative inverts)+        --tail COUNT       show only the last COUNT entries (negative inverts)+        --pager PAGER      send all output through the given PAGER program+    -A, --average          report average transaction amount+    -D, --deviation        report deviation from the average+    -%, --percentage       report balance totals as a percentile of the parent+        --totals           in the "xml" report, include running total+    -j, --amount-data      print only raw amount data (useful for scripting)+    -J, --total-data       print only raw total data+    -y, --date-format STR  use STR as the date format (default: %Y/%m/%d)+    -F, --format STR       use STR as the format; for each report type, use:+        --balance-format      --register-format       --print-format+        --plot-amount-format  --plot-total-format     --equity-format+        --prices-format       --wide-register-format+    +    Commodity reporting:+        --price-db FILE    sets the price database to FILE (def: ~/.pricedb)+    -L, --price-exp MINS   download quotes only if newer than MINS (def: 1440)+    -Q, --download         download price information when needed+    -O, --quantity         report commodity totals (this is the default)+    -V, --market           report last known market value+    -g, --performance      report gain/loss for each displayed transaction+    -G, --gain             report net gain/loss+    +    Commands:+    xml      [REGEXP]...   print matching entries in XML format+    equity   [REGEXP]...   output equity entries for matching accounts+    prices   [REGEXP]...   display price history for matching commodities+    entry DATE PAYEE AMT   output a derived entry, based on the arguments++#### Other differences++-   hledger recognises description and negative patterns by "desc:"+    and "not:" prefixes, unlike ledger 3's free-form parser+-   hledger doesn't require a space before command-line option+    values, you can write -f-+-   hledger's weekly reporting intervals always start on mondays+-   hledger shows start and end dates of the intervals requested,+    not just the span containing data+-   hledger period expressions don't support "biweekly",+    "bimonthly", or "every N days/weeks/..."+-   hledger always shows timelog balances in hours+-   hledger splits multi-day timelog sessions at midnight+-   hledger doesn't track the value of commodities with varying+    price; prices are fixed as of the transaction date+-   hledger print shows amounts for all postings, and shows unit+    prices for amounts which have them+-   hledger assumes a transaction's actual date comes first, and is+    required, while the optional effective date comes second (cf+    [Actual and effective dates](#actual-and-effective-dates))+-   hledger does not support per-posting actual or effective dates++### More examples and recipes++-   Here's a bash function that will run hledger chart and display+    the image in your (graphical) emacs:++        function chart () {+          hledger chart $* && emacsclient -n hledger.png+        }++    Example:++        $ chart food --depth 2 -p jan+

@@ -0,0 +1,344 @@+---+title: hledger news+---+hledger news+============++2010/05/23 hledger 0.10+........................++  * fix too-loose testpack dependency, missing safe dependency+  * fix ghc 6.12 compatibility with -fweb+  * fix handling of non-ascii arguments with ghc 6.12+  * fix "0.8" in --version output+  * fix an occasional stack overflow error due to infinite recursion in Posting/Transaction equality tests+  * the -fwebhappstack build flag is gone for now, to avoid a cabal problem+  * parsing: if there is no description, don't require a space after the transaction date+  * parsing: balance balanced-virtual postings separately, allow them to have an implicit amount+  * parsing: timelog entries now generate balanced transactions, using virtual postings+  * parsing: simpler high-level parse error message+  * parsing: clearer bad date errors+  * add: fix wrongful program exit on bad dates+  * print: negative account patterns now exclude transactions containing any posting to a matched account+  * vty: rename the ui command to vty for consistency+  * vty: fix restricted account scope when backing up to top level+  * web: fix non-ascii handling with ghc 6.12+  * web: fix a bug possibly affecting reload-on-change+  * consolidate module namespace under Hledger, api cleanups++  Stats:+  44 days, 81 commits since last release.+  Now at 4904 lines of code including tests, 144 tests, 53% coverage.++2010/04/10 hledger 0.9+......................++  * ghc 6.12 support+  * split off hledger-lib package, containing core types & utils+  * parsing: ignore D, C, N, tag, end tag directives; we should now accept any ledger 2.6 file+  * parsing: allow numbers in commodities if double-quoted, like ledger+  * parsing: allow transactions with empty descriptions+  * parsing: show a better error for illegal month/day numbers in dates+  * parsing: don't ignore trailing junk in a smart date, eg in web add form+  * parsing: don't ignore unparsed text following an amount+  * parsing: @ was being treated as a currency symbol+  * add: fix precision handling in default amounts (#19)+  * add: elide last amount in added transactions+  * convert: keep original description by default, allow backreferences in replace pattern+  * convert: basic csv file checking, warn instead of dying when it looks wrong+  * convert: allow blank/comment lines at end of rules file+  * print: always show zero amounts as 0, hiding any commodity/decimal places/price, like ledger+  * register: fix bad layout with years < 1000+  * register: fix a Prelude.head error with reporting interval, --empty, and --depth+  * register: fix a regression, register should not show posting comments+  * register: with --empty, intervals should continue to ends of the specified period+  * stats: better output when last transaction is in the future+  * stats: show commodity symbols, account tree depth, reorder slightly+  * web: -fweb now builds with simpleserver; to get happstack, use -fwebhappstack instead+  * web: pre-fill the add form with today's date+  * web: help links, better search form wording+  * web: show a proper error for a bad date in add form (#17)+  * web: fix for unicode search form values+  * web: fix stack overflow caused by regexpr, and handle requests faster (#14)+  * web: look for more-generic browser executables+  * web: more robust browser starting (#6)+  * error message cleanups+  * more tests, refactoring, docs++  Stats:+  58 days, 2 contributors, 102 commits since last release.+  Now at 3983 lines of non-test code, 139 tests, 53% coverage.++2010/02/11 hledger 0.8+......................++  * parsing: in date=date2, use first date's year as a default for the second+  * add: ctrl-d doesn't work on windows, suggest ctrl-c instead+  * add: --no-new-accounts option disallows new accounts (Roman Cheplyaka)+  * add: re-use the previous transaction's date as default (Roman Cheplyaka)+  * add: a command-line argument now filters by account during history matching (Roman Cheplyaka)+  * chart: new command, generates balances pie chart (requires -fchart flag, gtk2hs) (Roman Cheplyaka, Simon Michael)+  * register: make reporting intervals honour a display expression (#18)+  * web: fix help link+  * web: use today as default when adding with a blank date+  * web: re-enable account/period fields, they seem to be fixed, along with file re-reading (#16)+  * web: get static files from the cabal data dir, or the current dir when using make (#13)+  * web: preserve encoding during add, assuming it's utf-8 (#15)+  * fix some non-utf8-aware file handling (#15)+  * filter ledger again for each command, not just once at program start+  * refactoring, clearer data types++  Stats:+  62 days, 2 contributors, 76 commits since last release.+  Now at 3464 lines of non-test code, 97 tests, 53% test coverage.++2009/12/11 hledger 0.7+........................++  * price history support (first cut):+    P directives now work, though differently from c++ ledger. Each+    posting amount takes its fixed unit price from the price history (or+    @) when available. This is simple and useful for things like foreign+    currency expenses (but not investment tracking). Like ledger, balance+    and register don't show amount prices any more, and don't separate+    differently-priced amounts. Unlike ledger, print shows all amount+    prices, and supports -B.+  * --effective option, will use transactions' effective dates if any+  * convert: new rules file format, find/create rules file automatically,+    more robust parsing, more useful --debug output+  * print: always sort by date, fix long account name truncation, align+    amounts, show end of line comments, show all amounts for clarity+    (don't elide the final balancing amount)+  * ui: use vty 4, fixes non-ascii and gnome terminal problems (issues #3, #4)+  * web: allow data entry, react to data file changes, better layout, help+    links, remove histogram command and filter fields for now, fix bad+    localhost redirect, filter form did not work in eg firefox (issue #7),+    reset link did not work in all browsers+  * parsing: require whitespace between date and status code, allow (and+    ignore) a time in price records, better error messages, non-zero exit+    code on parse failure+  * display non-ascii error messages properly (issue #5)+  * fix an arithmetic bug that occasionally rejected valid transactions+  * fix a regex bug in showtree+  * don't break if HOME is undefined+  * --debug now implies --verbose+  * add functional tests like ledger's, use test-framework for speedy+    running, release shelltestrunner as a separate package+  * many hlint cleanups (Marko Kocić)+  * many site and documentation updates++  Stats:+  60 days, 1 contributor, 50 commits since last release.+  Now at 3377 lines of non-test code, 97 tests, 53% test coverage.++2009/06/22 hledger 0.6.1+........................++  * avoid use of exitSuccess which was breaking ghc 6.8/base 3 compatibility (issue #2)++2009/06/13 hledger 0.6+......................++  * now cabal-installable on unix, mac, and windows, with Haskell Platform+  * provide experimental platform binaries+  * parsing: fix a silly failure to open ledger file paths containing ~+  * parsing: show better errors for unbalanced transaction and missing default year+  * parsing: allow parentheses and brackets inside account names, as ledger does+  * parsing: fail on empty account name components, don't just ignore+  * add: description passed as arguments now affects first transaction only+  * add: better handling of virtual postings and default amounts+  * print, register: show virtual accounts bracketed/parenthesised+  * web: improved web ui supporting full patterns & period expressions+  * new "stats" command reports some ledger statistics+  * many dev/doc/deployment infrastructure improvements+  * move website into darcs repo, update home page+  * move issue tracker to google code++Release stats:++  * Contributors: Simon Michael+  * Days since last release: 21+  * Commits: 94+  * Lines of non-test code: 2865+  * Tests: 82+  * Test coverage: 53% expressions+  * Known errors: 3 (inconsistent eliding, vty-related failures)+  * Performance: similar (http://hledger.org/profs/200906131120.bench)++2009/05/23 hledger 0.5.1+.................................++  * two fixes: really disable vty flag by default, and include ConvertCommand in cabal file++2009/05/23 hledger 0.5+...............................++  * the vty flag is disabled by default again, to ease installation on windows+  * use ledger 3 terminology: a ledger contains transactions which contain postings+  * new "add" command prompts for transactions interactively and adds them to the ledger+  * new "convert" command transforms bank CSV exports to ledger format, with rule-based cleanup+  * new "histogram" command shows transaction counts per day or other reporting interval+  * most commands now work properly with UTF8-encoded text (Sergey Astanin)+  * invoking as "hours" is now less different: it just uses your timelog, not your ledger+  * ..quarterly/-Q option summarises by quarter+  * ..uncleared/-U option looks only at uncleared transactions+  * be more accurate about checking balanced amounts, don't rely on display precision+  * enforce balancing for bracketed virtual postings+  * fix bug in eliding of posting amounts+  * don't show trailing spaces on amountless postings+  * parse null input as an empty ledger+  * don't treat comments as part of transaction descriptions+  * require some postings in ledger transactions+  * require a non-empty description in ledger transactions+  * don't fail when matching an empty pattern, as in "not:"+  * make the web server handle the null path+  * code, api and documentation updates+  * add a contributor agreement/list++Release stats:++  * Contributors: Simon Michael, Sergey Astanin+  * Days since last release: 51+  * Commits: 101+  * Lines of non-test code: 2795+  * Tests: 76+  * Known errors: 0++..+  * Performance:+                              || hledger-0.4 | hledger-0.5 | ledger+     =========================++=============+=============+=======+     -f sample.ledger balance ||        0.01 |        0.01 |   0.06+     -f 1000.ledger balance   ||        1.33 |        1.46 |   0.53+     -f 10000.ledger balance  ||       15.28 |       16.35 |   4.67+++2009/04/03 hledger 0.4+...............................++  * new "web" command serves reports in a web browser (install with -f happs to build this)+  * make the vty-based curses ui a cabal build option, which will be ignored on MS windows+  * drop the ..options-anywhere flag, that is now the default+  * patterns now use not: and desc: prefixes instead of ^ and ^^+  * patterns are now case-insensitive, like ledger+  * !include directives are now relative to the including file (Tim Docker)+  * "Y2009" default year directives are now supported, allowing m/d dates in ledger+  * individual transactions now have a cleared status+  * unbalanced entries now cause a proper warning+  * balance report now passes all ledger compatibility tests+  * balance report now shows subtotals by default, like ledger 3+  * balance report shows the final zero total when -E is used+  * balance report hides the final total when ..no-total is used+  * ..depth affects print and register reports (aggregating with a reporting interval, filtering otherwise)+  * register report sorts transactions by date+  * register report shows zero-amount transactions when -E is used+  * provide more convenient timelog querying when invoked as "hours"+  * multi-day timelog sessions are split at midnight+  * unterminated timelog sessions are now counted. Accurate time reports at last!+  * the test command gives better ..verbose output+  * ..version gives more detailed version numbers including patchlevel for dev builds+  * new make targets include: ghci, haddocktest, doctest, unittest, view-api-docs+  * a doctest-style framework for functional/shell tests has been added++Release stats:++  * Contributors: Simon Michael, Tim Docker; thanks to the HAppS, happstack and testpack developers+  * Days since release: 76+  * Commits: 144+  * Lines of non-test code: 2367+  * Tests: 56+  * Known errors: 0++..+  * Performance:+                                   || hledger-0.3 | hledger-0.4 | ledger-0.3+     ==============================++=============+=============+===========+     -f sample.ledger balance      ||        0.02 |        0.01 |       0.07+     -f sample1000.ledger balance  ||        1.02 |        1.39 |       0.53+     -f sample10000.ledger balance ||       12.72 |       14.97 |       4.63+++2009/01/17 hledger 0.3+...............................++  * count timelog sessions on the day they end, like ledger, for now+  * when options are repeated, use the last instead of the first+  * builds with ghc 6.10 as well as 6.8+  * a simple ui for interactive report browsing: hledger ui+  * accept smart dates everywhere (YYYYMMDD, Y/M/D, Y, M/D, D, jan, today, last week etc.)+  * ..period/-p flag accepting period expressions like "in 2008", "weekly from last month"..+  * -W/-M/-Y convenience flags to summarise register weekly, monthly, yearly+  * ..depth and -E flags also affect summarised register reports (including depth=0)+  * ..display/-d flag supporting date predicates (like "d<[DATE]", "d>=[DATE]")+  * !include directive to include additional ledger files+  * !account directive to set a default parent account+  * Added support for reading historical prices from files+  * timelog and ledger entries can be intermixed in one file+  * modifier and periodic entries can appear anywhere (but are still ignored)+  * help and readme improvements+  * runs much faster than 0.2++Release stats:++  * Contributors: Simon Michael, Nick Ingolia, Tim Docker; thanks to Corey O'Connor & the vty team+  * Lines of non-test code: 2123+  * Tests: 58+  * Known errors: 1++..+  * Performance:+     $ bench hledger-0.2 hledger ledger+                                       || hledger-0.2 | hledger | ledger+     ==================================++=============+=========+=======+     -f 2008.ledger -s balance         ||        2.59 |    0.26 |   0.11+     -f 10000entries.ledger -s balance ||      566.68 |    2.72 |   0.96+++2008/11/23 hledger 0.2+...............................++  * fix balance report totals when filtering by account+  * fix balance report selection of accounts when filtering by account+  * fix a bug with account name eliding in balance report+  * if we happen to be showing a not-yet-auto-balanced entry, hide the AUTO marker+  * fix print command filtering by account+  * omit transactions with zero amount from register report+  * Fix bug in parsing of timelogs+  * rename ..showsubs to ..subtotal, like ledger+  * drop ..usage flag+  * don't require quickcheck+  * priced amounts (eg "10h @ $50") and ..basis/..cost/-B flag to show them with cost basis+  * easy ..depth option, equivalent to c++ ledger's -d 'l<=N'+  * smarter y/m/d date parsing for -b and -e+    (any number of digits, month and day default to 1, separator can be / - or .)+  * -n flag for balance command+  * ..empty/-E flag+  * build a library, as well as the exe+  * new home page url (http://joyful.com/hledger)+  * publish html and pdf versions of README+  * detect display preferences for each commodity like c++ ledger+  * support amounts with multiple currencies/commodities+  * support ..real/-R flag+  * support -C/..cleared flag to filter by entry status (not transaction status)+  * support virtual and balanced virtual transactions+  * parse comment lines beginning with a space, as from M-; in emacs ledger-mode+  * allow any non-whitespace in account names, perhaps avoiding misleading missing amounts errors+  * clearer error message when we can't balance an entry+  * when we fail because of more than one missing amount in an entry, show the full entry+  * document the built-in test runner in ..help+  * add a ..verbose/-v flag, use it to show more test-running detail++Release stats:++  * Contributors: Simon Michael, Tim Docker+  * Lines of non-test code: 1350+  * Tests: 43+  * Known errors: 0+++2008/10/15 hledger 0.1+...............................++Release stats:++  * Contributors: Simon Michael

@@ -1,277 +0,0 @@-{-# LANGUAGE CPP #-}-{-|-Command-line options for the application.--}--module Options -where-import System.Console.GetOpt-import System.Environment-import Ledger.IO (myLedgerPath,myTimelogPath)-import Ledger.Utils-import Ledger.Types-import Ledger.Dates-#if __GLASGOW_HASKELL__ <= 610-import Codec.Binary.UTF8.String (decodeString)-#endif-import Control.Monad (liftM)--progname      = "hledger"-timeprogname  = "hours"-#ifdef CHART-chartoutput   = "hledger.png"-chartitems    = 10-chartsize     = "600x400"-#endif--usagehdr =-  "Usage: hledger [OPTIONS] [COMMAND [PATTERNS]]\n" ++-  "       hledger [OPTIONS] convert CSVFILE\n" ++-  "       hledger [OPTIONS] stats\n" ++-  "\n" ++-  "hledger uses your ~/.ledger or $LEDGER file, or another specified with -f\n" ++-  "\n" ++-  "COMMAND is one of (may be abbreviated):\n" ++-  "  add       - prompt for new transactions and add them to the ledger\n" ++-  "  balance   - show accounts, with balances\n" ++-  "  convert   - read CSV bank data and display in ledger format\n" ++-  "  histogram - show a barchart of transactions per day or other interval\n" ++-  "  print     - show transactions in ledger format\n" ++-  "  register  - show transactions as a register with running balance\n" ++-  "  stats     - show various statistics for a ledger\n" ++-#ifdef VTY-  "  ui        - run a simple text-based UI\n" ++-#endif-#ifdef WEB-  "  web       - run a simple web-based UI\n" ++-#endif-#ifdef CHART-  "  chart     - generate balances pie chart\n" ++-#endif-  "  test      - run self-tests\n" ++-  "\n" ++-  "PATTERNS are regular expressions which filter by account name.\n" ++-  "Prefix with desc: to filter by transaction description instead.\n" ++-  "Prefix with not: to negate a pattern. When using both, not: comes last.\n" ++-  "\n" ++-  "DATES can be y/m/d or ledger-style smart dates like \"last month\".\n" ++-  "\n" ++-  "Options:"--usageftr = ""-usage = usageInfo usagehdr options ++ usageftr---- | Command-line options we accept.-options :: [OptDescr Opt]-options = [-  Option "f" ["file"]         (ReqArg File "FILE")   "use a different ledger/timelog file; - means stdin"- ,Option ""  ["no-new-accounts"] (NoArg NoNewAccts)   "don't allow to create new accounts"- ,Option "b" ["begin"]        (ReqArg Begin "DATE")  "report on transactions on or after this date"- ,Option "e" ["end"]          (ReqArg End "DATE")    "report on transactions before this date"- ,Option "p" ["period"]       (ReqArg Period "EXPR") ("report on transactions during the specified period\n" ++-                                                       "and/or with the specified reporting interval\n")- ,Option "C" ["cleared"]      (NoArg  Cleared)       "report only on cleared transactions"- ,Option "U" ["uncleared"]    (NoArg  UnCleared)     "report only on uncleared transactions"- ,Option "B" ["cost","basis"] (NoArg  CostBasis)     "report cost of commodities"- ,Option ""    ["depth"]        (ReqArg Depth "N")     "hide accounts/transactions deeper than this"- ,Option "d" ["display"]      (ReqArg Display "EXPR") ("show only transactions matching EXPR (where\n" ++-                                                        "EXPR is 'dOP[DATE]' and OP is <, <=, =, >=, >)")- ,Option ""    ["effective"]    (NoArg  Effective)     "use transactions' effective dates, if any"- ,Option "E" ["empty"]        (NoArg  Empty)         "show empty/zero things which are normally elided"- ,Option "R" ["real"]         (NoArg  Real)          "report only on real (non-virtual) transactions"- ,Option ""    ["no-total"]     (NoArg  NoTotal)       "balance report: hide the final total"--- ,Option "s" ["subtotal"]     (NoArg  SubTotal)      "balance report: show subaccounts"- ,Option "W" ["weekly"]       (NoArg  WeeklyOpt)     "register report: show weekly summary"- ,Option "M" ["monthly"]      (NoArg  MonthlyOpt)    "register report: show monthly summary"- ,Option "Q" ["quarterly"]    (NoArg  QuarterlyOpt)  "register report: show quarterly summary"- ,Option "Y" ["yearly"]       (NoArg  YearlyOpt)     "register report: show yearly summary"- ,Option "h" ["help"] (NoArg  Help)                  "show this help"- ,Option "V" ["version"]      (NoArg  Version)       "show version information"- ,Option "v" ["verbose"]      (NoArg  Verbose)       "show verbose test output"- ,Option ""    ["binary-filename"] (NoArg BinaryFilename) "show the download filename for this hledger build"- ,Option ""    ["debug"]        (NoArg  Debug)         "show extra debug output; implies verbose"- ,Option ""    ["debug-no-ui"]  (NoArg  DebugNoUI)     "run ui commands with no output"-#ifdef CHART- ,Option "o" ["output"]  (ReqArg ChartOutput "FILE")    ("chart: output filename (default: "++chartoutput++")")- ,Option ""  ["items"]  (ReqArg ChartItems "N")         ("chart: number of accounts to show (default: "++show chartitems++")")- ,Option ""  ["size"] (ReqArg ChartSize "WIDTHxHEIGHT") ("chart: image size (default: "++chartsize++")")-#endif- ]---- | An option value from a command-line flag.-data Opt = -    File    {value::String} | -    NoNewAccts |-    Begin   {value::String} | -    End     {value::String} | -    Period  {value::String} | -    Cleared | -    UnCleared | -    CostBasis | -    Depth   {value::String} | -    Display {value::String} | -    Effective | -    Empty | -    Real | -    NoTotal |-    SubTotal |-    WeeklyOpt |-    MonthlyOpt |-    QuarterlyOpt |-    YearlyOpt |-    Help |-    Verbose |-    Version-    | BinaryFilename-    | Debug-    | DebugNoUI-#ifdef CHART-    | ChartOutput {value::String}-    | ChartItems  {value::String}-    | ChartSize   {value::String}-#endif-    deriving (Show,Eq)---- these make me nervous-optsWithConstructor f opts = concatMap get opts-    where get o = [o | f v == o] where v = value o--optsWithConstructors fs opts = concatMap get opts-    where get o = [o | any (== o) fs]--optValuesForConstructor f opts = concatMap get opts-    where get o = [v | f v == o] where v = value o--optValuesForConstructors fs opts = concatMap get opts-    where get o = [v | any (\f -> f v == o) fs] where v = value o---- | Parse the command-line arguments into options, command name, and--- command arguments. Any dates in the options are converted to explicit--- YYYY/MM/DD format based on the current time.-parseArguments :: IO ([Opt], String, [String])-parseArguments = do-#if __GLASGOW_HASKELL__ <= 610-  args <- liftM (map decodeString) getArgs-#else-  args <- getArgs-#endif-  let (os,as,es) = getOpt Permute options args---  istimequery <- usingTimeProgramName---  let os' = if istimequery then (Period "today"):os else os-  os' <- fixOptDates os-  let os'' = if Debug `elem` os' then Verbose:os' else os'-  case (as,es) of-    (cmd:args,[])   -> return (os'',cmd,args)-    ([],[])         -> return (os'',"",[])-    (_,errs)        -> ioError (userError (concat errs ++ usage))---- | Convert any fuzzy dates within these option values to explicit ones,--- based on today's date.-fixOptDates :: [Opt] -> IO [Opt]-fixOptDates opts = do-  d <- getCurrentDay-  return $ map (fixopt d) opts-  where-    fixopt d (Begin s)   = Begin $ fixSmartDateStr d s-    fixopt d (End s)     = End $ fixSmartDateStr d s-    fixopt d (Display s) = -- hacky-        Display $ gsubRegexPRBy "\\[.+?\\]" fixbracketeddatestr s-        where fixbracketeddatestr s = "[" ++ fixSmartDateStr d (init $ tail s) ++ "]"-    fixopt _ o            = o---- | Figure out the overall date span we should report on, based on any--- begin/end/period options provided. If there is a period option, the--- others are ignored.-dateSpanFromOpts :: Day -> [Opt] -> DateSpan-dateSpanFromOpts refdate opts-    | not $ null popts = snd $ parsePeriodExpr refdate $ last popts-    | otherwise = DateSpan lastb laste-    where-      popts = optValuesForConstructor Period opts-      bopts = optValuesForConstructor Begin opts-      eopts = optValuesForConstructor End opts-      lastb = listtomaybeday bopts-      laste = listtomaybeday eopts-      listtomaybeday vs = if null vs then Nothing else Just $ parse $ last vs-          where parse = parsedate . fixSmartDateStr refdate---- | Figure out the reporting interval, if any, specified by the options.--- If there is a period option, the others are ignored.-intervalFromOpts :: [Opt] -> Interval-intervalFromOpts opts =-    case (periodopts, intervalopts) of-      ((p:_), _)            -> fst $ parsePeriodExpr d p where d = parsedate "0001/01/01" -- unused-      (_, (WeeklyOpt:_))    -> Weekly-      (_, (MonthlyOpt:_))   -> Monthly-      (_, (QuarterlyOpt:_)) -> Quarterly-      (_, (YearlyOpt:_))    -> Yearly-      (_, _)                -> NoInterval-    where-      periodopts   = reverse $ optValuesForConstructor Period opts-      intervalopts = reverse $ filter (`elem` [WeeklyOpt,MonthlyOpt,QuarterlyOpt,YearlyOpt]) opts---- | Get the value of the (last) depth option, if any, otherwise a large number.-depthFromOpts :: [Opt] -> Maybe Int-depthFromOpts opts = listtomaybeint $ optValuesForConstructor Depth opts-    where-      listtomaybeint [] = Nothing-      listtomaybeint vs = Just $ read $ last vs---- | Get the value of the (last) display option, if any.-displayExprFromOpts :: [Opt] -> Maybe String-displayExprFromOpts opts = listtomaybe $ optValuesForConstructor Display opts-    where-      listtomaybe [] = Nothing-      listtomaybe vs = Just $ last vs---- | Get a maybe boolean representing the last cleared/uncleared option if any.-clearedValueFromOpts opts | null os = Nothing-                          | last os == Cleared = Just True-                          | otherwise = Just False-    where os = optsWithConstructors [Cleared,UnCleared] opts---- | Was the program invoked via the \"hours\" alias ?-usingTimeProgramName :: IO Bool-usingTimeProgramName = do-  progname <- getProgName-  return $ map toLower progname == timeprogname---- | Get the ledger file path from options, an environment variable, or a default-ledgerFilePathFromOpts :: [Opt] -> IO String-ledgerFilePathFromOpts opts = do-  istimequery <- usingTimeProgramName-  f <- if istimequery then myTimelogPath else myLedgerPath-  return $ last $ f : optValuesForConstructor File opts---- | Gather filter pattern arguments into a list of account patterns and a--- list of description patterns. We interpret pattern arguments as--- follows: those prefixed with "desc:" are description patterns, all--- others are account patterns; also patterns prefixed with "not:" are--- negated. not: should come after desc: if both are used.-parsePatternArgs :: [String] -> ([String],[String])-parsePatternArgs args = (as, ds')-    where-      descprefix = "desc:"-      (ds, as) = partition (descprefix `isPrefixOf`) args-      ds' = map (drop (length descprefix)) ds---- | Convert application options to the library's generic filter specification.-optsToFilterSpec :: [Opt] -> [String] -> LocalTime -> FilterSpec-optsToFilterSpec opts args t = FilterSpec {-                                datespan=dateSpanFromOpts (localDay t) opts-                               ,cleared=clearedValueFromOpts opts-                               ,real=Real `elem` opts-                               ,empty=Empty `elem` opts-                               ,costbasis=CostBasis `elem` opts-                               ,acctpats=apats-                               ,descpats=dpats-                               ,whichdate = if Effective `elem` opts then EffectiveDate else ActualDate-                               ,depth = depthFromOpts opts-                               }-    where (apats,dpats) = parsePatternArgs args---- currentLocalTimeFromOpts opts = listtomaybe $ optValuesForConstructor CurrentLocalTime opts---     where---       listtomaybe [] = Nothing---       listtomaybe vs = Just $ last vs-

@@ -1,36 +0,0 @@-hledger-=======--hledger is a computer program for easily tracking money, time, or other-commodities, using standard accounting principles. It is quite limited in-features, but reliable.  For some, it is a bare-bones, less complex, less-expensive alternative to Quicken or Microsoft Money.--hledger aims to help both computer experts and every-day users gain clarity in their finances and time management.-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--Here is a demo_ of the web interface.--Here are ready-to-run binaries_ for mac, windows and gnu/linux.-They are not always the `latest release`_, sorry about that.--Here is the manual_.-For support and more technical info, see `hledger for techies`_ or `email me`_.--.. (If you're reading this in plain text, see also README2, MANUAL etc., or http://hledger.org)--.. _hledger for techies:  README2.html-.. _manual:               MANUAL.html-.. _demo:                 http://demo.hledger.org-.. _binaries:             http://hledger.org/binaries/-.. _hledger for mac:      http://hledger.org/binaries/hledger-0.6-mac-i386.gz-.. _hledger for windows:  http://hledger.org/binaries/hledger-0.6-win-i386.zip-.. _32 bit intel:         http://hledger.org/binaries/hledger-0.6.1+9-linux-i386.gz-.. _64 bit intel:         http://hledger.org/binaries/hledger-0.6-linux-x86_64.gz-.. _email me:             mailto:simon@joyful.com-.. _latest release:       http://hledger.org/MANUAL.html#installing

@@ -0,0 +1,39 @@+---+title: hledger+---+hledger+=======++hledger is a computer program for easily tracking money, time, or other+commodities, using standard accounting principles. It is quite limited in+features, but reliable.  For some, it is a bare-bones, less complex, less+expensive alternative to Quicken or Microsoft Money.++hledger aims to help both computer experts and every-day users gain clarity in their finances and time management.+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++Here is a demo_ of the web interface.++Here are ready-to-run binaries_ for mac, windows and gnu/linux.+They are not always the `latest release`_, sorry about that.++Here is the manual_.+For support and more technical info, see `hledger for techies`_ or `email me`_.++.. (If you're reading this in plain text, see also README2, MANUAL etc., or http://hledger.org)++.. _hledger for techies:  README2.html+.. _manual:               MANUAL.html+.. _demo:                 http://demo.hledger.org+.. _binaries:             http://hledger.org/binaries/+.. _hledger for mac:      http://hledger.org/binaries/hledger-0.6-mac-i386.gz+.. _hledger for windows:  http://hledger.org/binaries/hledger-0.6-win-i386.zip+.. _32 bit intel:         http://hledger.org/binaries/hledger-0.6.1+9-linux-i386.gz+.. _64 bit intel:         http://hledger.org/binaries/hledger-0.6-linux-x86_64.gz+.. _email me:             mailto:simon@joyful.com+.. _latest release:       http://hledger.org/MANUAL.html#installing

@@ -0,0 +1,99 @@+---+title: hledger for techies+---+hledger for techies+===================++hledger_ is a remix, in haskell_, of John Wiegley's excellent ledger_ accounting tool.+It reads a plain text `ledger file`_ or timelog_ describing your transactions+and displays reports via `command line`_, curses_ or `web interface`_ (click for a demo).++The hledger project aims to produce:++- a practical, accessible, dependable tool for end users+- a useful library and toolbox for finance-minded haskell programmers+- a successful, time-and-money-solvent project within a thriving ecosystem of financial software projects.++hledger is free software by `Simon Michael`_ & `co.`_, released under GNU GPLv3.++**Learn**+ news_, manual_, screenshots_, `some extra tips`_++**Download**+ ``cabal install hledger``, + or try these ready-to-run binaries_,+ or see the `installing docs <MANUAL.html#installing>`_++**Develop**+ ``darcs get http://joyful.com/repos/hledger``, + `browse the repo`_, + `hackage page`_, + `hledger-lib api docs`_, + `hledger api docs`_, + `hledger-lib sourcegraph report`_, + `hledger sourcegraph report`_, + benchmark_\/profile_\/heap_\/coverage_ reports,+ `developer notes`_++.. raw:: html++ <a name="support" />++**Support**++- chat Simon (sm) on the `#ledger`_ irc channel which we share, or `email me`_+- report problems at `bugs.hledger.org <http://bugs.hledger.org>`_+- share and test ledger snippets at paste . hledger.org+- .. raw:: html++     <form action="http://groups.google.com/group/hledger/boxsubscribe" >+       join the hledger mail list at <a href="http://list.hledger.org">list.hledger.org</a>. Your email:+       <input type=text name=email><input type=submit name="sub" value="Subscribe">+     </form>++**Related projects**++- John Wiegley's ledger_ inspired hledger, and we try to stay compatible. You can often use both tools on the same ledger file.+- Uwe Hollerbach's umm_ is another haskell tool inspired by h/ledger.+- Tim Docker's ledger-reports_ uses hledger as a library to generate `html reports`_. +- I have a few older bits and pieces `here <http://joyful.com/Ledger>`_.++.. raw:: html++ <a href="http://joyful.com/darcsweb/darcsweb.cgi?r=hledger;a=shortlog"><img src=http://joyful.com/repos/hledger/commits.png border=0></a>+ <a href="https://www.google.com/analytics/reporting/?reset=1&id=15489822" accesskey="a"></a>+++.. _hledger:              README.html+.. _`ledger file`:        http://joyful.com/repos/hledger/sample.ledger+.. _timelog:              http://joyful.com/repos/hledger/sample.timelog+.. _command line:         SCREENSHOTS.html#hledger-screen-1+.. _curses:               SCREENSHOTS.html#sshot+.. _web interface:        http://demo.hledger.org+.. _mail list:            http://list.hledger.org+.. _issue tracker:        http://bugs.hledger.org+.. _binaries:             http://hledger.org/binaries/+.. _manual:               MANUAL.html+.. _news:                 NEWS.html+.. _screenshots:          SCREENSHOTS.html+.. _hledger-lib api docs: http://joyful.com/repos/hledger/hledger-lib/dist/doc/html/hledger-lib/index.html+.. _hledger api docs:     http://joyful.com/repos/hledger/dist/doc/html/hledger/index.html+.. _hledger-lib sourcegraph report: http://joyful.com/repos/hledger/hledger-lib/SourceGraph/hledger-lib.html+.. _hledger sourcegraph report: http://joyful.com/repos/hledger/SourceGraph/hledger.html+.. _developer notes:      http://joyful.com/darcsweb/darcsweb.cgi?r=hledger;a=plainblob;f=/NOTES+.. _benchmark:            http://hledger.org/profs/latest.bench+.. _profile:              http://hledger.org/profs/latest.prof+.. _heap:                 http://hledger.org/profs/latest.ps+.. _coverage:             http://hledger.org/profs/coverage/hpc_index_fun.html+.. _browse the repo:      http://joyful.com/darcsweb/darcsweb.cgi?r=hledger+.. _email me:             mailto:simon@joyful.com+.. _Simon Michael:        http://joyful.com+.. _co.:                  http://hledger.org/CONTRIBUTORS.html+.. _hackage page:         http://hackage.haskell.org/package/hledger+.. _#ledger:              irc://irc.freenode.net/#ledger+.. _haskell:              http://haskell.org+.. _ledger:               http://wiki.github.com/jwiegley/ledger+.. _umm:                  http://www.korgwal.com/umm/+.. _ledger-reports:       http://dockerz.net/repos/ledger-reports+.. _html reports:         http://dockerz.net/software/hledger_report_sample/report.html+.. _some extra tips:      http://podcastle.org/2009/10/09/pc-miniature-38-accounting-for-dragons/

@@ -1,1114 +0,0 @@-{- |--This module contains hledger's unit tests. These are built in to hledger,-and can be run at any time by doing @hledger test@ (or, with a few more-options, by doing @make unittest@ in the hledger source tree.)--Other kinds of tests:--hledger's functional tests are a set of shell/command-line tests defined-by .test files in the tests\/ subdirectory. These can be run by doing-@make functest@ in the hledger source tree.--hledger's doctests are shell tests defined in literal blocks in haddock-documentation in the source, run by doing @make doctest@ in the hledger-source tree. They are no longer used, but here is an example:--@-$ hledger -f sample.ledger balance o-                  $1  expenses:food-                 $-2  income-                 $-1    gifts-                 $-1    salary----------------------                 $-1-@---}--module Tests-where-import qualified Data.Map as Map-import Data.Time.Format-import System.Locale (defaultTimeLocale)-import Test.HUnit.Tools (runVerboseTests)-import System.Exit (exitFailure, exitWith, ExitCode(ExitSuccess)) -- base 3 compatible-import System.Time (ClockTime(TOD))--import Commands.All-import Ledger  -- including testing utils in Ledger.Utils-import Options-import Utils----- | Run unit tests.-runtests :: [Opt] -> [String] -> IO ()-runtests opts args = do-  (counts,_) <- runner ts-  if errors counts > 0 || (failures counts > 0)-   then exitFailure-   else exitWith ExitSuccess-    where-      runner | Verbose `elem` opts = runVerboseTests-             | otherwise = liftM (flip (,) 0) . runTestTT-      ts = TestList $ filter matchname $ tflatten tests  -- show flat test names-      -- ts = tfilter matchname $ TestList tests -- show hierarchical test names-      matchname = matchpats args . tname---- | unit tests, augmenting the ones defined in each module. Where that is--- inconvenient due to import cycles or whatever, we define them here.-tests :: Test-tests = TestList [-   tests_Ledger,-   tests_Commands,--   "account directive" ~:-   let sameParse str1 str2 = do l1 <- journalFromString str1-                                l2 <- journalFromString str2-                                l1 `is` l2-   in TestList-   [-    "account directive 1" ~: sameParse -                          "2008/12/07 One\n  test:from  $-1\n  test:to  $1\n"-                          "!account test\n2008/12/07 One\n  from  $-1\n  to  $1\n"--   ,"account directive 2" ~: sameParse -                           "2008/12/07 One\n  test:foo:from  $-1\n  test:foo:to  $1\n"-                           "!account test\n!account foo\n2008/12/07 One\n  from  $-1\n  to  $1\n"--   ,"account directive 3" ~: sameParse -                           "2008/12/07 One\n  test:from  $-1\n  test:to  $1\n"-                           "!account test\n!account foo\n!end\n2008/12/07 One\n  from  $-1\n  to  $1\n"--   ,"account directive 4" ~: sameParse -                           ("2008/12/07 One\n  alpha  $-1\n  beta  $1\n" ++-                            "!account outer\n2008/12/07 Two\n  aigh  $-2\n  bee  $2\n" ++-                            "!account inner\n2008/12/07 Three\n  gamma  $-3\n  delta  $3\n" ++-                            "!end\n2008/12/07 Four\n  why  $-4\n  zed  $4\n" ++-                            "!end\n2008/12/07 Five\n  foo  $-5\n  bar  $5\n"-                           )-                           ("2008/12/07 One\n  alpha  $-1\n  beta  $1\n" ++-                            "2008/12/07 Two\n  outer:aigh  $-2\n  outer:bee  $2\n" ++-                            "2008/12/07 Three\n  outer:inner:gamma  $-3\n  outer:inner:delta  $3\n" ++-                            "2008/12/07 Four\n  outer:why  $-4\n  outer:zed  $4\n" ++-                            "2008/12/07 Five\n  foo  $-5\n  bar  $5\n"-                           )-   ]--  ,"accountnames" ~:-    accountnames ledger7 `is`-     ["assets","assets:cash","assets:checking","assets:saving","equity","equity:opening balances",-      "expenses","expenses:food","expenses:food:dining","expenses:phone","expenses:vacation",-      "liabilities","liabilities:credit cards","liabilities:credit cards:discover"]--  ,"accountNameTreeFrom" ~: do-    accountNameTreeFrom ["a"]       `is` Node "top" [Node "a" []]-    accountNameTreeFrom ["a","b"]   `is` Node "top" [Node "a" [], Node "b" []]-    accountNameTreeFrom ["a","a:b"] `is` Node "top" [Node "a" [Node "a:b" []]]-    accountNameTreeFrom ["a:b:c"]   `is` Node "top" [Node "a" [Node "a:b" [Node "a:b:c" []]]]--  ,"balance report tests" ~:-   let (opts,args) `gives` es = do -        l <- sampleledgerwithopts opts args-        t <- getCurrentLocalTime-        showBalanceReport opts (optsToFilterSpec opts args t) l `is` unlines es-   in TestList-   [--    "balance report with no args" ~:-    ([], []) `gives`-    ["                 $-1  assets"-    ,"                  $1    bank:saving"-    ,"                 $-2    cash"-    ,"                  $2  expenses"-    ,"                  $1    food"-    ,"                  $1    supplies"-    ,"                 $-2  income"-    ,"                 $-1    gifts"-    ,"                 $-1    salary"-    ,"                  $1  liabilities:debts"-    ]--   ,"balance report can be limited with --depth" ~:-    ([Depth "1"], []) `gives`-    ["                 $-1  assets"-    ,"                  $2  expenses"-    ,"                 $-2  income"-    ,"                  $1  liabilities"-    ]-    -   ,"balance report with account pattern o" ~:-    ([SubTotal], ["o"]) `gives`-    ["                  $1  expenses:food"-    ,"                 $-2  income"-    ,"                 $-1    gifts"-    ,"                 $-1    salary"-    ,"--------------------"-    ,"                 $-1"-    ]--   ,"balance report with account pattern o and --depth 1" ~:-    ([Depth "1"], ["o"]) `gives`-    ["                  $1  expenses"-    ,"                 $-2  income"-    ,"--------------------"-    ,"                 $-1"-    ]--   ,"balance report with account pattern a" ~:-    ([], ["a"]) `gives`-    ["                 $-1  assets"-    ,"                  $1    bank:saving"-    ,"                 $-2    cash"-    ,"                 $-1  income:salary"-    ,"                  $1  liabilities:debts"-    ,"--------------------"-    ,"                 $-1"-    ]--   ,"balance report with account pattern e" ~:-    ([], ["e"]) `gives`-    ["                 $-1  assets"-    ,"                  $1    bank:saving"-    ,"                 $-2    cash"-    ,"                  $2  expenses"-    ,"                  $1    food"-    ,"                  $1    supplies"-    ,"                 $-2  income"-    ,"                 $-1    gifts"-    ,"                 $-1    salary"-    ,"                  $1  liabilities:debts"-    ]--   ,"balance report with unmatched parent of two matched subaccounts" ~: -    ([], ["cash","saving"]) `gives`-    ["                 $-1  assets"-    ,"                  $1    bank:saving"-    ,"                 $-2    cash"-    ,"--------------------"-    ,"                 $-1"-    ]--   ,"balance report with multi-part account name" ~: -    ([], ["expenses:food"]) `gives`-    ["                  $1  expenses:food"-    ,"--------------------"-    ,"                  $1"-    ]--   ,"balance report with negative account pattern" ~:-    ([], ["not:assets"]) `gives`-    ["                  $2  expenses"-    ,"                  $1    food"-    ,"                  $1    supplies"-    ,"                 $-2  income"-    ,"                 $-1    gifts"-    ,"                 $-1    salary"-    ,"                  $1  liabilities:debts"-    ,"--------------------"-    ,"                  $1"-    ]--   ,"balance report negative account pattern always matches full name" ~: -    ([], ["not:e"]) `gives` []--   ,"balance report negative patterns affect totals" ~: -    ([], ["expenses","not:food"]) `gives`-    ["                  $1  expenses:supplies"-    ,"--------------------"-    ,"                  $1"-    ]--   ,"balance report with -E shows zero-balance accounts" ~:-    ([SubTotal,Empty], ["assets"]) `gives`-    ["                 $-1  assets"-    ,"                  $1    bank"-    ,"                  $0      checking"-    ,"                  $1      saving"-    ,"                 $-2    cash"-    ,"--------------------"-    ,"                 $-1"-    ]--   ,"balance report with cost basis" ~: do-      j <- journalFromString $ unlines-             [""-             ,"2008/1/1 test           "-             ,"  a:b          10h @ $50"-             ,"  c:d                   "-             ,""-             ]-      let j' = canonicaliseAmounts True j -- enable cost basis adjustment-      showBalanceReport [] nullfilterspec nullledger{journal=j'} `is`-       unlines-        ["                $500  a:b"-        ,"               $-500  c:d"-        ]--   ,"balance report elides zero-balance root account(s)" ~: do-      l <- ledgerFromStringWithOpts []-             (unlines-              ["2008/1/1 one"-              ,"  test:a  1"-              ,"  test:b"-              ])-      showBalanceReport [] nullfilterspec l `is`-       unlines-        ["                   1  test:a"-        ,"                  -1  test:b"-        ]--   ]--  ,"balanceTransaction" ~: do-     assertBool "detect unbalanced entry, sign error"-                    (isLeft $ balanceTransaction-                           (Transaction (parsedate "2007/01/28") Nothing False "" "test" ""-                            [Posting False "a" (Mixed [dollars 1]) "" RegularPosting Nothing, -                             Posting False "b" (Mixed [dollars 1]) "" RegularPosting Nothing-                            ] ""))-     assertBool "detect unbalanced entry, multiple missing amounts"-                    (isLeft $ balanceTransaction-                           (Transaction (parsedate "2007/01/28") Nothing False "" "test" ""-                            [Posting False "a" missingamt "" RegularPosting Nothing, -                             Posting False "b" missingamt "" RegularPosting Nothing-                            ] ""))-     let e = balanceTransaction (Transaction (parsedate "2007/01/28") Nothing False "" "test" ""-                           [Posting False "a" (Mixed [dollars 1]) "" RegularPosting Nothing, -                            Posting False "b" missingamt "" RegularPosting Nothing-                           ] "")-     assertBool "one missing amount should be ok" (isRight e)-     assertEqual "balancing amount is added" -                     (Mixed [dollars (-1)])-                     (case e of-                        Right e' -> (pamount $ last $ tpostings e')-                        Left _ -> error "should not happen")--  ,"cacheLedger" ~:-    length (Map.keys $ accountmap $ cacheLedger journal7) `is` 15--  ,"canonicaliseAmounts" ~:-   "use the greatest precision" ~:-    journalPrecisions (canonicaliseAmounts False $ journalWithAmounts ["1","2.00"]) `is` [2,2]--  ,"commodities" ~:-    commodities ledger7 `is` [Commodity {symbol="$", side=L, spaced=False, comma=False, precision=2}]--  ,"dateSpanFromOpts" ~: do-    let todaysdate = parsedate "2008/11/26"-    let gives = is . show . dateSpanFromOpts todaysdate-    [] `gives` "DateSpan Nothing Nothing"-    [Begin "2008", End "2009"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"-    [Period "in 2008"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"-    [Begin "2005", End "2007",Period "in 2008"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"--  -- don't know what this should do-  -- ,"elideAccountName" ~: do-  --    (elideAccountName 50 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa"-  --     `is` "aa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa")-  --    (elideAccountName 20 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa"-  --     `is` "aa:aa:aaaaaaaaaaaaaa")--  ,"entriesFromTimeLogEntries" ~: do-     today <- getCurrentDay-     now' <- getCurrentTime-     tz <- getCurrentTimeZone-     let now = utcToLocalTime tz now'-         nowstr = showtime now-         yesterday = prevday today-         clockin = TimeLogEntry In-         mktime d = LocalTime d . fromMaybe midnight . parseTime defaultTimeLocale "%H:%M:%S"-         showtime = formatTime defaultTimeLocale "%H:%M"-         assertEntriesGiveStrings name es ss = assertEqual name ss (map tdescription $ entriesFromTimeLogEntries now es)--     assertEntriesGiveStrings "started yesterday, split session at midnight"-                                  [clockin (mktime yesterday "23:00:00") ""]-                                  ["23:00-23:59","00:00-"++nowstr]-     assertEntriesGiveStrings "split multi-day sessions at each midnight"-                                  [clockin (mktime (addDays (-2) today) "23:00:00") ""]-                                  ["23:00-23:59","00:00-23:59","00:00-"++nowstr]-     assertEntriesGiveStrings "auto-clock-out if needed" -                                  [clockin (mktime today "00:00:00") ""] -                                  ["00:00-"++nowstr]-     let future = utcToLocalTime tz $ addUTCTime 100 now'-         futurestr = showtime future-     assertEntriesGiveStrings "use the clockin time for auto-clockout if it's in the future"-                                  [clockin future ""]-                                  [printf "%s-%s" futurestr futurestr]--  ,"expandAccountNames" ~:-    expandAccountNames ["assets:cash","assets:checking","expenses:vacation"] `is`-     ["assets","assets:cash","assets:checking","expenses","expenses:vacation"]--  ,"intervalFromOpts" ~: do-    let gives = is . intervalFromOpts-    [] `gives` NoInterval-    [WeeklyOpt] `gives` Weekly-    [MonthlyOpt] `gives` Monthly-    [QuarterlyOpt] `gives` Quarterly-    [YearlyOpt] `gives` Yearly-    [Period "weekly"] `gives` Weekly-    [Period "monthly"] `gives` Monthly-    [Period "quarterly"] `gives` Quarterly-    [WeeklyOpt, Period "yearly"] `gives` Yearly--  ,"isAccountNamePrefixOf" ~: do-    "assets" `isAccountNamePrefixOf` "assets" `is` False-    "assets" `isAccountNamePrefixOf` "assets:bank" `is` True-    "assets" `isAccountNamePrefixOf` "assets:bank:checking" `is` True-    "my assets" `isAccountNamePrefixOf` "assets:bank" `is` False--  ,"isTransactionBalanced" ~: do-     let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""-             [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting (Just t)-             ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting (Just t)-             ] ""-     assertBool "detect balanced" (isTransactionBalanced t)-     let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""-             [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting (Just t)-             ,Posting False "c" (Mixed [dollars (-1.01)]) "" RegularPosting (Just t)-             ] ""-     assertBool "detect unbalanced" (not $ isTransactionBalanced t)-     let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""-             [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting (Just t)-             ] ""-     assertBool "detect unbalanced, one posting" (not $ isTransactionBalanced t)-     let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""-             [Posting False "b" (Mixed [dollars 0]) "" RegularPosting (Just t)-             ] ""-     assertBool "one zero posting is considered balanced for now" (isTransactionBalanced t)-     let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""-             [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting (Just t)-             ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting (Just t)-             ,Posting False "d" (Mixed [dollars 100]) "" VirtualPosting (Just t)-             ] ""-     assertBool "virtual postings don't need to balance" (isTransactionBalanced t)-     let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""-             [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting (Just t)-             ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting (Just t)-             ,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting (Just t)-             ] ""-     assertBool "balanced virtual postings need to balance among themselves" (not $ isTransactionBalanced t)-     let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""-             [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting (Just t)-             ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting (Just t)-             ,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting (Just t)-             ,Posting False "e" (Mixed [dollars (-100)]) "" BalancedVirtualPosting (Just t)-             ] ""-     assertBool "balanced virtual postings need to balance among themselves (2)" (isTransactionBalanced t)--  ,"isSubAccountNameOf" ~: do-    "assets" `isSubAccountNameOf` "assets" `is` False-    "assets:bank" `isSubAccountNameOf` "assets" `is` True-    "assets:bank:checking" `isSubAccountNameOf` "assets" `is` False-    "assets:bank" `isSubAccountNameOf` "my assets" `is` False--  ,"default year" ~: do-    rl <- journalFromString defaultyear_ledger_str-    tdate (head $ jtxns rl) `is` fromGregorian 2009 1 1-    return ()--  ,"ledgerFile" ~: do-    assertBool "ledgerFile should parse an empty file" (isRight $ parseWithCtx emptyCtx ledgerFile "")-    r <- journalFromString "" -- don't know how to get it from ledgerFile-    assertBool "ledgerFile parsing an empty file should give an empty ledger" $ null $ jtxns r--  ,"normaliseMixedAmount" ~: do-     normaliseMixedAmount (Mixed []) ~?= Mixed [nullamt]--  ,"parsedate" ~: do-    parsedate "2008/02/03" `is` parsetimewith "%Y/%m/%d" "2008/02/03" date1-    parsedate "2008-02-03" `is` parsetimewith "%Y/%m/%d" "2008/02/03" date1--  ,"period expressions" ~: do-    let todaysdate = parsedate "2008/11/26"-    let str `gives` result = show (parsewith (periodexpr todaysdate) str) `is` ("Right " ++ result)-    "from aug to oct"           `gives` "(NoInterval,DateSpan (Just 2008-08-01) (Just 2008-10-01))"-    "aug to oct"                `gives` "(NoInterval,DateSpan (Just 2008-08-01) (Just 2008-10-01))"-    "every day from aug to oct" `gives` "(Daily,DateSpan (Just 2008-08-01) (Just 2008-10-01))"-    "daily from aug"            `gives` "(Daily,DateSpan (Just 2008-08-01) Nothing)"-    "every week to 2009"        `gives` "(Weekly,DateSpan Nothing (Just 2009-01-01))"--  ,"print report tests" ~: TestList-  [--   "print expenses" ~:-   do -    let args = ["expenses"]-    l <- sampleledgerwithopts [] args-    t <- getCurrentLocalTime-    showTransactions (optsToFilterSpec [] args t) l `is` unlines-     ["2008/06/03 * eat & shop"-     ,"    expenses:food                $1"-     ,"    expenses:supplies            $1"-     ,"    assets:cash                 $-2"-     ,""-     ]--  , "print report with depth arg" ~:-   do -    l <- sampleledger-    t <- getCurrentLocalTime-    showTransactions (optsToFilterSpec [Depth "2"] [] t) l `is` unlines-      ["2008/01/01 income"-      ,"    income:salary           $-1"-      ,""-      ,"2008/06/01 gift"-      ,"    income:gifts           $-1"-      ,""-      ,"2008/06/03 * eat & shop"-      ,"    expenses:food                $1"-      ,"    expenses:supplies            $1"-      ,"    assets:cash                 $-2"-      ,""-      ,"2008/12/31 * pay off"-      ,"    liabilities:debts            $1"-      ,""-      ]--  ]--  ,"punctuatethousands 1" ~: punctuatethousands "" `is` ""--  ,"punctuatethousands 2" ~: punctuatethousands "1234567.8901" `is` "1,234,567.8901"--  ,"punctuatethousands 3" ~: punctuatethousands "-100" `is` "-100"--  ,"register report tests" ~:-  let registerdates = filter (not . null) .  map (strip . take 10) . lines-  in-  TestList-  [--   "register report with no args" ~:-   do -    l <- sampleledger-    showRegisterReport [] (optsToFilterSpec [] [] t1) l `is` unlines-     ["2008/01/01 income               assets:bank:checking             $1           $1"-     ,"                                income:salary                   $-1            0"-     ,"2008/06/01 gift                 assets:bank:checking             $1           $1"-     ,"                                income:gifts                    $-1            0"-     ,"2008/06/02 save                 assets:bank:saving               $1           $1"-     ,"                                assets:bank:checking            $-1            0"-     ,"2008/06/03 eat & shop           expenses:food                    $1           $1"-     ,"                                expenses:supplies                $1           $2"-     ,"                                assets:cash                     $-2            0"-     ,"2008/12/31 pay off              liabilities:debts                $1           $1"-     ,"                                assets:bank:checking            $-1            0"-     ]--  ,"register report with cleared option" ~:-   do -    let opts = [Cleared]-    l <- ledgerFromStringWithOpts opts sample_ledger_str-    showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines-     ["2008/06/03 eat & shop           expenses:food                    $1           $1"-     ,"                                expenses:supplies                $1           $2"-     ,"                                assets:cash                     $-2            0"-     ,"2008/12/31 pay off              liabilities:debts                $1           $1"-     ,"                                assets:bank:checking            $-1            0"-     ]--  ,"register report with uncleared option" ~:-   do -    let opts = [UnCleared]-    l <- ledgerFromStringWithOpts opts sample_ledger_str-    showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines-     ["2008/01/01 income               assets:bank:checking             $1           $1"-     ,"                                income:salary                   $-1            0"-     ,"2008/06/01 gift                 assets:bank:checking             $1           $1"-     ,"                                income:gifts                    $-1            0"-     ,"2008/06/02 save                 assets:bank:saving               $1           $1"-     ,"                                assets:bank:checking            $-1            0"-     ]--  ,"register report sorts by date" ~:-   do -    l <- ledgerFromStringWithOpts [] $ unlines-        ["2008/02/02 a"-        ,"  b  1"-        ,"  c"-        ,""-        ,"2008/01/01 d"-        ,"  e  1"-        ,"  f"-        ]-    registerdates (showRegisterReport [] (optsToFilterSpec [] [] t1) l) `is` ["2008/01/01","2008/02/02"]--  ,"register report with account pattern" ~:-   do-    l <- sampleledger-    showRegisterReport [] (optsToFilterSpec [] ["cash"] t1) l `is` unlines-     ["2008/06/03 eat & shop           assets:cash                     $-2          $-2"-     ]--  ,"register report with account pattern, case insensitive" ~:-   do -    l <- sampleledger-    showRegisterReport [] (optsToFilterSpec [] ["cAsH"] t1) l `is` unlines-     ["2008/06/03 eat & shop           assets:cash                     $-2          $-2"-     ]--  ,"register report with display expression" ~:-   do -    l <- sampleledger-    let gives displayexpr = -            (registerdates (showRegisterReport opts (optsToFilterSpec opts [] t1) l) `is`)-                where opts = [Display displayexpr]-    "d<[2008/6/2]"  `gives` ["2008/01/01","2008/06/01"]-    "d<=[2008/6/2]" `gives` ["2008/01/01","2008/06/01","2008/06/02"]-    "d=[2008/6/2]"  `gives` ["2008/06/02"]-    "d>=[2008/6/2]" `gives` ["2008/06/02","2008/06/03","2008/12/31"]-    "d>[2008/6/2]"  `gives` ["2008/06/03","2008/12/31"]--  ,"register report with period expression" ~:-   do -    l <- sampleledger    -    let periodexpr `gives` dates = do-          l' <- sampleledgerwithopts opts []-          registerdates (showRegisterReport opts (optsToFilterSpec opts [] t1) l') `is` dates-              where opts = [Period periodexpr]-    ""     `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]-    "2008" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]-    "2007" `gives` []-    "june" `gives` ["2008/06/01","2008/06/02","2008/06/03"]-    "monthly" `gives` ["2008/01/01","2008/06/01","2008/12/01"]-    "quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"]-    let opts = [Period "yearly"]-    showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines-     ["2008/01/01 - 2008/12/31         assets:bank:saving               $1           $1"-     ,"                                assets:cash                     $-2          $-1"-     ,"                                expenses:food                    $1            0"-     ,"                                expenses:supplies                $1           $1"-     ,"                                income:gifts                    $-1            0"-     ,"                                income:salary                   $-1          $-1"-     ,"                                liabilities:debts                $1            0"-     ]-    let opts = [Period "quarterly"]-    registerdates (showRegisterReport opts (optsToFilterSpec opts [] t1) l) `is` ["2008/01/01","2008/04/01","2008/10/01"]-    let opts = [Period "quarterly",Empty]-    registerdates (showRegisterReport opts (optsToFilterSpec opts [] t1) l) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"]--  ]--  , "register report with depth arg" ~:-   do -    l <- sampleledger-    let opts = [Depth "2"]-    showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines-     ["2008/01/01 income               income:salary                   $-1          $-1"-     ,"2008/06/01 gift                 income:gifts                    $-1          $-2"-     ,"2008/06/03 eat & shop           expenses:food                    $1          $-1"-     ,"                                expenses:supplies                $1            0"-     ,"                                assets:cash                     $-2          $-2"-     ,"2008/12/31 pay off              liabilities:debts                $1          $-1"-     ]--  ,"show dollars" ~: show (dollars 1) ~?= "$1.00"--  ,"show hours" ~: show (hours 1) ~?= "1.0h"--  ,"unicode in balance layout" ~: do-    l <- ledgerFromStringWithOpts []-      "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"-    showBalanceReport [] (optsToFilterSpec [] [] t1) l `is` unlines-      ["                -100  актив:наличные"-      ,"                 100  расходы:покупки"]--  ,"unicode in register layout" ~: do-    l <- ledgerFromStringWithOpts []-      "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"-    showRegisterReport [] (optsToFilterSpec [] [] t1) l `is` unlines-      ["2009/01/01 медвежья шкура       расходы:покупки                 100          100"-      ,"                                актив:наличные                 -100            0"]--  ,"smart dates" ~: do-    let gives = is . fixSmartDateStr (parsedate "2008/11/26")-    "1999-12-02"   `gives` "1999/12/02"-    "1999.12.02"   `gives` "1999/12/02"-    "1999/3/2"     `gives` "1999/03/02"-    "19990302"     `gives` "1999/03/02"-    "2008/2"       `gives` "2008/02/01"-    "20/2"         `gives` "0020/02/01"-    "1000"         `gives` "1000/01/01"-    "4/2"          `gives` "2008/04/02"-    "2"            `gives` "2008/11/02"-    "January"      `gives` "2008/01/01"-    "feb"          `gives` "2008/02/01"-    "today"        `gives` "2008/11/26"-    "yesterday"    `gives` "2008/11/25"-    "tomorrow"     `gives` "2008/11/27"-    "this day"     `gives` "2008/11/26"-    "last day"     `gives` "2008/11/25"-    "next day"     `gives` "2008/11/27"-    "this week"    `gives` "2008/11/24" -- last monday-    "last week"    `gives` "2008/11/17" -- previous monday-    "next week"    `gives` "2008/12/01" -- next monday-    "this month"   `gives` "2008/11/01"-    "last month"   `gives` "2008/10/01"-    "next month"   `gives` "2008/12/01"-    "this quarter" `gives` "2008/10/01"-    "last quarter" `gives` "2008/07/01"-    "next quarter" `gives` "2009/01/01"-    "this year"    `gives` "2008/01/01"-    "last year"    `gives` "2007/01/01"-    "next year"    `gives` "2009/01/01"---     "last wed"     `gives` "2008/11/19"---     "next friday"  `gives` "2008/11/28"---     "next january" `gives` "2009/01/01"--  ,"subAccounts" ~: do-    l <- liftM cacheLedger' sampleledger-    let a = ledgerAccount l "assets"-    map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"]--  -- ,"summarisePostingsInDateSpan" ~: do-  --   let gives (b,e,depth,showempty,ps) =-  --           (summarisePostingsInDateSpan (mkdatespan b e) depth showempty ps `is`)-  --   let ps =-  --           [-  --            nullposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=Mixed [dollars 1]}-  --           ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining",   lpamount=Mixed [dollars 2]}-  --           ,nullposting{lpdescription="desc",lpaccount="expenses:food",          lpamount=Mixed [dollars 4]}-  --           ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining",   lpamount=Mixed [dollars 8]}-  --           ]-  --   ("2008/01/01","2009/01/01",0,9999,False,[]) `gives` -  --    []-  --   ("2008/01/01","2009/01/01",0,9999,True,[]) `gives` -  --    [-  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31"}-  --    ]-  --   ("2008/01/01","2009/01/01",0,9999,False,ts) `gives` -  --    [-  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food",          lpamount=Mixed [dollars 4]}-  --    ,nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:dining",   lpamount=Mixed [dollars 10]}-  --    ,nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:groceries",lpamount=Mixed [dollars 1]}-  --    ]-  --   ("2008/01/01","2009/01/01",0,2,False,ts) `gives` -  --    [-  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food",lpamount=Mixed [dollars 15]}-  --    ]-  --   ("2008/01/01","2009/01/01",0,1,False,ts) `gives` -  --    [-  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses",lpamount=Mixed [dollars 15]}-  --    ]-  --   ("2008/01/01","2009/01/01",0,0,False,ts) `gives` -  --    [-  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="",lpamount=Mixed [dollars 15]}-  --    ]--  ]--  --- fixtures/test data--date1 = parsedate "2008/11/26"-t1 = LocalTime date1 midday--sampleledger = ledgerFromStringWithOpts [] sample_ledger_str-sampleledgerwithopts opts _ = ledgerFromStringWithOpts opts sample_ledger_str--sample_ledger_str = unlines- ["; A sample ledger file."- ,";"- ,"; Sets up this account tree:"- ,"; assets"- ,";   bank"- ,";     checking"- ,";     saving"- ,";   cash"- ,"; expenses"- ,";   food"- ,";   supplies"- ,"; income"- ,";   gifts"- ,";   salary"- ,"; liabilities"- ,";   debts"- ,""- ,"2008/01/01 income"- ,"    assets:bank:checking  $1"- ,"    income:salary"- ,""- ,"2008/06/01 gift"- ,"    assets:bank:checking  $1"- ,"    income:gifts"- ,""- ,"2008/06/02 save"- ,"    assets:bank:saving  $1"- ,"    assets:bank:checking"- ,""- ,"2008/06/03 * eat & shop"- ,"    expenses:food      $1"- ,"    expenses:supplies  $1"- ,"    assets:cash"- ,""- ,"2008/12/31 * pay off"- ,"    liabilities:debts  $1"- ,"    assets:bank:checking"- ,""- ,""- ,";final comment"- ]--defaultyear_ledger_str = unlines- ["Y2009"- ,""- ,"01/01 A"- ,"    a  $1"- ,"    b"- ]--write_sample_ledger = writeFile "sample.ledger" sample_ledger_str--entry2_str = unlines- ["2007/01/27 * joes diner"- ,"    expenses:food:dining                      $10.00"- ,"    expenses:gifts                            $10.00"- ,"    assets:checking                          $-20.00"- ,""- ]--entry3_str = unlines- ["2007/01/01 * opening balance"- ,"    assets:cash                                $4.82"- ,"    equity:opening balances"- ,""- ,"2007/01/01 * opening balance"- ,"    assets:cash                                $4.82"- ,"    equity:opening balances"- ,""- ,"2007/01/28 coopportunity"- ,"  expenses:food:groceries                 $47.18"- ,"  assets:checking"- ,""- ]--periodic_entry1_str = unlines- ["~ monthly from 2007/2/2"- ,"  assets:saving            $200.00"- ,"  assets:checking"- ,""- ]--periodic_entry2_str = unlines- ["~ monthly from 2007/2/2"- ,"  assets:saving            $200.00         ;auto savings"- ,"  assets:checking"- ,""- ]--periodic_entry3_str = unlines- ["~ monthly from 2007/01/01"- ,"    assets:cash                                $4.82"- ,"    equity:opening balances"- ,""- ,"~ monthly from 2007/01/01"- ,"    assets:cash                                $4.82"- ,"    equity:opening balances"- ,""- ]--ledger1_str = unlines- [""- ,"2007/01/27 * joes diner"- ,"  expenses:food:dining                    $10.00"- ,"  expenses:gifts                          $10.00"- ,"  assets:checking                        $-20.00"- ,""- ,""- ,"2007/01/28 coopportunity"- ,"  expenses:food:groceries                 $47.18"- ,"  assets:checking                        $-47.18"- ,""- ,""- ]--ledger2_str = unlines- [";comment"- ,"2007/01/27 * joes diner"- ,"  expenses:food:dining                    $10.00"- ,"  assets:checking                        $-47.18"- ,""- ]--ledger3_str = unlines- ["2007/01/27 * joes diner"- ,"  expenses:food:dining                    $10.00"- ,";intra-entry comment"- ,"  assets:checking                        $-47.18"- ,""- ]--ledger4_str = unlines- ["!include \"somefile\""- ,"2007/01/27 * joes diner"- ,"  expenses:food:dining                    $10.00"- ,"  assets:checking                        $-47.18"- ,""- ]--ledger5_str = ""--ledger6_str = unlines- ["~ monthly from 2007/1/21"- ,"    expenses:entertainment  $16.23        ;netflix"- ,"    assets:checking"- ,""- ,"; 2007/01/01 * opening balance"- ,";     assets:saving                            $200.04"- ,";     equity:opening balances                         "- ,""- ]--ledger7_str = unlines- ["2007/01/01 * opening balance"- ,"    assets:cash                                $4.82"- ,"    equity:opening balances                         "- ,""- ,"2007/01/01 * opening balance"- ,"    income:interest                                $-4.82"- ,"    equity:opening balances                         "- ,""- ,"2007/01/02 * ayres suites"- ,"    expenses:vacation                        $179.92"- ,"    assets:checking                                 "- ,""- ,"2007/01/02 * auto transfer to savings"- ,"    assets:saving                            $200.00"- ,"    assets:checking                                 "- ,""- ,"2007/01/03 * poquito mas"- ,"    expenses:food:dining                       $4.82"- ,"    assets:cash                                     "- ,""- ,"2007/01/03 * verizon"- ,"    expenses:phone                            $95.11"- ,"    assets:checking                                 "- ,""- ,"2007/01/03 * discover"- ,"    liabilities:credit cards:discover         $80.00"- ,"    assets:checking                                 "- ,""- ,"2007/01/04 * blue cross"- ,"    expenses:health:insurance                 $90.00"- ,"    assets:checking                                 "- ,""- ,"2007/01/05 * village market liquor"- ,"    expenses:food:dining                       $6.48"- ,"    assets:checking                                 "- ,""- ]--journal7 = Journal-          [] -          [] -          [-           txnTieKnot $ Transaction {-             tdate=parsedate "2007/01/01",-             teffectivedate=Nothing,-             tstatus=False,-             tcode="*",-             tdescription="opening balance",-             tcomment="",-             tpostings=[-              Posting {-                pstatus=False,-                paccount="assets:cash",-                pamount=(Mixed [dollars 4.82]),-                pcomment="",-                ptype=RegularPosting,-                ptransaction=Nothing-              },-              Posting {-                pstatus=False,-                paccount="equity:opening balances",-                pamount=(Mixed [dollars (-4.82)]),-                pcomment="",-                ptype=RegularPosting,-                ptransaction=Nothing-              }-             ],-             tpreceding_comment_lines=""-           }-          ,-           txnTieKnot $ Transaction {-             tdate=parsedate "2007/02/01",-             teffectivedate=Nothing,-             tstatus=False,-             tcode="*",-             tdescription="ayres suites",-             tcomment="",-             tpostings=[-              Posting {-                pstatus=False,-                paccount="expenses:vacation",-                pamount=(Mixed [dollars 179.92]),-                pcomment="",-                ptype=RegularPosting,-                ptransaction=Nothing-              },-              Posting {-                pstatus=False,-                paccount="assets:checking",-                pamount=(Mixed [dollars (-179.92)]),-                pcomment="",-                ptype=RegularPosting,-                ptransaction=Nothing-              }-             ],-             tpreceding_comment_lines=""-           }-          ,-           txnTieKnot $ Transaction {-             tdate=parsedate "2007/01/02",-             teffectivedate=Nothing,-             tstatus=False,-             tcode="*",-             tdescription="auto transfer to savings",-             tcomment="",-             tpostings=[-              Posting {-                pstatus=False,-                paccount="assets:saving",-                pamount=(Mixed [dollars 200]),-                pcomment="",-                ptype=RegularPosting,-                ptransaction=Nothing-              },-              Posting {-                pstatus=False,-                paccount="assets:checking",-                pamount=(Mixed [dollars (-200)]),-                pcomment="",-                ptype=RegularPosting,-                ptransaction=Nothing-              }-             ],-             tpreceding_comment_lines=""-           }-          ,-           txnTieKnot $ Transaction {-             tdate=parsedate "2007/01/03",-             teffectivedate=Nothing,-             tstatus=False,-             tcode="*",-             tdescription="poquito mas",-             tcomment="",-             tpostings=[-              Posting {-                pstatus=False,-                paccount="expenses:food:dining",-                pamount=(Mixed [dollars 4.82]),-                pcomment="",-                ptype=RegularPosting,-                ptransaction=Nothing-              },-              Posting {-                pstatus=False,-                paccount="assets:cash",-                pamount=(Mixed [dollars (-4.82)]),-                pcomment="",-                ptype=RegularPosting,-                ptransaction=Nothing-              }-             ],-             tpreceding_comment_lines=""-           }-          ,-           txnTieKnot $ Transaction {-             tdate=parsedate "2007/01/03",-             teffectivedate=Nothing,-             tstatus=False,-             tcode="*",-             tdescription="verizon",-             tcomment="",-             tpostings=[-              Posting {-                pstatus=False,-                paccount="expenses:phone",-                pamount=(Mixed [dollars 95.11]),-                pcomment="",-                ptype=RegularPosting,-                ptransaction=Nothing-              },-              Posting {-                pstatus=False,-                paccount="assets:checking",-                pamount=(Mixed [dollars (-95.11)]),-                pcomment="",-                ptype=RegularPosting,-                ptransaction=Nothing-              }-             ],-             tpreceding_comment_lines=""-           }-          ,-           txnTieKnot $ Transaction {-             tdate=parsedate "2007/01/03",-             teffectivedate=Nothing,-             tstatus=False,-             tcode="*",-             tdescription="discover",-             tcomment="",-             tpostings=[-              Posting {-                pstatus=False,-                paccount="liabilities:credit cards:discover",-                pamount=(Mixed [dollars 80]),-                pcomment="",-                ptype=RegularPosting,-                ptransaction=Nothing-              },-              Posting {-                pstatus=False,-                paccount="assets:checking",-                pamount=(Mixed [dollars (-80)]),-                pcomment="",-                ptype=RegularPosting,-                ptransaction=Nothing-              }-             ],-             tpreceding_comment_lines=""-           }-          ]-          []-          []-          ""-          ""-          (TOD 0 0)-          ""--ledger7 = cacheLedger journal7--ledger8_str = unlines- ["2008/1/1 test           "- ,"  a:b          10h @ $40"- ,"  c:d                   "- ,""- ]--timelogentry1_str  = "i 2007/03/11 16:19:00 hledger\n"-timelogentry1 = TimeLogEntry In (parsedatetime "2007/03/11 16:19:00") "hledger"--timelogentry2_str  = "o 2007/03/11 16:30:00\n"-timelogentry2 = TimeLogEntry Out (parsedatetime "2007/03/11 16:30:00") ""--a1 = Mixed [(hours 1){price=Just $ Mixed [Amount (comm "$") 10 Nothing]}]-a2 = Mixed [(hours 2){price=Just $ Mixed [Amount (comm "EUR") 10 Nothing]}]-a3 = Mixed $ amounts a1 ++ amounts a2--journalWithAmounts :: [String] -> Journal-journalWithAmounts as =-        Journal-        []-        []-        [t | a <- as, let t = nulltransaction{tdescription=a,tpostings=[nullposting{pamount=parse a,ptransaction=Just t}]}]-        []-        []-        ""-        ""-        (TOD 0 0)-        ""-    where parse = fromparse . parseWithCtx emptyCtx postingamount . (" "++)-