lib,cli,ui: Use Text for showDate and related.
This commit is contained in:
		
							parent
							
								
									74b296f865
								
							
						
					
					
						commit
						e3ec01c3c6
					
				| @ -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' | ||||
|  | ||||
| @ -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 | ||||
| 
 | ||||
|  | ||||
| @ -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            = "" | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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_ | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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)) | ||||
|  | ||||
| @ -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) $ | ||||
|  | ||||
| @ -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) | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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) | ||||
|  | ||||
| @ -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"]) | ||||
|  | ||||
| @ -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, | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user