From e3ec01c3c6a64da228979b3845968484b7a1af53 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Thu, 5 Nov 2020 12:58:04 +1100 Subject: [PATCH] lib,cli,ui: Use Text for showDate and related. --- hledger-lib/Hledger/Data/Dates.hs | 16 +++++----- hledger-lib/Hledger/Data/Period.hs | 24 +++++++++------ hledger-lib/Hledger/Data/Transaction.hs | 2 +- .../Hledger/Data/TransactionModifier.hs | 6 ++-- hledger-lib/Hledger/Read.hs | 22 +++++++------- hledger-lib/Hledger/Reports/BudgetReport.hs | 14 ++++----- hledger-ui/Hledger/UI/RegisterScreen.hs | 2 +- hledger-ui/Hledger/UI/UIUtils.hs | 3 +- hledger/Hledger/Cli/Commands/Add.hs | 2 +- hledger/Hledger/Cli/Commands/Aregister.hs | 4 +-- hledger/Hledger/Cli/Commands/Balance.hs | 8 ++--- hledger/Hledger/Cli/Commands/Print.hs | 4 +-- hledger/Hledger/Cli/Commands/Register.hs | 8 ++--- hledger/Hledger/Cli/Commands/Roi.hs | 18 +++++------ hledger/Hledger/Cli/CompoundBalanceCommand.hs | 30 +++++++++---------- 15 files changed, 85 insertions(+), 78 deletions(-) diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs index 3ccdeae46..c9c0ca4bd 100644 --- a/hledger-lib/Hledger/Data/Dates.hs +++ b/hledger-lib/Hledger/Data/Dates.hs @@ -110,19 +110,19 @@ import Hledger.Utils -- Help ppShow parse and line-wrap DateSpans better in debug output. instance Show DateSpan where - show s = "DateSpan " ++ showDateSpan s + show s = "DateSpan " ++ T.unpack (showDateSpan s) -showDate :: Day -> String -showDate = show +showDate :: Day -> Text +showDate = T.pack . show -- | Render a datespan as a display string, abbreviating into a -- compact form if possible. -showDateSpan :: DateSpan -> String +showDateSpan :: DateSpan -> Text showDateSpan = showPeriod . dateSpanAsPeriod -- | Like showDateSpan, but show month spans as just the abbreviated month name -- in the current locale. -showDateSpanMonthAbbrev :: DateSpan -> String +showDateSpanMonthAbbrev :: DateSpan -> Text showDateSpanMonthAbbrev = showPeriodMonthAbbrev . dateSpanAsPeriod -- | Get the current local date. @@ -388,13 +388,13 @@ spanFromSmartDate refdate sdate = DateSpan (Just b) (Just e) -- | Convert a smart date string to an explicit yyyy\/mm\/dd string using -- the provided reference date, or raise an error. -fixSmartDateStr :: Day -> Text -> String +fixSmartDateStr :: Day -> Text -> Text fixSmartDateStr d s = either (error' . printf "could not parse date %s %s" (show s) . show) id $ -- PARTIAL: - (fixSmartDateStrEither d s :: Either (ParseErrorBundle Text CustomErr) String) + (fixSmartDateStrEither d s :: Either (ParseErrorBundle Text CustomErr) Text) -- | A safe version of fixSmartDateStr. -fixSmartDateStrEither :: Day -> Text -> Either (ParseErrorBundle Text CustomErr) String +fixSmartDateStrEither :: Day -> Text -> Either (ParseErrorBundle Text CustomErr) Text fixSmartDateStrEither d = fmap showDate . fixSmartDateStrEither' d fixSmartDateStrEither' diff --git a/hledger-lib/Hledger/Data/Period.hs b/hledger-lib/Hledger/Data/Period.hs index 9f7c785e7..bf261563a 100644 --- a/hledger-lib/Hledger/Data/Period.hs +++ b/hledger-lib/Hledger/Data/Period.hs @@ -5,6 +5,8 @@ a richer abstraction than DateSpan. See also Types and Dates. -} +{-# LANGUAGE OverloadedStrings #-} + module Hledger.Data.Period ( periodAsDateSpan ,dateSpanAsPeriod @@ -30,6 +32,8 @@ module Hledger.Data.Period ( ) where +import Data.Text (Text) +import qualified Data.Text as T import Data.Time.Calendar import Data.Time.Calendar.MonthDay import Data.Time.Calendar.OrdinalDate @@ -155,21 +159,23 @@ isStandardPeriod = isStandardPeriod' . simplifyPeriod -- -- >>> showPeriod (WeekPeriod (fromGregorian 2016 7 25)) -- "2016-07-25W30" -showPeriod (DayPeriod b) = formatTime defaultTimeLocale "%F" b -- DATE -showPeriod (WeekPeriod b) = formatTime defaultTimeLocale "%FW%V" b -- STARTDATEWYEARWEEK -showPeriod (MonthPeriod y m) = printf "%04d-%02d" y m -- YYYY-MM -showPeriod (QuarterPeriod y q) = printf "%04dQ%d" y q -- YYYYQN -showPeriod (YearPeriod y) = printf "%04d" y -- YYYY -showPeriod (PeriodBetween b e) = formatTime defaultTimeLocale "%F" b +showPeriod :: Period -> Text +showPeriod (DayPeriod b) = T.pack $ formatTime defaultTimeLocale "%F" b -- DATE +showPeriod (WeekPeriod b) = T.pack $ formatTime defaultTimeLocale "%FW%V" b -- STARTDATEWYEARWEEK +showPeriod (MonthPeriod y m) = T.pack $ printf "%04d-%02d" y m -- YYYY-MM +showPeriod (QuarterPeriod y q) = T.pack $ printf "%04dQ%d" y q -- YYYYQN +showPeriod (YearPeriod y) = T.pack $ printf "%04d" y -- YYYY +showPeriod (PeriodBetween b e) = T.pack $ formatTime defaultTimeLocale "%F" b ++ formatTime defaultTimeLocale "..%F" (addDays (-1) e) -- STARTDATE..INCLUSIVEENDDATE -showPeriod (PeriodFrom b) = formatTime defaultTimeLocale "%F.." b -- STARTDATE.. -showPeriod (PeriodTo e) = formatTime defaultTimeLocale "..%F" (addDays (-1) e) -- ..INCLUSIVEENDDATE +showPeriod (PeriodFrom b) = T.pack $ formatTime defaultTimeLocale "%F.." b -- STARTDATE.. +showPeriod (PeriodTo e) = T.pack $ formatTime defaultTimeLocale "..%F" (addDays (-1) e) -- ..INCLUSIVEENDDATE showPeriod PeriodAll = ".." -- | Like showPeriod, but if it's a month period show just -- the 3 letter month name abbreviation for the current locale. +showPeriodMonthAbbrev :: Period -> Text showPeriodMonthAbbrev (MonthPeriod _ m) -- Jan - | m > 0 && m <= length monthnames = snd $ monthnames !! (m-1) + | m > 0 && m <= length monthnames = T.pack . snd $ monthnames !! (m-1) where monthnames = months defaultTimeLocale showPeriodMonthAbbrev p = showPeriod p diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index ab367dbc2..c6ea54f58 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -174,7 +174,7 @@ showTransactionHelper onelineamounts t = ++ [""] where descriptionline = T.stripEnd $ T.concat [date, status, code, desc, samelinecomment] - date = T.pack $ showDate (tdate t) ++ maybe "" (("="++) . showDate) (tdate2 t) + date = showDate (tdate t) <> maybe "" (("="<>) . showDate) (tdate2 t) status | tstatus t == Cleared = " *" | tstatus t == Pending = " !" | otherwise = "" diff --git a/hledger-lib/Hledger/Data/TransactionModifier.hs b/hledger-lib/Hledger/Data/TransactionModifier.hs index 6bf71f328..cabe79b7d 100644 --- a/hledger-lib/Hledger/Data/TransactionModifier.hs +++ b/hledger-lib/Hledger/Data/TransactionModifier.hs @@ -26,7 +26,7 @@ import Hledger.Data.Amount import Hledger.Data.Transaction import Hledger.Query import Hledger.Data.Posting (commentJoin, commentAddTag) -import Hledger.Utils.Debug +import Hledger.Utils -- $setup -- >>> :set -XOverloadedStrings @@ -137,7 +137,7 @@ postingRuleMultiplier p = renderPostingCommentDates :: Posting -> Posting renderPostingCommentDates p = p { pcomment = comment' } where - dates = T.concat $ catMaybes [T.pack . showDate <$> pdate p, ("=" <>) . T.pack . showDate <$> pdate2 p] + dates = T.concat $ catMaybes [showDate <$> pdate p, ("=" <>) . showDate <$> pdate2 p] comment' | T.null dates = pcomment p - | otherwise = ("[" <> dates <> "]") `commentJoin` pcomment p + | otherwise = (wrap "[" "]" dates) `commentJoin` pcomment p diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index c9e2a3c9a..dc0f3418d 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/hledger-lib/Hledger/Read.hs @@ -56,6 +56,7 @@ import Data.Ord (comparing) import Data.Semigroup (sconcat) import Data.Text (Text) import qualified Data.Text as T +import qualified Data.Text.IO as T import Data.Time (Day) import Safe (headDef) import System.Directory (doesFileExist, getHomeDirectory) @@ -63,8 +64,7 @@ import System.Environment (getEnv) import System.Exit (exitFailure) import System.FilePath ((<.>), (), splitDirectories, splitFileName) import System.Info (os) -import System.IO (stderr, writeFile) -import Text.Printf (hPrintf, printf) +import System.IO (hPutStr, stderr) import Hledger.Data.Dates (getCurrentDay, parsedateM, showDate) import Hledger.Data.Types @@ -191,9 +191,9 @@ requireJournalFileExists "-" = return () requireJournalFileExists f = do exists <- doesFileExist f when (not exists) $ do -- XXX might not be a journal file - hPrintf stderr "The hledger journal file \"%s\" was not found.\n" f - hPrintf stderr "Please create it first, eg with \"hledger add\" or a text editor.\n" - hPrintf stderr "Or, specify an existing journal file with -f or LEDGER_FILE.\n" + hPutStr stderr $ "The hledger journal file \"" <> show f <> "\" was not found.\n" + hPutStr stderr "Please create it first, eg with \"hledger add\" or a text editor.\n" + hPutStr stderr "Or, specify an existing journal file with -f or LEDGER_FILE.\n" exitFailure -- | Ensure there is a journal file at the given path, creating an empty one if needed. @@ -202,14 +202,14 @@ requireJournalFileExists f = do ensureJournalFileExists :: FilePath -> IO () ensureJournalFileExists f = do when (os/="mingw32" && isWindowsUnsafeDotPath f) $ do - hPrintf stderr "Part of file path %s\n ends with a dot, which is unsafe on Windows; please use a different path.\n" (show f) + hPutStr stderr $ "Part of file path \"" <> show f <> "\"\n ends with a dot, which is unsafe on Windows; please use a different path.\n" exitFailure exists <- doesFileExist f when (not exists) $ do - hPrintf stderr "Creating hledger journal file %s.\n" f + hPutStr stderr $ "Creating hledger journal file " <> show f <> ".\n" -- note Hledger.Utils.UTF8.* do no line ending conversion on windows, -- we currently require unix line endings on all platforms. - newJournalContent >>= writeFile f + newJournalContent >>= T.writeFile f -- | Does any part of this path contain non-. characters and end with a . ? -- Such paths are not safe to use on Windows (cf #1056). @@ -221,10 +221,10 @@ isWindowsUnsafeDotPath = splitDirectories -- | Give the content for a new auto-created journal file. -newJournalContent :: IO String +newJournalContent :: IO Text newJournalContent = do d <- getCurrentDay - return $ printf "; journal created %s by hledger\n" (show d) + return $ "; journal created " <> T.pack (show d) <> " by hledger\n" -- A "LatestDates" is zero or more copies of the same date, -- representing the latest transaction date read from a file, @@ -240,7 +240,7 @@ latestDates = headDef [] . take 1 . group . reverse . sort -- | Remember that these transaction dates were the latest seen when -- reading this journal file. saveLatestDates :: LatestDates -> FilePath -> IO () -saveLatestDates dates f = writeFile (latestDatesFileFor f) $ unlines $ map showDate dates +saveLatestDates dates f = T.writeFile (latestDatesFileFor f) $ T.unlines $ map showDate dates -- | What were the latest transaction dates seen the last time this -- journal file was read ? If there were multiple transactions on the diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index fffbf6635..dc4e07e4b 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -232,7 +232,7 @@ budgetReportAsText ropts@ReportOpts{..} budgetr = Just (AtThen _mc) -> error' unsupportedValueThenError -- PARTIAL: Just (AtEnd _mc) -> ", valued at period ends" Just (AtNow _mc) -> ", current value" - Just (AtDate d _mc) -> ", valued at "++showDate d + Just (AtDate d _mc) -> ", valued at " ++ T.unpack (showDate d) Nothing -> "") displayTableWithWidths :: Table String String ((Int, Int, Int), BudgetDisplayCell) @@ -299,7 +299,7 @@ budgetReportAsTable (T.Group NoLine $ map Header colheadings) (map rowvals rows) where - colheadings = map (reportPeriodName balancetype_ spans) spans + colheadings = map (T.unpack . reportPeriodName balancetype_ spans) spans ++ [" Total" | row_total_ ropts] ++ ["Average" | average_ ropts] @@ -332,7 +332,7 @@ budgetReportAsTable -- - all other balance change reports: a description of the datespan, -- abbreviated to compact form if possible (see showDateSpan). -- -reportPeriodName :: BalanceType -> [DateSpan] -> DateSpan -> String +reportPeriodName :: BalanceType -> [DateSpan] -> DateSpan -> T.Text reportPeriodName balancetype spans = case balancetype of PeriodChange -> if multiyear then showDateSpan else showDateSpanMonthAbbrev @@ -344,14 +344,14 @@ reportPeriodName balancetype spans = -- | Render a budget report as CSV. Like multiBalanceReportAsCsv, -- but includes alternating actual and budget amount columns. budgetReportAsCsv :: ReportOpts -> BudgetReport -> CSV -budgetReportAsCsv +budgetReportAsCsv ReportOpts{average_, row_total_, no_total_, transpose_} (PeriodicReport colspans items (PeriodicReportRow _ abtotals (magrandtot,mbgrandtot) (magrandavg,mbgrandavg))) = (if transpose_ then transpose else id) $ -- heading row - ("Account" : - concatMap (\span -> [showDateSpan span, "budget"]) colspans + ("Account" : + concatMap (\span -> [T.unpack $ showDateSpan span, "budget"]) colspans ++ concat [["Total" ,"budget"] | row_total_] ++ concat [["Average","budget"] | average_] ) : @@ -369,7 +369,7 @@ budgetReportAsCsv [ "Total:" : map showmamt (flattentuples abtotals) - ++ concat [[showmamt magrandtot,showmamt mbgrandtot] | row_total_] + ++ concat [[showmamt magrandtot,showmamt mbgrandtot] | row_total_] ++ concat [[showmamt magrandavg,showmamt mbgrandavg] | average_] ] | not no_total_ diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index f41de8f79..294375f39 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -88,7 +88,7 @@ rsInit d reset ui@UIState{aopts=_uopts@UIOpts{cliopts_=CliOpts{reportspec_=rspec displayitems = map displayitem items' where displayitem (t, _, _issplit, otheracctsstr, change, bal) = - RegisterScreenItem{rsItemDate = showDate $ transactionRegisterDate q thisacctq t + RegisterScreenItem{rsItemDate = T.unpack . showDate $ transactionRegisterDate q thisacctq t ,rsItemStatus = tstatus t ,rsItemDescription = T.unpack $ tdescription t ,rsItemOtherAccounts = T.unpack otheracctsstr diff --git a/hledger-ui/Hledger/UI/UIUtils.hs b/hledger-ui/Hledger/UI/UIUtils.hs index bc5d17d5d..ad1808438 100644 --- a/hledger-ui/Hledger/UI/UIUtils.hs +++ b/hledger-ui/Hledger/UI/UIUtils.hs @@ -38,6 +38,7 @@ import Data.List #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif +import qualified Data.Text as T import Graphics.Vty (Event(..),Key(..),Modifier(..),Vty(..),Color,Attr,currentAttr,refresh -- ,Output(displayBounds,mkDisplayContext),DisplayContext(..) @@ -189,7 +190,7 @@ borderDepthStr (Just d) = str " to depth " <+> withAttr ("border" <> "query") (s borderPeriodStr :: String -> Period -> Widget Name borderPeriodStr _ PeriodAll = str "" -borderPeriodStr preposition p = str (" "++preposition++" ") <+> withAttr ("border" <> "query") (str $ showPeriod p) +borderPeriodStr preposition p = str (" "++preposition++" ") <+> withAttr ("border" <> "query") (str . T.unpack $ showPeriod p) borderKeysStr :: [(String,String)] -> Widget Name borderKeysStr = borderKeysStr' . map (\(a,b) -> (a, str b)) diff --git a/hledger/Hledger/Cli/Commands/Add.hs b/hledger/Hledger/Cli/Commands/Add.hs index e2068ed99..afda925b5 100644 --- a/hledger/Hledger/Cli/Commands/Add.hs +++ b/hledger/Hledger/Cli/Commands/Add.hs @@ -267,7 +267,7 @@ similarTransaction EntryState{..} desc = in bestmatch dateAndCodeWizard PrevInput{..} EntryState{..} = do - let def = headDef (showDate esDefDate) esArgs + let def = headDef (T.unpack $ showDate esDefDate) esArgs retryMsg "A valid hledger smart date is required. Eg: 2014/2/14, 14, yesterday." $ parser (parseSmartDateAndCode esToday) $ withCompletion (dateCompleter def) $ diff --git a/hledger/Hledger/Cli/Commands/Aregister.hs b/hledger/Hledger/Cli/Commands/Aregister.hs index 41520b3d4..c32443891 100644 --- a/hledger/Hledger/Cli/Commands/Aregister.hs +++ b/hledger/Hledger/Cli/Commands/Aregister.hs @@ -133,7 +133,7 @@ accountTransactionsReportItemAsCsvRecord = [idx,date,code,desc,T.unpack otheracctsstr,amt,bal] where idx = show tindex - date = showDate $ transactionRegisterDate reportq thisacctq t + date = T.unpack . showDate $ transactionRegisterDate reportq thisacctq t code = T.unpack tcode desc = T.unpack tdescription amt = showMixedAmountOneLineWithoutPrice False change @@ -199,7 +199,7 @@ accountTransactionsReportItemAsText where -- calculate widths (totalwidth,mdescwidth) = registerWidthsFromOpts copts - (datewidth, date) = (10, T.pack . showDate $ transactionRegisterDate reportq thisacctq t) + (datewidth, date) = (10, showDate $ transactionRegisterDate reportq thisacctq t) (amtwidth, balwidth) | shortfall <= 0 = (preferredamtwidth, preferredbalwidth) | otherwise = (adjustedamtwidth, adjustedbalwidth) diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 775741f97..79c454383 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -446,7 +446,7 @@ multiBalanceReportAsCsv :: ReportOpts -> MultiBalanceReport -> CSV multiBalanceReportAsCsv opts@ReportOpts{average_, row_total_} (PeriodicReport colspans items (PeriodicReportRow _ coltotals tot avg)) = maybetranspose $ - ("Account" : map showDateSpan colspans + ("Account" : map (T.unpack . showDateSpan) colspans ++ ["Total" | row_total_] ++ ["Average" | average_] ) : @@ -561,7 +561,7 @@ multiBalanceReportHtmlFootRow ropts (acct:rest) = -- | Render a multi-column balance report as plain text suitable for console output. multiBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String multiBalanceReportAsText ropts@ReportOpts{..} r = - title ++ "\n\n" ++ (balanceReportTableAsText ropts $ balanceReportAsTable ropts r) + T.unpack title <> "\n\n" <> (balanceReportTableAsText ropts $ balanceReportAsTable ropts r) where title = mtitle <> " in " <> showDateSpan (periodicReportSpan r) <> valuationdesc <> ":" @@ -576,7 +576,7 @@ multiBalanceReportAsText ropts@ReportOpts{..} r = Just (AtEnd _mc) | changingValuation -> "" Just (AtEnd _mc) -> ", valued at period ends" Just (AtNow _mc) -> ", current value" - Just (AtDate d _mc) -> ", valued at "++showDate d + Just (AtDate d _mc) -> ", valued at " <> showDate d Nothing -> "" changingValuation = case (balancetype_, value_) of @@ -595,7 +595,7 @@ balanceReportAsTable opts@ReportOpts{average_, row_total_, balancetype_} (map rowvals items) where totalscolumn = row_total_ && balancetype_ `notElem` [CumulativeChange, HistoricalBalance] - colheadings = map (reportPeriodName balancetype_ spans) spans + colheadings = map (T.unpack . reportPeriodName balancetype_ spans) spans ++ [" Total" | totalscolumn] ++ ["Average" | average_] accts = map renderacct items diff --git a/hledger/Hledger/Cli/Commands/Print.hs b/hledger/Hledger/Cli/Commands/Print.hs index 9eee02cd4..0921a144e 100644 --- a/hledger/Hledger/Cli/Commands/Print.hs +++ b/hledger/Hledger/Cli/Commands/Print.hs @@ -156,8 +156,8 @@ transactionToCSV t = where idx = tindex t description = T.unpack $ tdescription t - date = showDate (tdate t) - date2 = maybe "" showDate (tdate2 t) + date = T.unpack $ showDate (tdate t) + date2 = maybe "" (T.unpack . showDate) (tdate2 t) status = show $ tstatus t code = T.unpack $ tcode t comment = chomp $ strip $ T.unpack $ tcomment t diff --git a/hledger/Hledger/Cli/Commands/Register.hs b/hledger/Hledger/Cli/Commands/Register.hs index 2f00d1f4b..9e93f3ef5 100644 --- a/hledger/Hledger/Cli/Commands/Register.hs +++ b/hledger/Hledger/Cli/Commands/Register.hs @@ -78,9 +78,9 @@ postingsReportItemAsCsvRecord :: PostingsReportItem -> CsvRecord postingsReportItemAsCsvRecord (_, _, _, p, b) = [idx,date,code,desc,acct,amt,bal] where idx = show $ maybe 0 tindex $ ptransaction p - date = showDate $ postingDate p -- XXX csv should show date2 with --date2 + date = T.unpack . showDate $ postingDate p -- XXX csv should show date2 with --date2 code = maybe "" (T.unpack . tcode) $ ptransaction p - desc = T.unpack $ maybe "" tdescription $ ptransaction p + desc = T.unpack . maybe "" tdescription $ ptransaction p acct = T.unpack . bracket $ paccount p where bracket = case ptype p of @@ -146,9 +146,9 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda -- calculate widths (totalwidth,mdescwidth) = registerWidthsFromOpts opts (datewidth, date) = case (mdate,menddate) of - (Just _, Just _) -> (21, T.pack $ showDateSpan (DateSpan mdate menddate)) + (Just _, Just _) -> (21, showDateSpan (DateSpan mdate menddate)) (Nothing, Just _) -> (21, "") - (Just d, Nothing) -> (10, T.pack $ showDate d) + (Just d, Nothing) -> (10, showDate d) _ -> (10, "") (amtwidth, balwidth) | shortfall <= 0 = (preferredamtwidth, preferredbalwidth) diff --git a/hledger/Hledger/Cli/Commands/Roi.hs b/hledger/Hledger/Cli/Commands/Roi.hs index 37d1e6ac8..c2be4d32c 100644 --- a/hledger/Hledger/Cli/Commands/Roi.hs +++ b/hledger/Hledger/Cli/Commands/Roi.hs @@ -118,12 +118,12 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec} j = do let smallIsZero x = if abs x < 0.01 then 0.0 else x return [ showDate spanBegin , showDate (addDays (-1) spanEnd) - , show valueBefore - , show cashFlowAmt - , show valueAfter - , show (valueAfter - (valueBefore + cashFlowAmt)) - , printf "%0.2f%%" $ smallIsZero irr - , printf "%0.2f%%" $ smallIsZero twr ] + , T.pack $ show valueBefore + , T.pack $ show cashFlowAmt + , T.pack $ show valueAfter + , T.pack $ show (valueAfter - (valueBefore + cashFlowAmt)) + , T.pack $ printf "%0.2f%%" $ smallIsZero irr + , T.pack $ printf "%0.2f%%" $ smallIsZero twr ] let table = Table (Tbl.Group NoLine (map (Header . show) (take (length tableBody) [1..]))) @@ -133,7 +133,7 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec} j = do , Tbl.Group SingleLine [Header "IRR", Header "TWR"]]) tableBody - putStrLn $ Ascii.render prettyTables id id id table + putStrLn $ Ascii.render prettyTables id id T.unpack table timeWeightedReturn showCashFlow prettyTables investmentsQuery trans (OneSpan spanBegin spanEnd valueBefore valueAfter cashFlow pnl) = do let initialUnitPrice = 100 @@ -196,7 +196,7 @@ timeWeightedReturn showCashFlow prettyTables investmentsQuery trans (OneSpan spa unitBalances = add initialUnits unitBalances' valuesOnDate = add 0 valuesOnDate' - putStr $ Ascii.render prettyTables id id id + putStr $ Ascii.render prettyTables T.unpack id id (Table (Tbl.Group NoLine (map (Header . showDate) dates)) (Tbl.Group DoubleLine [ Tbl.Group SingleLine [Header "Portfolio value", Header "Unit balance"] @@ -226,7 +226,7 @@ internalRateOfReturn showCashFlow prettyTables (OneSpan spanBegin spanEnd valueB when showCashFlow $ do printf "\nIRR cash flow for %s - %s\n" (showDate spanBegin) (showDate (addDays (-1) spanEnd)) let (dates, amounts) = unzip totalCF - putStrLn $ Ascii.render prettyTables id id id + putStrLn $ Ascii.render prettyTables T.unpack id id (Table (Tbl.Group NoLine (map (Header . showDate) dates)) (Tbl.Group SingleLine [Header "Amount"]) diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index f49284537..e50a586ac 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE OverloadedStrings, RecordWildCards, LambdaCase #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} {-| Common helpers for making multi-section balance report commands @@ -105,11 +107,11 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportspec_=r ropts' = ropts{balancetype_=balancetype} title = - cbctitle - ++ " " - ++ titledatestr - ++ maybe "" (' ':) mtitleclarification - ++ valuationdesc + T.pack cbctitle + <> " " + <> titledatestr + <> maybe "" (" "<>) mtitleclarification + <> valuationdesc where -- XXX #1078 the title of ending balance reports @@ -138,7 +140,7 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportspec_=r Just (AtEnd _mc) | changingValuation -> "" Just (AtEnd _mc) -> ", valued at period ends" Just (AtNow _mc) -> ", current value" - Just (AtDate today _mc) -> ", valued at "++showDate today + Just (AtDate today _mc) -> ", valued at " <> showDate today Nothing -> "" changingValuation = case (balancetype_, value_) of @@ -147,7 +149,7 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportspec_=r -- make a CompoundBalanceReport. cbr' = compoundBalanceReport rspec{rsOpts=ropts'} j cbcqueries - cbr = cbr'{cbrTitle=title} + cbr = cbr'{cbrTitle=T.unpack title} -- render appropriately render = case outputFormatFromOpts opts of @@ -160,14 +162,12 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportspec_=r -- | Summarise one or more (inclusive) end dates, in a way that's -- visually different from showDateSpan, suggesting discrete end dates -- rather than a continuous span. -showEndDates :: [Day] -> String +showEndDates :: [Day] -> T.Text showEndDates es = case es of -- cf showPeriod - (e:_:_) -> showdate e ++ ".." ++ showdate (last es) - [e] -> showdate e + (e:_:_) -> showDate e <> ".." <> showDate (last es) + [e] -> showDate e [] -> "" - where - showdate = show -- | Render a compound balance report as plain text suitable for console output. {- Eg: @@ -232,7 +232,7 @@ compoundBalanceReportAsCsv :: ReportOpts -> CompoundPeriodicReport DisplayName M compoundBalanceReportAsCsv ropts (CompoundPeriodicReport title colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg)) = addtotals $ padRow title : - ("Account" : + map T.unpack ("Account" : map showDateSpanMonthAbbrev colspans ++ (if row_total_ ropts then ["Total"] else []) ++ (if average_ ropts then ["Average"] else []) @@ -283,7 +283,7 @@ compoundBalanceReportAsHtml ropts cbr = ++ (if average_ ropts then ["Average"] else []) ] - thRow :: [String] -> Html () + thRow :: [T.Text] -> Html () thRow = tr_ . mconcat . map (th_ . toHtml) -- Make rows for a subreport: its title row, not the headings row,