bin: Update bin scripts for new API.

This commit is contained in:
Stephen Morgan 2021-01-01 09:43:00 +11:00
parent 7d3cf1747a
commit ef250e5673
5 changed files with 36 additions and 30 deletions

View File

@ -5,7 +5,8 @@
{-| 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

View File

@ -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

View File

@ -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

View File

@ -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]

View File

@ -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