mirror of
https://github.com/simonmichael/hledger.git
synced 2024-12-26 20:02:27 +03:00
bin: Update bin scripts for new API.
This commit is contained in:
parent
7d3cf1747a
commit
ef250e5673
@ -6,6 +6,7 @@
|
||||
{-| Construct two balance reports for two different time periods and use one of the as "budget" for
|
||||
the other, thus comparing them
|
||||
-}
|
||||
import Data.Text.Lazy.IO as TL
|
||||
import System.Environment (getArgs)
|
||||
import Hledger.Cli
|
||||
|
||||
@ -34,7 +35,7 @@ main = do
|
||||
(_,_,report1) <- mbReport report1args
|
||||
(ropts2,j,report2) <- mbReport report2args
|
||||
let pastAsBudget = combineBudgetAndActual ropts2 j report1{prDates=prDates report2} report2
|
||||
putStrLn $ budgetReportAsText ropts2 pastAsBudget
|
||||
TL.putStrLn $ budgetReportAsText ropts2 pastAsBudget
|
||||
where
|
||||
mbReport args = do
|
||||
opts@CliOpts{reportspec_=rspec} <- getHledgerCliOpts' cmdmode args
|
||||
|
@ -70,7 +70,8 @@ hledger-check-fancyassertions "(assets:overdraft < £2000) ==> (*assets:checkin
|
||||
my checking account (including subaccounts)."
|
||||
-}
|
||||
|
||||
{-# LANGUAGE PackageImports #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PackageImports #-}
|
||||
|
||||
module Main where
|
||||
|
||||
@ -86,7 +87,9 @@ import Data.List.NonEmpty (NonEmpty(..), nonEmpty, toList)
|
||||
import Data.Maybe (fromMaybe, mapMaybe)
|
||||
import Data.Time.Calendar (toGregorian)
|
||||
import Data.Time.Calendar.OrdinalDate (mondayStartWeek, sundayStartWeek, toOrdinalDate)
|
||||
import Data.Text (isPrefixOf, pack, unpack)
|
||||
import Data.Text (Text, isPrefixOf, pack, unpack)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import qualified Hledger.Data as H
|
||||
import qualified Hledger.Query as H
|
||||
import qualified Hledger.Read as H
|
||||
@ -124,17 +127,17 @@ main = do
|
||||
-- | Check assertions against a collection of grouped postings:
|
||||
-- assertions must hold when all postings in the group have been
|
||||
-- applied. Print out errors as they are found.
|
||||
checkAssertions :: [(H.AccountName, H.MixedAmount)] -> [(String, Predicate)] -> [NonEmpty H.Posting] -> IO Bool
|
||||
checkAssertions :: [(H.AccountName, H.MixedAmount)] -> [(Text, Predicate)] -> [NonEmpty H.Posting] -> IO Bool
|
||||
checkAssertions balances0 asserts0 postingss
|
||||
| null failed = pure True
|
||||
| otherwise = putStrLn (intercalate "\n\n" failed) >> pure False
|
||||
| otherwise = T.putStrLn (T.intercalate "\n\n" failed) >> pure False
|
||||
where
|
||||
(_, _, failed) = foldl' applyAndCheck (balances0, asserts0, []) postingss
|
||||
|
||||
-- Apply a collection of postings and check the assertions.
|
||||
applyAndCheck :: ([(H.AccountName, H.MixedAmount)], [(String, Predicate)], [String])
|
||||
applyAndCheck :: ([(H.AccountName, H.MixedAmount)], [(Text, Predicate)], [Text])
|
||||
-> NonEmpty H.Posting
|
||||
-> ([(H.AccountName, H.MixedAmount)], [(String, Predicate)], [String])
|
||||
-> ([(H.AccountName, H.MixedAmount)], [(Text, Predicate)], [Text])
|
||||
applyAndCheck (starting, asserts, errs) ps =
|
||||
let ps' = toList ps
|
||||
closing = starting `addAccounts` closingBalances' ps'
|
||||
@ -145,25 +148,25 @@ checkAssertions balances0 asserts0 postingss
|
||||
|
||||
-- Check an assertion against a collection of account balances,
|
||||
-- and return an error on failure.
|
||||
check :: H.Posting -> [(H.AccountName, H.MixedAmount)] -> (String, Predicate) -> Maybe String
|
||||
check :: H.Posting -> [(H.AccountName, H.MixedAmount)] -> (Text, Predicate) -> Maybe Text
|
||||
check lastp balances (pstr, p)
|
||||
| checkAssertion balances p = Nothing
|
||||
| otherwise = Just . unlines $
|
||||
| otherwise = Just . T.unlines $
|
||||
let after = case H.ptransaction lastp of
|
||||
Just t ->
|
||||
"after transaction:\n" ++ H.showTransaction t ++
|
||||
"(after posting: " ++ init (H.showPosting lastp) ++ ")\n\n"
|
||||
"after transaction:\n" <> H.showTransaction t <>
|
||||
"(after posting: " <> T.pack (init $ H.showPosting lastp) <> ")\n\n"
|
||||
Nothing ->
|
||||
"after posting:\n" ++ H.showPosting lastp
|
||||
"after posting:\n" <> T.pack (H.showPosting lastp)
|
||||
|
||||
-- Restrict to accounts mentioned in the predicate, and pretty-print balances
|
||||
balances' = map (first unpack) $ filter (flip inAssertion p . fst) balances
|
||||
maxalen = maximum $ map (length . fst) balances'
|
||||
accounts = [ a <> padding <> show m
|
||||
balances' = filter (flip inAssertion p . fst) balances
|
||||
maxalen = maximum $ map (T.length . fst) balances'
|
||||
accounts = [ a <> padding <> T.pack (show m)
|
||||
| (a,m) <- balances'
|
||||
, let padding = replicate (2 + maxalen - length a) ' '
|
||||
, let padding = T.replicate (2 + maxalen - T.length a) " "
|
||||
]
|
||||
in [ "assertion '" ++ pstr ++ "' violated", after ++ "relevant balances:"] ++ map (" "++) accounts
|
||||
in [ "assertion '" <> pstr <> "' violated", after <> "relevant balances:"] ++ map (" "<>) accounts
|
||||
|
||||
-- | Check an assertion holds for a collection of account balances.
|
||||
checkAssertion :: [(H.AccountName, H.MixedAmount)] -> Predicate -> Bool
|
||||
@ -322,17 +325,17 @@ data Opts = Opts
|
||||
-- ^ Include only non-virtual postings.
|
||||
, sunday :: Bool
|
||||
-- ^ Week starts on Sunday.
|
||||
, assertionsDaily :: [(String, Predicate)]
|
||||
, assertionsDaily :: [(Text, Predicate)]
|
||||
-- ^ Account assertions that must hold at the end of each day.
|
||||
, assertionsWeekly :: [(String, Predicate)]
|
||||
, assertionsWeekly :: [(Text, Predicate)]
|
||||
-- ^ Account assertions that must hold at the end of each week.
|
||||
, assertionsMonthly :: [(String, Predicate)]
|
||||
, assertionsMonthly :: [(Text, Predicate)]
|
||||
-- ^ Account assertions that must hold at the end of each month.
|
||||
, assertionsQuarterly :: [(String, Predicate)]
|
||||
, assertionsQuarterly :: [(Text, Predicate)]
|
||||
-- ^ Account assertions that must hold at the end of each quarter.
|
||||
, assertionsYearly :: [(String, Predicate)]
|
||||
, assertionsYearly :: [(Text, Predicate)]
|
||||
-- ^ Account assertions that must hold at the end of each year.
|
||||
, assertionsAlways :: [(String, Predicate)]
|
||||
, assertionsAlways :: [(Text, Predicate)]
|
||||
-- ^ Account assertions that must hold after each txn.
|
||||
}
|
||||
deriving (Show)
|
||||
@ -388,13 +391,13 @@ args = info (helper <*> parser) $ mconcat
|
||||
|
||||
-- Turn a Parsec parser into a ReadM parser that also returns the
|
||||
-- input.
|
||||
readParsec :: H.JournalParser ReadM a -> ReadM (String, a)
|
||||
readParsec :: H.JournalParser ReadM a -> ReadM (Text, a)
|
||||
readParsec p = do
|
||||
s <- str
|
||||
parsed <- P.runParserT (runStateT p H.nulljournal) "" (pack s)
|
||||
parsed <- P.runParserT (runStateT p H.nulljournal) "" s
|
||||
case parsed of
|
||||
Right (a, _) -> pure (s, a)
|
||||
Left err -> fail ("failed to parse input '" ++ s ++ "': " ++ show err)
|
||||
Left err -> fail ("failed to parse input '" ++ unpack s ++ "': " ++ show err)
|
||||
|
||||
readParsec' :: H.SimpleTextParser a -> ReadM (String, a)
|
||||
readParsec' p = do
|
||||
|
@ -9,6 +9,7 @@ import System.Environment (getArgs)
|
||||
import Hledger.Cli
|
||||
import qualified Data.Map as M
|
||||
import Data.Map.Merge.Strict
|
||||
import qualified Data.Text.Lazy.IO as TL
|
||||
|
||||
appendReports :: MultiBalanceReport -> MultiBalanceReport -> MultiBalanceReport
|
||||
appendReports r1 r2 =
|
||||
@ -62,7 +63,7 @@ main = do
|
||||
(_,report1) <- mbReport report1args
|
||||
(rspec2,report2) <- mbReport report2args
|
||||
let merged = appendReports report1 report2
|
||||
putStrLn $ multiBalanceReportAsText (rsOpts rspec2) merged
|
||||
TL.putStrLn $ multiBalanceReportAsText (rsOpts rspec2) merged
|
||||
where
|
||||
mbReport args = do
|
||||
opts@CliOpts{reportspec_=rspec} <- getHledgerCliOpts' cmdmode args
|
||||
|
@ -69,7 +69,7 @@ main = do
|
||||
pr = postingsReport rspec{rsQuery = And [Acct $ accountNameToAccountRegexCI acct, q]} j
|
||||
|
||||
-- dates of postings to acct (in report)
|
||||
pdates = map (postingDate . fourth5) (snd pr)
|
||||
pdates = map (postingDate . fourth5) pr
|
||||
-- the specified report end date or today's date
|
||||
enddate = fromMaybe today menddate
|
||||
dates = pdates ++ [enddate]
|
||||
|
@ -7,6 +7,7 @@
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
import Data.String.QQ (s)
|
||||
import qualified Data.Text.IO as T
|
||||
import Hledger
|
||||
import Hledger.Cli
|
||||
|
||||
@ -33,7 +34,7 @@ main = do
|
||||
q = rsQuery rspec
|
||||
ts = filter (q `matchesTransaction`) $ jtxns $ journalSelectingAmountFromOpts (rsOpts rspec) j
|
||||
ts' = map transactionSwapDates ts
|
||||
mapM_ (putStrLn . showTransaction) ts'
|
||||
mapM_ (T.putStrLn . showTransaction) ts'
|
||||
|
||||
transactionSwapDates :: Transaction -> Transaction
|
||||
transactionSwapDates t@Transaction{tdate2=Nothing} = t
|
||||
|
Loading…
Reference in New Issue
Block a user