cli: Using Text Builder for posting reports.
This commit is contained in:
Stephen Morgan
parent
ac39d59016
commit
646ee0bce5
@ -44,7 +44,7 @@ import Data.Decimal
|
||||
import Data.Maybe
|
||||
import qualified Data.Text.Lazy as TL
|
||||
import qualified Data.Text.Lazy.IO as TL
|
||||
import Data.Text.Lazy.Builder (toLazyText)
|
||||
import qualified Data.Text.Lazy.Builder as TB
|
||||
import GHC.Generics (Generic)
|
||||
import System.Time (ClockTime)
|
||||
|
||||
@ -232,7 +232,7 @@ instance FromJSON (DecimalRaw Integer)
|
||||
|
||||
-- | Show a JSON-convertible haskell value as pretty-printed JSON text.
|
||||
toJsonText :: ToJSON a => a -> TL.Text
|
||||
toJsonText = (<>"\n") . toLazyText . encodePrettyToTextBuilder
|
||||
toJsonText = TB.toLazyText . (<> TB.fromText "\n") . encodePrettyToTextBuilder
|
||||
|
||||
-- | Write a JSON-convertible haskell value to a pretty-printed JSON file.
|
||||
-- Eg: writeJsonFile "a.json" nulltransaction
|
||||
|
||||
@ -24,8 +24,7 @@ where
|
||||
import Data.List
|
||||
import Data.List.Extra (nubSort)
|
||||
import Data.Maybe
|
||||
-- import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text (Text)
|
||||
import Data.Time.Calendar
|
||||
import Safe (headMay, lastMay)
|
||||
|
||||
@ -38,9 +37,7 @@ import Hledger.Reports.ReportOptions
|
||||
-- | A postings report is a list of postings with a running total, a label
|
||||
-- for the total field, and a little extra transaction info to help with rendering.
|
||||
-- This is used eg for the register command.
|
||||
type PostingsReport = (String -- label for the running balance column XXX remove
|
||||
,[PostingsReportItem] -- line items, one per posting
|
||||
)
|
||||
type PostingsReport = [PostingsReportItem] -- line items, one per posting
|
||||
type PostingsReportItem = (Maybe Day -- The posting date, if this is the first posting in a
|
||||
-- transaction or if it's different from the previous
|
||||
-- posting's date. Or if this a summary posting, the
|
||||
@ -49,7 +46,7 @@ type PostingsReportItem = (Maybe Day -- The posting date, if this is the firs
|
||||
,Maybe Day -- If this is a summary posting, the report interval's
|
||||
-- end date if this is the first summary posting in
|
||||
-- the interval.
|
||||
,Maybe String -- The posting's transaction's description, if this is the first posting in the transaction.
|
||||
,Maybe Text -- The posting's transaction's description, if this is the first posting in the transaction.
|
||||
,Posting -- The posting, possibly with the account name depth-clipped.
|
||||
,MixedAmount -- The running total after this posting, or with --average,
|
||||
-- the running average posting amount. With --historical,
|
||||
@ -66,8 +63,7 @@ type SummaryPosting = (Posting, Day)
|
||||
-- | Select postings from the journal and add running balance and other
|
||||
-- information to make a postings report. Used by eg hledger's register command.
|
||||
postingsReport :: ReportSpec -> Journal -> PostingsReport
|
||||
postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j =
|
||||
(totallabel, items)
|
||||
postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = items
|
||||
where
|
||||
reportspan = adjustReportDates rspec j
|
||||
whichdate = whichDateFromOpts ropts
|
||||
@ -130,8 +126,6 @@ registerRunningCalculationFn ropts
|
||||
| average_ ropts = \i avg amt -> avg + divideMixedAmount (fromIntegral i) (amt - avg)
|
||||
| otherwise = \_ bal amt -> bal + amt
|
||||
|
||||
totallabel = "Total"
|
||||
|
||||
-- | Adjust report start/end dates to more useful ones based on
|
||||
-- journal data and report intervals. Ie:
|
||||
-- 1. If the start date is unspecified, use the earliest date in the journal (if any)
|
||||
@ -206,14 +200,13 @@ mkpostingsReportItem :: Bool -> Bool -> WhichDate -> Maybe Day -> Posting -> Mix
|
||||
mkpostingsReportItem showdate showdesc wd menddate p b =
|
||||
(if showdate then Just date else Nothing
|
||||
,menddate
|
||||
,if showdesc then Just desc else Nothing
|
||||
,if showdesc then tdescription <$> ptransaction p else Nothing
|
||||
,p
|
||||
,b
|
||||
)
|
||||
where
|
||||
date = case wd of PrimaryDate -> postingDate p
|
||||
SecondaryDate -> postingDate2 p
|
||||
desc = T.unpack $ maybe "" tdescription $ ptransaction p
|
||||
|
||||
-- | Convert a list of postings into summary postings, one per interval,
|
||||
-- aggregated to the specified depth if any.
|
||||
@ -267,7 +260,7 @@ negatePostingAmount p = p { pamount = negate $ pamount p }
|
||||
tests_PostingsReport = tests "PostingsReport" [
|
||||
|
||||
test "postingsReport" $ do
|
||||
let (query, journal) `gives` n = (length $ snd $ postingsReport defreportspec{rsQuery=query} journal) @?= n
|
||||
let (query, journal) `gives` n = (length $ postingsReport defreportspec{rsQuery=query} journal) @?= n
|
||||
-- with the query specified explicitly
|
||||
(Any, nulljournal) `gives` 0
|
||||
(Any, samplejournal) `gives` 13
|
||||
@ -276,10 +269,10 @@ tests_PostingsReport = tests "PostingsReport" [
|
||||
(And [Depth 1, StatusQ Cleared, Acct (toRegex' "expenses")], samplejournal) `gives` 2
|
||||
(And [And [Depth 1, StatusQ Cleared], Acct (toRegex' "expenses")], samplejournal) `gives` 2
|
||||
-- with query and/or command-line options
|
||||
(length $ snd $ postingsReport defreportspec samplejournal) @?= 13
|
||||
(length $ snd $ postingsReport defreportspec{rsOpts=defreportopts{interval_=Months 1}} samplejournal) @?= 11
|
||||
(length $ snd $ postingsReport defreportspec{rsOpts=defreportopts{interval_=Months 1, empty_=True}} samplejournal) @?= 20
|
||||
(length $ snd $ postingsReport defreportspec{rsQuery=Acct $ toRegex' "assets:bank:checking"} samplejournal) @?= 5
|
||||
(length $ postingsReport defreportspec samplejournal) @?= 13
|
||||
(length $ postingsReport defreportspec{rsOpts=defreportopts{interval_=Months 1}} samplejournal) @?= 11
|
||||
(length $ postingsReport defreportspec{rsOpts=defreportopts{interval_=Months 1, empty_=True}} samplejournal) @?= 20
|
||||
(length $ postingsReport defreportspec{rsQuery=Acct $ toRegex' "assets:bank:checking"} samplejournal) @?= 5
|
||||
|
||||
-- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0
|
||||
-- [(Just (fromGregorian 2008 01 01,"income"),assets:bank:checking $1,$1)
|
||||
|
||||
@ -30,6 +30,8 @@ import qualified Data.Set as S
|
||||
import Data.Maybe
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy as TL
|
||||
import qualified Data.Text.Lazy.IO as TL
|
||||
import Data.Time.Calendar (Day)
|
||||
import Data.Time.Format (formatTime, defaultTimeLocale, iso8601DateFormat)
|
||||
import Safe (headDef, headMay, atMay)
|
||||
@ -442,7 +444,7 @@ journalAddTransaction j@Journal{jtxns=ts} opts t = do
|
||||
-- unelided shows all amounts explicitly, in case there's a price, cf #283
|
||||
when (debug_ opts > 0) $ do
|
||||
putStrLn $ printf "\nAdded transaction to %s:" f
|
||||
putStrLn =<< registerFromString (showTransaction t)
|
||||
TL.putStrLn =<< registerFromString (T.pack $ showTransaction t)
|
||||
return j{jtxns=ts++[t]}
|
||||
|
||||
-- | Append a string, typically one or more transactions, to a journal
|
||||
@ -464,9 +466,9 @@ ensureOneNewlineTerminated :: String -> String
|
||||
ensureOneNewlineTerminated = (++"\n") . reverse . dropWhile (=='\n') . reverse
|
||||
|
||||
-- | Convert a string of journal data into a register report.
|
||||
registerFromString :: String -> IO String
|
||||
registerFromString :: Text -> IO TL.Text
|
||||
registerFromString s = do
|
||||
j <- readJournal' $ T.pack s
|
||||
j <- readJournal' s
|
||||
return . postingsReportAsText opts $ postingsReport rspec j
|
||||
where
|
||||
ropts = defreportopts{empty_=True}
|
||||
|
||||
@ -23,6 +23,7 @@ import Data.Maybe
|
||||
-- import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy as TL
|
||||
import qualified Data.Text.Lazy.Builder as TB
|
||||
import System.Console.CmdArgs.Explicit
|
||||
import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV)
|
||||
|
||||
@ -58,16 +59,17 @@ registermode = hledgerCommandMode
|
||||
|
||||
-- | Print a (posting) register report.
|
||||
register :: CliOpts -> Journal -> IO ()
|
||||
register opts@CliOpts{reportspec_=rspec} j = do
|
||||
let fmt = outputFormatFromOpts opts
|
||||
render | fmt=="txt" = postingsReportAsText
|
||||
| fmt=="csv" = const ((++"\n") . printCSV . postingsReportAsCsv)
|
||||
| fmt=="json" = const ((++"\n") . TL.unpack . toJsonText)
|
||||
| otherwise = const $ error' $ unsupportedOutputFormatError fmt -- PARTIAL:
|
||||
writeOutput opts . render opts $ postingsReport rspec j
|
||||
register opts@CliOpts{reportspec_=rspec} j =
|
||||
writeOutputLazyText opts . render $ postingsReport rspec j
|
||||
where
|
||||
fmt = outputFormatFromOpts opts
|
||||
render | fmt=="txt" = postingsReportAsText opts
|
||||
| fmt=="csv" = TL.pack . printCSV . postingsReportAsCsv
|
||||
| fmt=="json" = toJsonText
|
||||
| otherwise = error' $ unsupportedOutputFormatError fmt -- PARTIAL:
|
||||
|
||||
postingsReportAsCsv :: PostingsReport -> CSV
|
||||
postingsReportAsCsv (_,is) =
|
||||
postingsReportAsCsv is =
|
||||
["txnidx","date","code","description","account","amount","total"]
|
||||
:
|
||||
map postingsReportItemAsCsvRecord is
|
||||
@ -89,13 +91,17 @@ postingsReportItemAsCsvRecord (_, _, _, p, b) = [idx,date,code,desc,acct,amt,bal
|
||||
bal = showMixedAmountOneLineWithoutPrice False b
|
||||
|
||||
-- | Render a register report as plain text suitable for console output.
|
||||
postingsReportAsText :: CliOpts -> PostingsReport -> String
|
||||
postingsReportAsText opts (_,items) = unlines $ map (postingsReportItemAsText opts amtwidth balwidth) items
|
||||
postingsReportAsText :: CliOpts -> PostingsReport -> TL.Text
|
||||
postingsReportAsText opts items =
|
||||
TB.toLazyText . unlinesB $
|
||||
map (postingsReportItemAsText opts amtwidth balwidth) items
|
||||
where
|
||||
amtwidth = maximumStrict $ map (snd . showMixed showAmount (Just 12) Nothing False . itemamt) items
|
||||
balwidth = maximumStrict $ map (snd . showMixed showAmount (Just 12) Nothing False . itembal) items
|
||||
itemamt (_,_,_,Posting{pamount=a},_) = a
|
||||
itembal (_,_,_,_,a) = a
|
||||
unlinesB [] = mempty
|
||||
unlinesB xs = mconcat (intersperse (TB.fromText "\n") xs) <> TB.fromText "\n"
|
||||
|
||||
-- | Render one register report line item as plain text. Layout is like so:
|
||||
-- @
|
||||
@ -119,36 +125,30 @@ postingsReportAsText opts (_,items) = unlines $ map (postingsReportItemAsText op
|
||||
-- has multiple commodities. Does not yet support formatting control
|
||||
-- like balance reports.
|
||||
--
|
||||
postingsReportItemAsText :: CliOpts -> Int -> Int -> PostingsReportItem -> String
|
||||
postingsReportItemAsText :: CliOpts -> Int -> Int -> PostingsReportItem -> TB.Builder
|
||||
postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, menddate, mdesc, p, b) =
|
||||
-- use elide*Width to be wide-char-aware
|
||||
-- trace (show (totalwidth, datewidth, descwidth, acctwidth, amtwidth, balwidth)) $
|
||||
intercalate "\n" $
|
||||
concat [fitString (Just datewidth) (Just datewidth) True True date
|
||||
foldMap mconcat . intersperse ([TB.fromText "\n"]) . map (map TB.fromText) $
|
||||
[ fitText (Just datewidth) (Just datewidth) True True date
|
||||
, " "
|
||||
,fitString (Just descwidth) (Just descwidth) True True desc
|
||||
, fitText (Just descwidth) (Just descwidth) True True desc
|
||||
, " "
|
||||
,fitString (Just acctwidth) (Just acctwidth) True True acct
|
||||
, fitText (Just acctwidth) (Just acctwidth) True True acct
|
||||
, " "
|
||||
, amtfirstline
|
||||
, " "
|
||||
, balfirstline
|
||||
]
|
||||
:
|
||||
[concat [spacer
|
||||
,a
|
||||
," "
|
||||
,b
|
||||
]
|
||||
| (a,b) <- zip amtrest balrest
|
||||
]
|
||||
[ [ spacer, a, " ", b ] | (a,b) <- zip amtrest balrest ]
|
||||
where
|
||||
-- calculate widths
|
||||
(totalwidth,mdescwidth) = registerWidthsFromOpts opts
|
||||
(datewidth, date) = case (mdate,menddate) of
|
||||
(Just _, Just _) -> (21, showDateSpan (DateSpan mdate menddate))
|
||||
(Just _, Just _) -> (21, T.pack $ showDateSpan (DateSpan mdate menddate))
|
||||
(Nothing, Just _) -> (21, "")
|
||||
(Just d, Nothing) -> (10, showDate d)
|
||||
(Just d, Nothing) -> (10, T.pack $ showDate d)
|
||||
_ -> (10, "")
|
||||
(amtwidth, balwidth)
|
||||
| shortfall <= 0 = (preferredamtwidth, preferredbalwidth)
|
||||
@ -171,24 +171,25 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda
|
||||
|
||||
-- gather content
|
||||
desc = fromMaybe "" mdesc
|
||||
acct = parenthesise $ T.unpack $ elideAccountName awidth $ paccount p
|
||||
acct = parenthesise . elideAccountName awidth $ paccount p
|
||||
where
|
||||
(parenthesise, awidth) =
|
||||
case ptype p of
|
||||
BalancedVirtualPosting -> (\s -> "["++s++"]", acctwidth-2)
|
||||
VirtualPosting -> (\s -> "("++s++")", acctwidth-2)
|
||||
BalancedVirtualPosting -> (\s -> wrap "[" "]" s, acctwidth-2)
|
||||
VirtualPosting -> (\s -> wrap "(" ")" s, acctwidth-2)
|
||||
_ -> (id,acctwidth)
|
||||
amt = fst $ showMixed showAmountWithoutPrice (Just amtwidth) (Just amtwidth) (color_ . rsOpts $ reportspec_ opts) $ pamount p
|
||||
bal = fst $ showMixed showAmountWithoutPrice (Just balwidth) (Just balwidth) (color_ . rsOpts $ reportspec_ opts) b
|
||||
wrap a b x = a <> x <> b
|
||||
amt = T.pack . fst $ showMixed showAmountWithoutPrice (Just amtwidth) (Just amtwidth) (color_ . rsOpts $ reportspec_ opts) $ pamount p
|
||||
bal = T.pack . fst $ showMixed showAmountWithoutPrice (Just balwidth) (Just balwidth) (color_ . rsOpts $ reportspec_ opts) b
|
||||
-- alternate behaviour, show null amounts as 0 instead of blank
|
||||
-- amt = if null amt' then "0" else amt'
|
||||
-- bal = if null bal' then "0" else bal'
|
||||
(amtlines, ballines) = (lines amt, lines bal)
|
||||
(amtlines, ballines) = (T.lines amt, T.lines bal)
|
||||
(amtlen, ballen) = (length amtlines, length ballines)
|
||||
numlines = max 1 (max amtlen ballen)
|
||||
(amtfirstline:amtrest) = take numlines $ amtlines ++ repeat (replicate amtwidth ' ') -- posting amount is top-aligned
|
||||
(balfirstline:balrest) = take numlines $ replicate (numlines - ballen) (replicate balwidth ' ') ++ ballines -- balance amount is bottom-aligned
|
||||
spacer = replicate (totalwidth - (amtwidth + 2 + balwidth)) ' '
|
||||
(amtfirstline:amtrest) = take numlines $ amtlines ++ repeat (T.replicate amtwidth " ") -- posting amount is top-aligned
|
||||
(balfirstline:balrest) = take numlines $ replicate (numlines - ballen) (T.replicate balwidth " ") ++ ballines -- balance amount is bottom-aligned
|
||||
spacer = T.replicate (totalwidth - (amtwidth + 2 + balwidth)) " "
|
||||
|
||||
-- tests
|
||||
|
||||
@ -198,7 +199,7 @@ tests_Register = tests "Register" [
|
||||
test "unicode in register layout" $ do
|
||||
j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
|
||||
let rspec = defreportspec
|
||||
(postingsReportAsText defcliopts $ postingsReport rspec j)
|
||||
(TL.unpack . postingsReportAsText defcliopts $ postingsReport rspec j)
|
||||
@?=
|
||||
unlines
|
||||
["2009-01-01 медвежья шкура расходы:покупки 100 100"
|
||||
|
||||
@ -10,6 +10,7 @@ where
|
||||
import Data.Char (toUpper)
|
||||
import Data.List
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy.IO as TL
|
||||
import Hledger
|
||||
import Hledger.Cli.CliOptions
|
||||
import Hledger.Cli.Commands.Register
|
||||
@ -25,14 +26,13 @@ registermatch :: CliOpts -> Journal -> IO ()
|
||||
registermatch opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j =
|
||||
case listofstringopt "args" rawopts of
|
||||
[desc] -> do
|
||||
let (_,pris) = postingsReport rspec j
|
||||
ps = [p | (_,_,_,p,_) <- pris]
|
||||
let ps = [p | (_,_,_,p,_) <- postingsReport rspec j]
|
||||
case similarPosting ps desc of
|
||||
Nothing -> putStrLn "no matches found."
|
||||
Just p -> putStr $ postingsReportAsText opts ("",[pri])
|
||||
Just p -> TL.putStr $ postingsReportAsText opts [pri]
|
||||
where pri = (Just (postingDate p)
|
||||
,Nothing
|
||||
,Just $ T.unpack (maybe "" tdescription $ ptransaction p)
|
||||
,tdescription <$> ptransaction p
|
||||
,p
|
||||
,0)
|
||||
_ -> putStrLn "please provide one description argument."
|
||||
|
||||
@ -13,6 +13,7 @@ module Hledger.Cli.Utils
|
||||
unsupportedOutputFormatError,
|
||||
withJournalDo,
|
||||
writeOutput,
|
||||
writeOutputLazyText,
|
||||
journalTransform,
|
||||
journalAddForecast,
|
||||
journalReload,
|
||||
@ -34,6 +35,8 @@ import Data.List
|
||||
import Data.Maybe
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import qualified Data.Text.Lazy as TL
|
||||
import qualified Data.Text.Lazy.IO as TL
|
||||
import Data.Time (UTCTime, Day, addDays)
|
||||
import Safe (readMay)
|
||||
import System.Console.CmdArgs
|
||||
@ -159,6 +162,14 @@ writeOutput opts s = do
|
||||
f <- outputFileFromOpts opts
|
||||
(if f == "-" then putStr else writeFile f) s
|
||||
|
||||
-- | Write some output to stdout or to a file selected by --output-file.
|
||||
-- If the file exists it will be overwritten. This function operates on Lazy
|
||||
-- Text values.
|
||||
writeOutputLazyText :: CliOpts -> TL.Text -> IO ()
|
||||
writeOutputLazyText opts s = do
|
||||
f <- outputFileFromOpts opts
|
||||
(if f == "-" then TL.putStr else TL.writeFile f) s
|
||||
|
||||
-- -- | Get a journal from the given string and options, or throw an error.
|
||||
-- readJournal :: CliOpts -> String -> IO Journal
|
||||
-- readJournal opts s = readJournal def Nothing s >>= either error' return
|
||||
|
||||
Loading…
Reference in New Issue
Block a user