slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lib,cli,ui: Use Text for showDate and related.

Browse Source
This commit is contained in:
Stephen Morgan 2020-11-05 12:58:04 +11:00
parent 74b296f865
commit e3ec01c3c6
15 changed files with 85 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
hledger-lib/Hledger/Data/Dates.hs
View File

@ -110,19 +110,19 @@ import Hledger.Utils
-- Help ppShow parse and line-wrap DateSpans better in debug output. -- Help ppShow parse and line-wrap DateSpans better in debug output.
instance Show DateSpan where instance Show DateSpan where
show s = "DateSpan " ++ showDateSpan s show s = "DateSpan " ++ T.unpack (showDateSpan s)
showDate :: Day -> String showDate :: Day -> Text
showDate = show showDate = T.pack . show
-- | Render a datespan as a display string, abbreviating into a -- | Render a datespan as a display string, abbreviating into a
-- compact form if possible. -- compact form if possible.
showDateSpan :: DateSpan -> String showDateSpan :: DateSpan -> Text
showDateSpan = showPeriod . dateSpanAsPeriod showDateSpan = showPeriod . dateSpanAsPeriod
-- | Like showDateSpan, but show month spans as just the abbreviated month name -- | Like showDateSpan, but show month spans as just the abbreviated month name
-- in the current locale. -- in the current locale.
showDateSpanMonthAbbrev :: DateSpan -> String showDateSpanMonthAbbrev :: DateSpan -> Text
showDateSpanMonthAbbrev = showPeriodMonthAbbrev . dateSpanAsPeriod showDateSpanMonthAbbrev = showPeriodMonthAbbrev . dateSpanAsPeriod
-- | Get the current local date. -- | 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 -- | Convert a smart date string to an explicit yyyy\/mm\/dd string using
-- the provided reference date, or raise an error. -- the provided reference date, or raise an error.
fixSmartDateStr :: Day -> Text -> String fixSmartDateStr :: Day -> Text -> Text
fixSmartDateStr d s = fixSmartDateStr d s =
either (error' . printf "could not parse date %s %s" (show s) . show) id $ -- PARTIAL: 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. -- | 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 d = fmap showDate . fixSmartDateStrEither' d
fixSmartDateStrEither' fixSmartDateStrEither'

24
hledger-lib/Hledger/Data/Period.hs
View File

@ -5,6 +5,8 @@ a richer abstraction than DateSpan. See also Types and Dates.
-} -}
{-# LANGUAGE OverloadedStrings #-}
module Hledger.Data.Period ( module Hledger.Data.Period (
periodAsDateSpan periodAsDateSpan
,dateSpanAsPeriod ,dateSpanAsPeriod
@ -30,6 +32,8 @@ module Hledger.Data.Period (
) )
where where
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Calendar import Data.Time.Calendar
import Data.Time.Calendar.MonthDay import Data.Time.Calendar.MonthDay
import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.OrdinalDate
@ -155,21 +159,23 @@ isStandardPeriod = isStandardPeriod' . simplifyPeriod
-- --
-- >>> showPeriod (WeekPeriod (fromGregorian 2016 7 25)) -- >>> showPeriod (WeekPeriod (fromGregorian 2016 7 25))
-- "2016-07-25W30" -- "2016-07-25W30"
showPeriod (DayPeriod b) = formatTime defaultTimeLocale "%F" b -- DATE showPeriod :: Period -> Text
showPeriod (WeekPeriod b) = formatTime defaultTimeLocale "%FW%V" b -- STARTDATEWYEARWEEK showPeriod (DayPeriod b) = T.pack $ formatTime defaultTimeLocale "%F" b -- DATE
showPeriod (MonthPeriod y m) = printf "%04d-%02d" y m -- YYYY-MM showPeriod (WeekPeriod b) = T.pack $ formatTime defaultTimeLocale "%FW%V" b -- STARTDATEWYEARWEEK
showPeriod (QuarterPeriod y q) = printf "%04dQ%d" y q -- YYYYQN showPeriod (MonthPeriod y m) = T.pack $ printf "%04d-%02d" y m -- YYYY-MM
showPeriod (YearPeriod y) = printf "%04d" y -- YYYY showPeriod (QuarterPeriod y q) = T.pack $ printf "%04dQ%d" y q -- YYYYQN
showPeriod (PeriodBetween b e) = formatTime defaultTimeLocale "%F" b 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 ++ formatTime defaultTimeLocale "..%F" (addDays (-1) e) -- STARTDATE..INCLUSIVEENDDATE
showPeriod (PeriodFrom b) = formatTime defaultTimeLocale "%F.." b -- STARTDATE.. showPeriod (PeriodFrom b) = T.pack $ formatTime defaultTimeLocale "%F.." b -- STARTDATE..
showPeriod (PeriodTo e) = formatTime defaultTimeLocale "..%F" (addDays (-1) e) -- ..INCLUSIVEENDDATE showPeriod (PeriodTo e) = T.pack $ formatTime defaultTimeLocale "..%F" (addDays (-1) e) -- ..INCLUSIVEENDDATE
showPeriod PeriodAll = ".." showPeriod PeriodAll = ".."
-- | Like showPeriod, but if it's a month period show just -- | Like showPeriod, but if it's a month period show just
-- the 3 letter month name abbreviation for the current locale. -- the 3 letter month name abbreviation for the current locale.
showPeriodMonthAbbrev :: Period -> Text
showPeriodMonthAbbrev (MonthPeriod _ m) -- Jan 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 where monthnames = months defaultTimeLocale
showPeriodMonthAbbrev p = showPeriod p showPeriodMonthAbbrev p = showPeriod p

2
hledger-lib/Hledger/Data/Transaction.hs
View File

@ -174,7 +174,7 @@ showTransactionHelper onelineamounts t =
++ [""] ++ [""]
where where
descriptionline = T.stripEnd $ T.concat [date, status, code, desc, samelinecomment] 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 = " *" status | tstatus t == Cleared = " *"
| tstatus t == Pending = " !" | tstatus t == Pending = " !"
| otherwise = "" | otherwise = ""

6
hledger-lib/Hledger/Data/TransactionModifier.hs
View File

@ -26,7 +26,7 @@ import Hledger.Data.Amount
import Hledger.Data.Transaction import Hledger.Data.Transaction
import Hledger.Query import Hledger.Query
import Hledger.Data.Posting (commentJoin, commentAddTag) import Hledger.Data.Posting (commentJoin, commentAddTag)
import Hledger.Utils.Debug import Hledger.Utils
-- $setup -- $setup
-- >>> :set -XOverloadedStrings -- >>> :set -XOverloadedStrings
@ -137,7 +137,7 @@ postingRuleMultiplier p =
renderPostingCommentDates :: Posting -> Posting renderPostingCommentDates :: Posting -> Posting
renderPostingCommentDates p = p { pcomment = comment' } renderPostingCommentDates p = p { pcomment = comment' }
where 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' comment'
| T.null dates = pcomment p | T.null dates = pcomment p
| otherwise = ("[" <> dates <> "]") `commentJoin` pcomment p | otherwise = (wrap "[" "]" dates) `commentJoin` pcomment p

22
hledger-lib/Hledger/Read.hs
View File

@ -56,6 +56,7 @@ import Data.Ord (comparing)
import Data.Semigroup (sconcat) import Data.Semigroup (sconcat)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Time (Day) import Data.Time (Day)
import Safe (headDef) import Safe (headDef)
import System.Directory (doesFileExist, getHomeDirectory) import System.Directory (doesFileExist, getHomeDirectory)
@ -63,8 +64,7 @@ import System.Environment (getEnv)
import System.Exit (exitFailure) import System.Exit (exitFailure)
import System.FilePath ((<.>), (</>), splitDirectories, splitFileName) import System.FilePath ((<.>), (</>), splitDirectories, splitFileName)
import System.Info (os) import System.Info (os)
import System.IO (stderr, writeFile) import System.IO (hPutStr, stderr)
import Text.Printf (hPrintf, printf)
import Hledger.Data.Dates (getCurrentDay, parsedateM, showDate) import Hledger.Data.Dates (getCurrentDay, parsedateM, showDate)
import Hledger.Data.Types import Hledger.Data.Types
@ -191,9 +191,9 @@ requireJournalFileExists "-" = return ()
requireJournalFileExists f = do requireJournalFileExists f = do
exists <- doesFileExist f exists <- doesFileExist f
when (not exists) $ do -- XXX might not be a journal file when (not exists) $ do -- XXX might not be a journal file
hPrintf stderr "The hledger journal file \"%s\" was not found.\n" f hPutStr stderr $ "The hledger journal file \"" <> show f <> "\" was not found.\n"
hPrintf stderr "Please create it first, eg with \"hledger add\" or a text editor.\n" hPutStr 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 "Or, specify an existing journal file with -f or LEDGER_FILE.\n"
exitFailure exitFailure
-- | Ensure there is a journal file at the given path, creating an empty one if needed. -- | 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 :: FilePath -> IO ()
ensureJournalFileExists f = do ensureJournalFileExists f = do
when (os/="mingw32" && isWindowsUnsafeDotPath 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 exitFailure
exists <- doesFileExist f exists <- doesFileExist f
when (not exists) $ do 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, -- note Hledger.Utils.UTF8.* do no line ending conversion on windows,
-- we currently require unix line endings on all platforms. -- 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 . ? -- | Does any part of this path contain non-. characters and end with a . ?
-- Such paths are not safe to use on Windows (cf #1056). -- Such paths are not safe to use on Windows (cf #1056).
@ -221,10 +221,10 @@ isWindowsUnsafeDotPath =
splitDirectories splitDirectories
-- | Give the content for a new auto-created journal file. -- | Give the content for a new auto-created journal file.
newJournalContent :: IO String newJournalContent :: IO Text
newJournalContent = do newJournalContent = do
d <- getCurrentDay 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, -- A "LatestDates" is zero or more copies of the same date,
-- representing the latest transaction date read from a file, -- 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 -- | Remember that these transaction dates were the latest seen when
-- reading this journal file. -- reading this journal file.
saveLatestDates :: LatestDates -> FilePath -> IO () 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 -- | What were the latest transaction dates seen the last time this
-- journal file was read ? If there were multiple transactions on the -- journal file was read ? If there were multiple transactions on the

8
hledger-lib/Hledger/Reports/BudgetReport.hs
View File

@ -232,7 +232,7 @@ budgetReportAsText ropts@ReportOpts{..} budgetr =
Just (AtThen _mc) -> error' unsupportedValueThenError -- PARTIAL: Just (AtThen _mc) -> error' unsupportedValueThenError -- PARTIAL:
Just (AtEnd _mc) -> ", valued at period ends" Just (AtEnd _mc) -> ", valued at period ends"
Just (AtNow _mc) -> ", current value" Just (AtNow _mc) -> ", current value"
Just (AtDate d _mc) -> ", valued at "++showDate d Just (AtDate d _mc) -> ", valued at " ++ T.unpack (showDate d)
Nothing -> "") Nothing -> "")
displayTableWithWidths :: Table String String ((Int, Int, Int), BudgetDisplayCell) displayTableWithWidths :: Table String String ((Int, Int, Int), BudgetDisplayCell)
@ -299,7 +299,7 @@ budgetReportAsTable
(T.Group NoLine $ map Header colheadings) (T.Group NoLine $ map Header colheadings)
(map rowvals rows) (map rowvals rows)
where where
colheadings = map (reportPeriodName balancetype_ spans) spans colheadings = map (T.unpack . reportPeriodName balancetype_ spans) spans
++ [" Total" | row_total_ ropts] ++ [" Total" | row_total_ ropts]
++ ["Average" | average_ ropts] ++ ["Average" | average_ ropts]
@ -332,7 +332,7 @@ budgetReportAsTable
-- - all other balance change reports: a description of the datespan, -- - all other balance change reports: a description of the datespan,
-- abbreviated to compact form if possible (see showDateSpan). -- abbreviated to compact form if possible (see showDateSpan).
-- --
reportPeriodName :: BalanceType -> [DateSpan] -> DateSpan -> String reportPeriodName :: BalanceType -> [DateSpan] -> DateSpan -> T.Text
reportPeriodName balancetype spans = reportPeriodName balancetype spans =
case balancetype of case balancetype of
PeriodChange -> if multiyear then showDateSpan else showDateSpanMonthAbbrev PeriodChange -> if multiyear then showDateSpan else showDateSpanMonthAbbrev
@ -351,7 +351,7 @@ budgetReportAsCsv
-- heading row -- heading row
("Account" : ("Account" :
concatMap (\span -> [showDateSpan span, "budget"]) colspans concatMap (\span -> [T.unpack $ showDateSpan span, "budget"]) colspans
++ concat [["Total" ,"budget"] | row_total_] ++ concat [["Total" ,"budget"] | row_total_]
++ concat [["Average","budget"] | average_] ++ concat [["Average","budget"] | average_]
) : ) :

2
hledger-ui/Hledger/UI/RegisterScreen.hs
View File

@ -88,7 +88,7 @@ rsInit d reset ui@UIState{aopts=_uopts@UIOpts{cliopts_=CliOpts{reportspec_=rspec
displayitems = map displayitem items' displayitems = map displayitem items'
where where
displayitem (t, _, _issplit, otheracctsstr, change, bal) = 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 ,rsItemStatus = tstatus t
,rsItemDescription = T.unpack $ tdescription t ,rsItemDescription = T.unpack $ tdescription t
,rsItemOtherAccounts = T.unpack otheracctsstr ,rsItemOtherAccounts = T.unpack otheracctsstr

3
hledger-ui/Hledger/UI/UIUtils.hs
View File

@ -38,6 +38,7 @@ import Data.List
#if !(MIN_VERSION_base(4,11,0)) #if !(MIN_VERSION_base(4,11,0))
import Data.Monoid import Data.Monoid
#endif #endif
import qualified Data.Text as T
import Graphics.Vty import Graphics.Vty
(Event(..),Key(..),Modifier(..),Vty(..),Color,Attr,currentAttr,refresh (Event(..),Key(..),Modifier(..),Vty(..),Color,Attr,currentAttr,refresh
-- ,Output(displayBounds,mkDisplayContext),DisplayContext(..) -- ,Output(displayBounds,mkDisplayContext),DisplayContext(..)
@ -189,7 +190,7 @@ borderDepthStr (Just d) = str " to depth " <+> withAttr ("border" <> "query") (s
borderPeriodStr :: String -> Period -> Widget Name borderPeriodStr :: String -> Period -> Widget Name
borderPeriodStr _ PeriodAll = str "" 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 :: [(String,String)] -> Widget Name
borderKeysStr = borderKeysStr' . map (\(a,b) -> (a, str b)) borderKeysStr = borderKeysStr' . map (\(a,b) -> (a, str b))

2
hledger/Hledger/Cli/Commands/Add.hs
View File

@ -267,7 +267,7 @@ similarTransaction EntryState{..} desc =
in bestmatch in bestmatch
dateAndCodeWizard PrevInput{..} EntryState{..} = do 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." $ retryMsg "A valid hledger smart date is required. Eg: 2014/2/14, 14, yesterday." $
parser (parseSmartDateAndCode esToday) $ parser (parseSmartDateAndCode esToday) $
withCompletion (dateCompleter def) $ withCompletion (dateCompleter def) $

4
hledger/Hledger/Cli/Commands/Aregister.hs
View File

@ -133,7 +133,7 @@ accountTransactionsReportItemAsCsvRecord
= [idx,date,code,desc,T.unpack otheracctsstr,amt,bal] = [idx,date,code,desc,T.unpack otheracctsstr,amt,bal]
where where
idx = show tindex idx = show tindex
date = showDate $ transactionRegisterDate reportq thisacctq t date = T.unpack . showDate $ transactionRegisterDate reportq thisacctq t
code = T.unpack tcode code = T.unpack tcode
desc = T.unpack tdescription desc = T.unpack tdescription
amt = showMixedAmountOneLineWithoutPrice False change amt = showMixedAmountOneLineWithoutPrice False change
@ -199,7 +199,7 @@ accountTransactionsReportItemAsText
where where
-- calculate widths -- calculate widths
(totalwidth,mdescwidth) = registerWidthsFromOpts copts (totalwidth,mdescwidth) = registerWidthsFromOpts copts
(datewidth, date) = (10, T.pack . showDate $ transactionRegisterDate reportq thisacctq t) (datewidth, date) = (10, showDate $ transactionRegisterDate reportq thisacctq t)
(amtwidth, balwidth) (amtwidth, balwidth)
| shortfall <= 0 = (preferredamtwidth, preferredbalwidth) | shortfall <= 0 = (preferredamtwidth, preferredbalwidth)
| otherwise = (adjustedamtwidth, adjustedbalwidth) | otherwise = (adjustedamtwidth, adjustedbalwidth)

8
hledger/Hledger/Cli/Commands/Balance.hs
View File

@ -446,7 +446,7 @@ multiBalanceReportAsCsv :: ReportOpts -> MultiBalanceReport -> CSV
multiBalanceReportAsCsv opts@ReportOpts{average_, row_total_} multiBalanceReportAsCsv opts@ReportOpts{average_, row_total_}
(PeriodicReport colspans items (PeriodicReportRow _ coltotals tot avg)) = (PeriodicReport colspans items (PeriodicReportRow _ coltotals tot avg)) =
maybetranspose $ maybetranspose $
("Account" : map showDateSpan colspans ("Account" : map (T.unpack . showDateSpan) colspans
++ ["Total" | row_total_] ++ ["Total" | row_total_]
++ ["Average" | average_] ++ ["Average" | average_]
) : ) :
@ -561,7 +561,7 @@ multiBalanceReportHtmlFootRow ropts (acct:rest) =
-- | Render a multi-column balance report as plain text suitable for console output. -- | Render a multi-column balance report as plain text suitable for console output.
multiBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String multiBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String
multiBalanceReportAsText ropts@ReportOpts{..} r = multiBalanceReportAsText ropts@ReportOpts{..} r =
title ++ "\n\n" ++ (balanceReportTableAsText ropts $ balanceReportAsTable ropts r) T.unpack title <> "\n\n" <> (balanceReportTableAsText ropts $ balanceReportAsTable ropts r)
where where
title = mtitle <> " in " <> showDateSpan (periodicReportSpan r) <> valuationdesc <> ":" title = mtitle <> " in " <> showDateSpan (periodicReportSpan r) <> valuationdesc <> ":"
@ -576,7 +576,7 @@ multiBalanceReportAsText ropts@ReportOpts{..} r =
Just (AtEnd _mc) | changingValuation -> "" Just (AtEnd _mc) | changingValuation -> ""
Just (AtEnd _mc) -> ", valued at period ends" Just (AtEnd _mc) -> ", valued at period ends"
Just (AtNow _mc) -> ", current value" Just (AtNow _mc) -> ", current value"
Just (AtDate d _mc) -> ", valued at "++showDate d Just (AtDate d _mc) -> ", valued at " <> showDate d
Nothing -> "" Nothing -> ""
changingValuation = case (balancetype_, value_) of changingValuation = case (balancetype_, value_) of
@ -595,7 +595,7 @@ balanceReportAsTable opts@ReportOpts{average_, row_total_, balancetype_}
(map rowvals items) (map rowvals items)
where where
totalscolumn = row_total_ && balancetype_ `notElem` [CumulativeChange, HistoricalBalance] totalscolumn = row_total_ && balancetype_ `notElem` [CumulativeChange, HistoricalBalance]
colheadings = map (reportPeriodName balancetype_ spans) spans colheadings = map (T.unpack . reportPeriodName balancetype_ spans) spans
++ [" Total" | totalscolumn] ++ [" Total" | totalscolumn]
++ ["Average" | average_] ++ ["Average" | average_]
accts = map renderacct items accts = map renderacct items

4
hledger/Hledger/Cli/Commands/Print.hs
View File

@ -156,8 +156,8 @@ transactionToCSV t =
where where
idx = tindex t idx = tindex t
description = T.unpack $ tdescription t description = T.unpack $ tdescription t
date = showDate (tdate t) date = T.unpack $ showDate (tdate t)
date2 = maybe "" showDate (tdate2 t) date2 = maybe "" (T.unpack . showDate) (tdate2 t)
status = show $ tstatus t status = show $ tstatus t
code = T.unpack $ tcode t code = T.unpack $ tcode t
comment = chomp $ strip $ T.unpack $ tcomment t comment = chomp $ strip $ T.unpack $ tcomment t

8
hledger/Hledger/Cli/Commands/Register.hs
View File

@ -78,9 +78,9 @@ postingsReportItemAsCsvRecord :: PostingsReportItem -> CsvRecord
postingsReportItemAsCsvRecord (_, _, _, p, b) = [idx,date,code,desc,acct,amt,bal] postingsReportItemAsCsvRecord (_, _, _, p, b) = [idx,date,code,desc,acct,amt,bal]
where where
idx = show $ maybe 0 tindex $ ptransaction p 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 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 acct = T.unpack . bracket $ paccount p
where where
bracket = case ptype p of bracket = case ptype p of
@ -146,9 +146,9 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda
-- calculate widths -- calculate widths
(totalwidth,mdescwidth) = registerWidthsFromOpts opts (totalwidth,mdescwidth) = registerWidthsFromOpts opts
(datewidth, date) = case (mdate,menddate) of (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, "") (Nothing, Just _) -> (21, "")
(Just d, Nothing) -> (10, T.pack $ showDate d) (Just d, Nothing) -> (10, showDate d)
_ -> (10, "") _ -> (10, "")
(amtwidth, balwidth) (amtwidth, balwidth)
| shortfall <= 0 = (preferredamtwidth, preferredbalwidth) | shortfall <= 0 = (preferredamtwidth, preferredbalwidth)

18
hledger/Hledger/Cli/Commands/Roi.hs
View File

@ -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 let smallIsZero x = if abs x < 0.01 then 0.0 else x
return [ showDate spanBegin return [ showDate spanBegin
, showDate (addDays (-1) spanEnd) , showDate (addDays (-1) spanEnd)
, show valueBefore , T.pack $ show valueBefore
, show cashFlowAmt , T.pack $ show cashFlowAmt
, show valueAfter , T.pack $ show valueAfter
, show (valueAfter - (valueBefore + cashFlowAmt)) , T.pack $ show (valueAfter - (valueBefore + cashFlowAmt))
, printf "%0.2f%%" $ smallIsZero irr , T.pack $ printf "%0.2f%%" $ smallIsZero irr
, printf "%0.2f%%" $ smallIsZero twr ] , T.pack $ printf "%0.2f%%" $ smallIsZero twr ]
let table = Table let table = Table
(Tbl.Group NoLine (map (Header . show) (take (length tableBody) [1..]))) (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"]]) , Tbl.Group SingleLine [Header "IRR", Header "TWR"]])
tableBody 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 timeWeightedReturn showCashFlow prettyTables investmentsQuery trans (OneSpan spanBegin spanEnd valueBefore valueAfter cashFlow pnl) = do
let initialUnitPrice = 100 let initialUnitPrice = 100
@ -196,7 +196,7 @@ timeWeightedReturn showCashFlow prettyTables investmentsQuery trans (OneSpan spa
unitBalances = add initialUnits unitBalances' unitBalances = add initialUnits unitBalances'
valuesOnDate = add 0 valuesOnDate' valuesOnDate = add 0 valuesOnDate'
putStr $ Ascii.render prettyTables id id id putStr $ Ascii.render prettyTables T.unpack id id
(Table (Table
(Tbl.Group NoLine (map (Header . showDate) dates)) (Tbl.Group NoLine (map (Header . showDate) dates))
(Tbl.Group DoubleLine [ Tbl.Group SingleLine [Header "Portfolio value", Header "Unit balance"] (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 when showCashFlow $ do
printf "\nIRR cash flow for %s - %s\n" (showDate spanBegin) (showDate (addDays (-1) spanEnd)) printf "\nIRR cash flow for %s - %s\n" (showDate spanBegin) (showDate (addDays (-1) spanEnd))
let (dates, amounts) = unzip totalCF let (dates, amounts) = unzip totalCF
putStrLn $ Ascii.render prettyTables id id id putStrLn $ Ascii.render prettyTables T.unpack id id
(Table (Table
(Tbl.Group NoLine (map (Header . showDate) dates)) (Tbl.Group NoLine (map (Header . showDate) dates))
(Tbl.Group SingleLine [Header "Amount"]) (Tbl.Group SingleLine [Header "Amount"])

30
hledger/Hledger/Cli/CompoundBalanceCommand.hs
View File

@ -1,4 +1,6 @@
{-# LANGUAGE OverloadedStrings, RecordWildCards, LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-| {-|
Common helpers for making multi-section balance report commands Common helpers for making multi-section balance report commands
@ -105,11 +107,11 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportspec_=r
ropts' = ropts{balancetype_=balancetype} ropts' = ropts{balancetype_=balancetype}
title = title =
cbctitle T.pack cbctitle
++ " " <> " "
++ titledatestr <> titledatestr
++ maybe "" (' ':) mtitleclarification <> maybe "" (" "<>) mtitleclarification
++ valuationdesc <> valuationdesc
where where
-- XXX #1078 the title of ending balance reports -- 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) | changingValuation -> ""
Just (AtEnd _mc) -> ", valued at period ends" Just (AtEnd _mc) -> ", valued at period ends"
Just (AtNow _mc) -> ", current value" Just (AtNow _mc) -> ", current value"
Just (AtDate today _mc) -> ", valued at "++showDate today Just (AtDate today _mc) -> ", valued at " <> showDate today
Nothing -> "" Nothing -> ""
changingValuation = case (balancetype_, value_) of changingValuation = case (balancetype_, value_) of
@ -147,7 +149,7 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportspec_=r
-- make a CompoundBalanceReport. -- make a CompoundBalanceReport.
cbr' = compoundBalanceReport rspec{rsOpts=ropts'} j cbcqueries cbr' = compoundBalanceReport rspec{rsOpts=ropts'} j cbcqueries
cbr = cbr'{cbrTitle=title} cbr = cbr'{cbrTitle=T.unpack title}
-- render appropriately -- render appropriately
render = case outputFormatFromOpts opts of 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 -- | Summarise one or more (inclusive) end dates, in a way that's
-- visually different from showDateSpan, suggesting discrete end dates -- visually different from showDateSpan, suggesting discrete end dates
-- rather than a continuous span. -- rather than a continuous span.
showEndDates :: [Day] -> String showEndDates :: [Day] -> T.Text
showEndDates es = case es of showEndDates es = case es of
-- cf showPeriod -- cf showPeriod
(e:_:_) -> showdate e ++ ".." ++ showdate (last es) (e:_:_) -> showDate e <> ".." <> showDate (last es)
[e] -> showdate e [e] -> showDate e
[] -> "" [] -> ""
where
showdate = show
-- | Render a compound balance report as plain text suitable for console output. -- | Render a compound balance report as plain text suitable for console output.
{- Eg: {- Eg:
@ -232,7 +232,7 @@ compoundBalanceReportAsCsv :: ReportOpts -> CompoundPeriodicReport DisplayName M
compoundBalanceReportAsCsv ropts (CompoundPeriodicReport title colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg)) = compoundBalanceReportAsCsv ropts (CompoundPeriodicReport title colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg)) =
addtotals $ addtotals $
padRow title : padRow title :
("Account" : map T.unpack ("Account" :
map showDateSpanMonthAbbrev colspans map showDateSpanMonthAbbrev colspans
++ (if row_total_ ropts then ["Total"] else []) ++ (if row_total_ ropts then ["Total"] else [])
++ (if average_ ropts then ["Average"] else []) ++ (if average_ ropts then ["Average"] else [])
@ -283,7 +283,7 @@ compoundBalanceReportAsHtml ropts cbr =
++ (if average_ ropts then ["Average"] else []) ++ (if average_ ropts then ["Average"] else [])
] ]
thRow :: [String] -> Html () thRow :: [T.Text] -> Html ()
thRow = tr_ . mconcat . map (th_ . toHtml) thRow = tr_ . mconcat . map (th_ . toHtml)
-- Make rows for a subreport: its title row, not the headings row, -- Make rows for a subreport: its title row, not the headings row,