From ef250e5673468d1dd23cdab7e23ce5304628ae81 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Fri, 1 Jan 2021 09:43:00 +1100 Subject: [PATCH] bin: Update bin scripts for new API. --- bin/hledger-balance-as-budget.hs | 5 +-- bin/hledger-check-fancyassertions.hs | 53 +++++++++++++++------------- bin/hledger-combine-balances.hs | 3 +- bin/hledger-smooth.hs | 2 +- bin/hledger-swap-dates.hs | 3 +- 5 files changed, 36 insertions(+), 30 deletions(-) diff --git a/bin/hledger-balance-as-budget.hs b/bin/hledger-balance-as-budget.hs index e7350cb3a..cbd3699f3 100755 --- a/bin/hledger-balance-as-budget.hs +++ b/bin/hledger-balance-as-budget.hs @@ -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 diff --git a/bin/hledger-check-fancyassertions.hs b/bin/hledger-check-fancyassertions.hs index 7052ce7c4..1e8ad995d 100755 --- a/bin/hledger-check-fancyassertions.hs +++ b/bin/hledger-check-fancyassertions.hs @@ -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 diff --git a/bin/hledger-combine-balances.hs b/bin/hledger-combine-balances.hs index 5dd042125..084a26bc9 100755 --- a/bin/hledger-combine-balances.hs +++ b/bin/hledger-combine-balances.hs @@ -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 diff --git a/bin/hledger-smooth.hs b/bin/hledger-smooth.hs index 2ba770a9b..40d69b200 100755 --- a/bin/hledger-smooth.hs +++ b/bin/hledger-smooth.hs @@ -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] diff --git a/bin/hledger-swap-dates.hs b/bin/hledger-swap-dates.hs index f3eaa85bc..c8fd88f41 100755 --- a/bin/hledger-swap-dates.hs +++ b/bin/hledger-swap-dates.hs @@ -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