diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index d883f562c..c9fdee2fd 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -895,7 +895,7 @@ checkBalanceAssertionOneCommodityB p@Posting{paccount=assertedacct} assertedamt Nothing -> "?" -- shouldn't happen Just t -> printf "%s\ntransaction:\n%s" (showGenericSourcePos pos) - (chomp $ showTransaction t) + (textChomp $ showTransaction t) :: String where pos = baposition $ fromJust $ pbalanceassertion p @@ -926,11 +926,11 @@ checkIllegalBalanceAssignmentB p = do checkBalanceAssignmentPostingDateB :: Posting -> Balancing s () checkBalanceAssignmentPostingDateB p = when (hasBalanceAssignment p && isJust (pdate p)) $ - throwError $ unlines $ + throwError . T.unpack $ T.unlines ["postings which are balance assignments may not have a custom date." ,"Please write the posting amount explicitly, or remove the posting date:" ,"" - ,maybe (unlines $ showPostingLines p) showTransaction $ ptransaction p + ,maybe (T.unlines $ showPostingLines p) showTransaction $ ptransaction p ] -- | Throw an error if this posting is trying to do a balance assignment and @@ -940,16 +940,16 @@ checkBalanceAssignmentUnassignableAccountB :: Posting -> Balancing s () checkBalanceAssignmentUnassignableAccountB p = do unassignable <- R.asks bsUnassignable when (hasBalanceAssignment p && paccount p `S.member` unassignable) $ - throwError $ unlines $ + throwError . T.unpack $ T.unlines ["balance assignments cannot be used with accounts which are" ,"posted to by transaction modifier rules (auto postings)." ,"Please write the posting amount explicitly, or remove the rule." ,"" - ,"account: "++T.unpack (paccount p) + ,"account: " <> paccount p ,"" ,"transaction:" ,"" - ,maybe (unlines $ showPostingLines p) showTransaction $ ptransaction p + ,maybe (T.unlines $ showPostingLines p) showTransaction $ ptransaction p ] -- diff --git a/hledger-lib/Hledger/Data/PeriodicTransaction.hs b/hledger-lib/Hledger/Data/PeriodicTransaction.hs index 57487be00..44472f173 100644 --- a/hledger-lib/Hledger/Data/PeriodicTransaction.hs +++ b/hledger-lib/Hledger/Data/PeriodicTransaction.hs @@ -16,6 +16,7 @@ where import Data.Semigroup ((<>)) #endif import qualified Data.Text as T +import qualified Data.Text.IO as T import Text.Printf import Hledger.Data.Types @@ -40,7 +41,7 @@ _ptgen str = do case checkPeriodicTransactionStartDate i s t of Just e -> error' e -- PARTIAL: Nothing -> - mapM_ (putStr . showTransaction) $ + mapM_ (T.putStr . showTransaction) $ runPeriodicTransaction nullperiodictransaction{ ptperiodexpr=t , ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1] } nulldatespan @@ -52,7 +53,7 @@ _ptgenspan str span = do case checkPeriodicTransactionStartDate i s t of Just e -> error' e -- PARTIAL: Nothing -> - mapM_ (putStr . showTransaction) $ + mapM_ (T.putStr . showTransaction) $ runPeriodicTransaction nullperiodictransaction{ ptperiodexpr=t , ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1] } span diff --git a/hledger-lib/Hledger/Data/Timeclock.hs b/hledger-lib/Hledger/Data/Timeclock.hs index 1cf164397..06072df9b 100644 --- a/hledger-lib/Hledger/Data/Timeclock.hs +++ b/hledger-lib/Hledger/Data/Timeclock.hs @@ -90,8 +90,8 @@ errorWithSourceLine line msg = error $ "line " ++ show line ++ ": " ++ msg entryFromTimeclockInOut :: TimeclockEntry -> TimeclockEntry -> Transaction entryFromTimeclockInOut i o | otime >= itime = t - | otherwise = - error' $ "clock-out time less than clock-in time in:\n" ++ showTransaction t -- PARTIAL: + | otherwise = error' . T.unpack $ + "clock-out time less than clock-in time in:\n" <> showTransaction t -- PARTIAL: where t = Transaction { tindex = 0, diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 18f4ccf01..ab367dbc2 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -63,7 +63,6 @@ import Data.Maybe import Data.Text (Text) import qualified Data.Text as T import Data.Time.Calendar -import Text.Printf import qualified Data.Map as M import Hledger.Utils @@ -148,53 +147,54 @@ To facilitate this, postings with explicit multi-commodity amounts are displayed as multiple similar postings, one per commodity. (Normally does not happen with this function). -} -showTransaction :: Transaction -> String +showTransaction :: Transaction -> Text showTransaction = showTransactionHelper False -- | Deprecated alias for 'showTransaction' -showTransactionUnelided :: Transaction -> String +showTransactionUnelided :: Transaction -> Text showTransactionUnelided = showTransaction -- TODO: drop it -- | Like showTransaction, but explicit multi-commodity amounts -- are shown on one line, comma-separated. In this case the output will -- not be parseable journal syntax. -showTransactionOneLineAmounts :: Transaction -> String +showTransactionOneLineAmounts :: Transaction -> Text showTransactionOneLineAmounts = showTransactionHelper True -- | Deprecated alias for 'showTransactionOneLineAmounts' -showTransactionUnelidedOneLineAmounts :: Transaction -> String +showTransactionUnelidedOneLineAmounts :: Transaction -> Text showTransactionUnelidedOneLineAmounts = showTransactionOneLineAmounts -- TODO: drop it -- | Helper for showTransaction*. -showTransactionHelper :: Bool -> Transaction -> String +showTransactionHelper :: Bool -> Transaction -> Text showTransactionHelper onelineamounts t = - unlines $ [descriptionline] - ++ newlinecomments - ++ (postingsAsLines onelineamounts (tpostings t)) - ++ [""] - where - descriptionline = rstrip $ concat [date, status, code, desc, samelinecomment] - date = showDate (tdate t) ++ maybe "" (("="++) . showDate) (tdate2 t) - status | tstatus t == Cleared = " *" - | tstatus t == Pending = " !" - | otherwise = "" - code = if T.length (tcode t) > 0 then printf " (%s)" $ T.unpack $ tcode t else "" - desc = if null d then "" else " " ++ d where d = T.unpack $ tdescription t - (samelinecomment, newlinecomments) = - case renderCommentLines (tcomment t) of [] -> ("",[]) - c:cs -> (c,cs) + T.unlines $ + descriptionline + : newlinecomments + ++ (postingsAsLines onelineamounts (tpostings t)) + ++ [""] + where + descriptionline = T.stripEnd $ T.concat [date, status, code, desc, samelinecomment] + date = T.pack $ showDate (tdate t) ++ maybe "" (("="++) . showDate) (tdate2 t) + status | tstatus t == Cleared = " *" + | tstatus t == Pending = " !" + | otherwise = "" + code = if T.null (tcode t) then "" else wrap " (" ")" $ tcode t + desc = if T.null d then "" else " " <> d where d = tdescription t + (samelinecomment, newlinecomments) = + case renderCommentLines (tcomment t) of [] -> ("",[]) + c:cs -> (c,cs) -- | Render a transaction or posting's comment as indented, semicolon-prefixed comment lines. -- The first line (unless empty) will have leading space, subsequent lines will have a larger indent. -renderCommentLines :: Text -> [String] +renderCommentLines :: Text -> [Text] renderCommentLines t = - case lines $ T.unpack t of + case T.lines t of [] -> [] - [l] -> [(commentSpace . comment) l] -- single-line comment + [l] -> [commentSpace $ comment l] -- single-line comment ("":ls) -> "" : map (lineIndent . comment) ls -- multi-line comment with empty first line - (l:ls) -> (commentSpace . comment) l : map (lineIndent . comment) ls + (l:ls) -> commentSpace (comment l) : map (lineIndent . comment) ls where - comment = ("; "++) + comment = ("; "<>) -- | Given a transaction and its postings, render the postings, suitable -- for `print` output. Normally this output will be valid journal syntax which @@ -214,7 +214,7 @@ renderCommentLines t = -- Posting amounts will be aligned with each other, starting about 4 columns -- beyond the widest account name (see postingAsLines for details). -- -postingsAsLines :: Bool -> [Posting] -> [String] +postingsAsLines :: Bool -> [Posting] -> [Text] postingsAsLines onelineamounts ps = concatMap (postingAsLines False onelineamounts ps) ps -- | Render one posting, on one or more lines, suitable for `print` output. @@ -236,23 +236,25 @@ postingsAsLines onelineamounts ps = concatMap (postingAsLines False onelineamoun -- increased if needed to match the posting with the longest account name. -- This is used to align the amounts of a transaction's postings. -- -postingAsLines :: Bool -> Bool -> [Posting] -> Posting -> [String] +postingAsLines :: Bool -> Bool -> [Posting] -> Posting -> [Text] postingAsLines elideamount onelineamounts pstoalignwith p = concat [ postingblock ++ newlinecomments | postingblock <- postingblocks] where - postingblocks = [map rstrip $ lines $ concatTopPadded [statusandaccount, " ", amt, assertion, samelinecomment] | amt <- shownAmounts] + postingblocks = [map (T.stripEnd . T.pack) . lines $ + concatTopPadded [T.unpack statusandaccount, " ", amt, assertion, T.unpack samelinecomment] + | amt <- shownAmounts] assertion = maybe "" ((' ':).showBalanceAssertion) $ pbalanceassertion p - statusandaccount = lineIndent $ fitString (Just $ minwidth) Nothing False True $ pstatusandacct p - where - -- pad to the maximum account name width, plus 2 to leave room for status flags, to keep amounts aligned - minwidth = maximum $ map ((2+) . textWidth . T.pack . pacctstr) pstoalignwith - pstatusandacct p' = pstatusprefix p' ++ pacctstr p' - pstatusprefix p' | null s = "" - | otherwise = s ++ " " - where s = show $ pstatus p' - pacctstr p' = showAccountName Nothing (ptype p') (paccount p') + statusandaccount = lineIndent . fitText (Just $ minwidth) Nothing False True $ pstatusandacct p + where + -- pad to the maximum account name width, plus 2 to leave room for status flags, to keep amounts aligned + minwidth = maximum $ map ((2+) . textWidth . pacctstr) pstoalignwith + pstatusandacct p' = pstatusprefix p' <> pacctstr p' + pstatusprefix p' = case pstatus p' of + Unmarked -> "" + s -> T.pack (show s) <> " " + pacctstr p' = showAccountName Nothing (ptype p') (paccount p') -- currently prices are considered part of the amount string when right-aligning amounts shownAmounts @@ -286,33 +288,27 @@ showBalanceAssertion BalanceAssertion{..} = -- | Render a posting, at the appropriate width for aligning with -- its siblings if any. Used by the rewrite command. -showPostingLines :: Posting -> [String] +showPostingLines :: Posting -> [Text] showPostingLines p = postingAsLines False False ps p where ps | Just t <- ptransaction p = tpostings t | otherwise = [p] -- | Prepend a suitable indent for a posting (or transaction/posting comment) line. -lineIndent :: String -> String -lineIndent = (" "++) +lineIndent :: Text -> Text +lineIndent = (" "<>) -- | Prepend the space required before a same-line comment. -commentSpace :: String -> String -commentSpace = (" "++) +commentSpace :: Text -> Text +commentSpace = (" "<>) -- | Show an account name, clipped to the given width if any, and -- appropriately bracketed/parenthesised for the given posting type. -showAccountName :: Maybe Int -> PostingType -> AccountName -> String +showAccountName :: Maybe Int -> PostingType -> AccountName -> Text showAccountName w = fmt where - fmt RegularPosting = maybe id take w . T.unpack - fmt VirtualPosting = parenthesise . maybe id (takeEnd . subtract 2) w . T.unpack - fmt BalancedVirtualPosting = bracket . maybe id (takeEnd . subtract 2) w . T.unpack - -parenthesise :: String -> String -parenthesise s = "("++s++")" - -bracket :: String -> String -bracket s = "["++s++"]" + fmt RegularPosting = maybe id T.take w + fmt VirtualPosting = wrap "(" ")" . maybe id (T.takeEnd . subtract 2) w + fmt BalancedVirtualPosting = wrap "[" "]" . maybe id (T.takeEnd . subtract 2) w hasRealPostings :: Transaction -> Bool hasRealPostings = not . null . realPostings @@ -427,7 +423,7 @@ transactionBalanceError t errs = annotateErrorWithTransaction :: Transaction -> String -> String annotateErrorWithTransaction t s = - unlines [showGenericSourcePos $ tsourcepos t, s, rstrip $ showTransaction t] + unlines [showGenericSourcePos $ tsourcepos t, s, T.unpack . T.stripEnd $ showTransaction t] -- | Infer up to one missing amount for this transactions's real postings, and -- likewise for its balanced virtual postings, if needed; or return an error @@ -678,7 +674,7 @@ tests_Transaction = Right nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` usd 5]} (fst <$> inferBalancingAmount M.empty nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` (eur 3 @@ usd 4), "c" `post` missingamt]}) @?= Right nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` (eur 3 @@ usd 4), "c" `post` usd 1]} - + , tests "showTransaction" [ test "null transaction" $ showTransaction nulltransaction @?= "0000-01-01\n\n" , test "non-null transaction" $ showTransaction @@ -701,7 +697,7 @@ tests_Transaction = } ] } @?= - unlines + T.unlines [ "2012-05-14=2012-05-15 (code) desc ; tcomment1" , " ; tcomment2" , " * a $1.00" @@ -727,7 +723,7 @@ tests_Transaction = , posting {paccount = "assets:checking", pamount = Mixed [usd (-47.18)], ptransaction = Just t} ] in showTransaction t) @?= - (unlines + (T.unlines [ "2007-01-28 coopportunity" , " expenses:food:groceries $47.18" , " assets:checking $-47.18" @@ -750,7 +746,7 @@ tests_Transaction = [ posting {paccount = "expenses:food:groceries", pamount = Mixed [usd 47.18]} , posting {paccount = "assets:checking", pamount = Mixed [usd (-47.19)]} ])) @?= - (unlines + (T.unlines [ "2007-01-28 coopportunity" , " expenses:food:groceries $47.18" , " assets:checking $-47.19" @@ -771,9 +767,9 @@ tests_Transaction = "" [] [posting {paccount = "expenses:food:groceries", pamount = missingmixedamt}])) @?= - (unlines ["2007-01-28 coopportunity", " expenses:food:groceries", ""]) + (T.unlines ["2007-01-28 coopportunity", " expenses:food:groceries", ""]) , test "show a transaction with a priced commodityless amount" $ - (showTransaction + (T.unpack $ showTransaction (txnTieKnot $ Transaction 0 diff --git a/hledger-lib/Hledger/Data/TransactionModifier.hs b/hledger-lib/Hledger/Data/TransactionModifier.hs index 4e31b8e9b..6bf71f328 100644 --- a/hledger-lib/Hledger/Data/TransactionModifier.hs +++ b/hledger-lib/Hledger/Data/TransactionModifier.hs @@ -62,7 +62,7 @@ modifyTransactions d tmods ts = do -- postings when certain other postings are present. -- -- >>> t = nulltransaction{tpostings=["ping" `post` usd 1]} --- >>> test = either putStr (putStr.showTransaction) . fmap ($ t) . transactionModifierToFunction nulldate +-- >>> test = either putStr (putStr.T.unpack.showTransaction) . fmap ($ t) . transactionModifierToFunction nulldate -- >>> test $ TransactionModifier "" ["pong" `post` usd 2] -- 0000-01-01 -- ping $1.00 diff --git a/hledger-lib/Hledger/Utils/Text.hs b/hledger-lib/Hledger/Utils/Text.hs index 0f96d5391..dc17e1d4c 100644 --- a/hledger-lib/Hledger/Utils/Text.hs +++ b/hledger-lib/Hledger/Utils/Text.hs @@ -13,6 +13,7 @@ module Hledger.Utils.Text -- stripbrackets, textUnbracket, wrap, + textChomp, -- -- quoting quoteIfSpaced, textQuoteIfNeeded, @@ -92,6 +93,10 @@ textElideRight width t = wrap :: Text -> Text -> Text -> Text wrap start end x = start <> x <> end +-- | Remove trailing newlines/carriage returns. +textChomp :: Text -> Text +textChomp = T.dropWhileEnd (`elem` ['\r', '\n']) + -- -- | Clip and pad a string to a minimum & maximum width, and/or left/right justify it. -- -- Works on multi-line strings too (but will rewrite non-unix line endings). -- formatString :: Bool -> Maybe Int -> Maybe Int -> String -> String diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index 1e07b16c1..60fc842b8 100644 --- a/hledger-ui/Hledger/UI/TransactionScreen.hs +++ b/hledger-ui/Hledger/UI/TransactionScreen.hs @@ -79,9 +79,10 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{ fromMaybe (error' "TransactionScreen: expected a non-empty journal") $ -- PARTIAL: shouldn't happen reportPeriodOrJournalLastDay rspec j - render $ defaultLayout toplabel bottomlabel $ str $ - showTransactionOneLineAmounts $ - maybe t (transactionApplyValuation prices styles periodlast (rsToday rspec) t) $ value_ ropts + render . defaultLayout toplabel bottomlabel . str + . T.unpack . showTransactionOneLineAmounts + . maybe t (transactionApplyValuation prices styles periodlast (rsToday rspec) t) + $ value_ ropts -- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real where toplabel = diff --git a/hledger-web/templates/chart.hamlet b/hledger-web/templates/chart.hamlet index b5999424a..99993ab2b 100644 --- a/hledger-web/templates/chart.hamlet +++ b/hledger-web/templates/chart.hamlet @@ -38,7 +38,7 @@ #{simpleMixedAmountQuantity $ triCommodityBalance c i}, '#{showMixedAmountWithZeroCommodity $ triCommodityAmount c i}', '#{showMixedAmountWithZeroCommodity $ triCommodityBalance c i}', - '#{concat $ intersperse "\\n" $ lines $ showTransaction $ triOrigTransaction i}', + '#{concat $ intersperse "\\n" $ lines $ T.unpack $ showTransaction $ triOrigTransaction i}', #{tindex $ triOrigTransaction i} ], /* [] */ diff --git a/hledger/Hledger/Cli/Commands/Add.hs b/hledger/Hledger/Cli/Commands/Add.hs index 89bc9bab8..e2068ed99 100644 --- a/hledger/Hledger/Cli/Commands/Add.hs +++ b/hledger/Hledger/Cli/Commands/Add.hs @@ -27,18 +27,19 @@ import Data.Either (isRight) import Data.Functor.Identity (Identity(..)) import "base-compat-batteries" Data.List.Compat import qualified Data.Set as S -import Data.Maybe +import Data.Maybe (fromJust, fromMaybe, isJust) import Data.Text (Text) 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.Calendar (Day) import Data.Time.Format (formatTime, defaultTimeLocale, iso8601DateFormat) import Safe (headDef, headMay, atMay) -import System.Console.CmdArgs.Explicit +import System.Console.CmdArgs.Explicit (flagNone) import System.Console.Haskeline (runInputT, defaultSettings, setComplete) -import System.Console.Haskeline.Completion -import System.Console.Wizard +import System.Console.Haskeline.Completion (CompletionFunc, completeWord, isFinished, noCompletion, simpleCompletion) +import System.Console.Wizard (Wizard, defaultTo, line, output, retryMsg, linePrewritten, nonEmpty, parser, run) import System.Console.Wizard.Haskeline import System.IO ( stderr, hPutStr, hPutStrLn ) import Text.Megaparsec @@ -91,7 +92,7 @@ add :: CliOpts -> Journal -> IO () add opts j | journalFilePath j == "-" = return () | otherwise = do - hPrintf stderr "Adding transactions to journal file %s\n" (journalFilePath j) + hPutStrLn stderr $ "Adding transactions to journal file " <> journalFilePath j showHelp today <- getCurrentDay let es = defEntryState{esOpts=opts @@ -125,16 +126,16 @@ getAndAddTransactions es@EntryState{..} = (do Nothing -> error "Could not interpret the input, restarting" -- caught below causing a restart, I believe -- PARTIAL: Just t -> do j <- if debug_ esOpts > 0 - then do hPrintf stderr "Skipping journal add due to debug mode.\n" + then do hPutStrLn stderr "Skipping journal add due to debug mode." return esJournal else do j' <- journalAddTransaction esJournal esOpts t - hPrintf stderr "Saved.\n" + hPutStrLn stderr "Saved." return j' - hPrintf stderr "Starting the next transaction (. or ctrl-D/ctrl-C to quit)\n" + hPutStrLn stderr "Starting the next transaction (. or ctrl-D/ctrl-C to quit)" getAndAddTransactions es{esJournal=j, esDefDate=tdate t} ) `E.catch` (\(_::RestartTransactionException) -> - hPrintf stderr "Restarting this transaction.\n" >> getAndAddTransactions es) + hPutStrLn stderr "Restarting this transaction." >> getAndAddTransactions es) data TxnParams = TxnParams { txnDate :: Day @@ -182,7 +183,9 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _) } descAndCommentString = T.unpack $ desc <> (if T.null comment then "" else " ; " <> comment) prevInput' = prevInput{prevDescAndCmnt=Just descAndCommentString} - when (isJust mbaset) $ liftIO $ hPrintf stderr "Using this similar transaction for defaults:\n%s" (showTransaction $ fromJust mbaset) + when (isJust mbaset) . liftIO $ do + hPutStrLn stderr "Using this similar transaction for defaults:" + T.hPutStr stderr $ showTransaction (fromJust mbaset) confirmedTransactionWizard prevInput' es' ((EnterNewPosting TxnParams{txnDate=date, txnCode=code, txnDesc=desc, txnCmnt=comment} Nothing) : stack) Nothing -> confirmedTransactionWizard prevInput es (drop 1 stack) @@ -241,7 +244,7 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _) Nothing -> confirmedTransactionWizard prevInput es (drop 1 stack) EndStage t -> do - output $ showTransaction t + output . T.unpack $ showTransaction t y <- let def = "y" in retryMsg "Please enter y or n." $ parser ((fmap (\c -> if c == '<' then Nothing else Just c)) . headMay . map toLower . strip) $ @@ -305,7 +308,7 @@ accountWizard PrevInput{..} EntryState{..} = do historicalp = fmap ((!! (pnum - 1)) . (++ (repeat nullposting)) . tpostings) esSimilarTransaction historicalacct = case historicalp of Just p -> showAccountName Nothing (ptype p) (paccount p) Nothing -> "" - def = headDef historicalacct esArgs + def = headDef (T.unpack historicalacct) esArgs endmsg | canfinish && null def = " (or . or enter to finish this transaction)" | canfinish = " (or . to finish this transaction)" | otherwise = "" @@ -444,7 +447,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 - TL.putStrLn =<< registerFromString (T.pack $ showTransaction t) + TL.putStrLn =<< registerFromString (showTransaction t) return j{jtxns=ts++[t]} -- | Append a string, typically one or more transactions, to a journal @@ -455,15 +458,15 @@ journalAddTransaction j@Journal{jtxns=ts} opts t = do -- even if the file uses dos line endings (\r\n), which could leave -- mixed line endings in the file. See also writeFileWithBackupIfChanged. -- -appendToJournalFileOrStdout :: FilePath -> String -> IO () +appendToJournalFileOrStdout :: FilePath -> Text -> IO () appendToJournalFileOrStdout f s - | f == "-" = putStr s' - | otherwise = appendFile f s' - where s' = "\n" ++ ensureOneNewlineTerminated s + | f == "-" = T.putStr s' + | otherwise = appendFile f $ T.unpack s' + where s' = "\n" <> ensureOneNewlineTerminated s -- | Replace a string's 0 or more terminating newlines with exactly one. -ensureOneNewlineTerminated :: String -> String -ensureOneNewlineTerminated = (++"\n") . reverse . dropWhile (=='\n') . reverse +ensureOneNewlineTerminated :: Text -> Text +ensureOneNewlineTerminated = (<>"\n") . T.dropWhileEnd (=='\n') -- | Convert a string of journal data into a register report. registerFromString :: Text -> IO TL.Text diff --git a/hledger/Hledger/Cli/Commands/Close.hs b/hledger/Hledger/Cli/Commands/Close.hs index fdba83dda..9f019d595 100755 --- a/hledger/Hledger/Cli/Commands/Close.hs +++ b/hledger/Hledger/Cli/Commands/Close.hs @@ -11,7 +11,8 @@ import Control.Monad (when) import Data.Function (on) import Data.List (groupBy) import Data.Maybe -import qualified Data.Text as T (pack) +import qualified Data.Text as T +import qualified Data.Text.IO as T import Data.Time.Calendar import System.Console.CmdArgs.Explicit as C @@ -152,6 +153,5 @@ close CliOpts{rawopts_=rawopts, reportspec_=rspec} j = do ++ [posting{paccount=openingacct, pamount=if explicit then mapMixedAmount precise (negate totalamt) else missingmixedamt} | not interleaved] -- print them - when closing $ putStr $ showTransaction closingtxn - when opening $ putStr $ showTransaction openingtxn - + when closing . T.putStr $ showTransaction closingtxn + when opening . T.putStr $ showTransaction openingtxn diff --git a/hledger/Hledger/Cli/Commands/Diff.hs b/hledger/Hledger/Cli/Commands/Diff.hs index cd82e02ee..a4afce195 100644 --- a/hledger/Hledger/Cli/Commands/Diff.hs +++ b/hledger/Hledger/Cli/Commands/Diff.hs @@ -19,6 +19,7 @@ import Data.Maybe import Data.Time import Data.Either import qualified Data.Text as T +import qualified Data.Text.IO as T import System.Exit import Hledger @@ -116,10 +117,10 @@ diff CliOpts{file_=[f1, f2], reportspec_=ReportSpec{rsQuery=Acct acctRe}} _ = do let unmatchedtxn2 = unmatchedtxns R pp2 m putStrLn "These transactions are in the first file only:\n" - mapM_ (putStr . showTransaction) unmatchedtxn1 + mapM_ (T.putStr . showTransaction) unmatchedtxn1 putStrLn "These transactions are in the second file only:\n" - mapM_ (putStr . showTransaction) unmatchedtxn2 + mapM_ (T.putStr . showTransaction) unmatchedtxn2 diff _ _ = do putStrLn "Please specify two input files. Usage: hledger diff -f FILE1 -f FILE2 FULLACCOUNTNAME" diff --git a/hledger/Hledger/Cli/Commands/Import.hs b/hledger/Hledger/Cli/Commands/Import.hs index b5142a0ec..c052573ee 100755 --- a/hledger/Hledger/Cli/Commands/Import.hs +++ b/hledger/Hledger/Cli/Commands/Import.hs @@ -9,6 +9,7 @@ where import Control.Monad import Data.List +import qualified Data.Text.IO as T import Hledger import Hledger.Cli.CliOptions import Hledger.Cli.Commands.Add (journalAddTransaction) @@ -50,7 +51,7 @@ importcmd opts@CliOpts{rawopts_=rawopts,inputopts_=iopts} j = do printf "; would import %d new transactions from %s:\n\n" (length newts) inputstr -- TODO how to force output here ? -- length (jtxns newj) `seq` print' opts{rawopts_=("explicit",""):rawopts} newj - mapM_ (putStr . showTransaction) newts + mapM_ (T.putStr . showTransaction) newts newts | catchup -> do printf "marked %s as caught up, skipping %d unimported transactions\n\n" inputstr (length newts) newts -> do diff --git a/hledger/Hledger/Cli/Commands/Print.hs b/hledger/Hledger/Cli/Commands/Print.hs index 30564fafb..9eee02cd4 100644 --- a/hledger/Hledger/Cli/Commands/Print.hs +++ b/hledger/Hledger/Cli/Commands/Print.hs @@ -19,6 +19,7 @@ import Data.Maybe (isJust) import Data.Text (Text) import Data.List (intersperse) 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.Builder as TB import System.Console.CmdArgs.Explicit @@ -65,7 +66,7 @@ printEntries opts@CliOpts{reportspec_=rspec} j = | otherwise = error' $ unsupportedOutputFormatError fmt -- PARTIAL: entriesReportAsText :: CliOpts -> EntriesReport -> TL.Text -entriesReportAsText opts = TB.toLazyText . foldMap (TB.fromString . showTransaction . whichtxn) +entriesReportAsText opts = TB.toLazyText . foldMap (TB.fromText . showTransaction . whichtxn) where whichtxn -- With -x, use the fully-inferred txn with all amounts & txn prices explicit. @@ -176,8 +177,8 @@ postingToCSV p = where Mixed amounts = pamount p status = show $ pstatus p - account = showAccountName Nothing (ptype p) (paccount p) - comment = chomp $ strip $ T.unpack $ pcomment p + account = T.unpack $ showAccountName Nothing (ptype p) (paccount p) + comment = T.unpack . textChomp . T.strip $ pcomment p -- --match @@ -187,7 +188,7 @@ printMatch :: CliOpts -> Journal -> Text -> IO () printMatch CliOpts{reportspec_=rspec} j desc = do case similarTransaction' j (rsQuery rspec) desc of Nothing -> putStrLn "no matches found." - Just t -> putStr $ showTransaction t + Just t -> T.putStr $ showTransaction t where -- Identify the closest recent match for this description in past transactions. diff --git a/hledger/Hledger/Cli/Commands/Rewrite.hs b/hledger/Hledger/Cli/Commands/Rewrite.hs index 159d41440..5ce5a9a9a 100755 --- a/hledger/Hledger/Cli/Commands/Rewrite.hs +++ b/hledger/Hledger/Cli/Commands/Rewrite.hs @@ -13,7 +13,9 @@ import Control.Monad.Writer hiding (Any) #endif import Data.Functor.Identity import Data.List (sortOn, foldl') +import Data.Text (Text) import qualified Data.Text as T +import qualified Data.Text.IO as T import Hledger import Hledger.Cli.CliOptions import Hledger.Cli.Commands.Print @@ -65,9 +67,9 @@ printOrDiff opts diffOutput :: Journal -> Journal -> IO () diffOutput j j' = do let changed = [(originalTransaction t, originalTransaction t') | (t, t') <- zip (jtxns j) (jtxns j'), t /= t'] - putStr $ renderPatch $ map (uncurry $ diffTxn j) changed + T.putStr $ renderPatch $ map (uncurry $ diffTxn j) changed -type Chunk = (GenericSourcePos, [DiffLine String]) +type Chunk = (GenericSourcePos, [DiffLine Text]) -- XXX doctests, update needed: -- >>> putStr $ renderPatch [(GenericSourcePos "a" 1 1, [D.First "x", D.Second "y"])] @@ -95,17 +97,17 @@ type Chunk = (GenericSourcePos, [DiffLine String]) -- @@ -5,0 +5,1 @@ -- +z -- | Render list of changed lines as a unified diff -renderPatch :: [Chunk] -> String +renderPatch :: [Chunk] -> Text renderPatch = go Nothing . sortOn fst where go _ [] = "" - go Nothing cs@((sourceFilePath -> fp, _):_) = fileHeader fp ++ go (Just (fp, 0)) cs + go Nothing cs@((sourceFilePath -> fp, _):_) = fileHeader fp <> go (Just (fp, 0)) cs go (Just (fp, _)) cs@((sourceFilePath -> fp', _):_) | fp /= fp' = go Nothing cs - go (Just (fp, offs)) ((sourceFirstLine -> lineno, diffs):cs) = chunkHeader ++ chunk ++ go (Just (fp, offs + adds - dels)) cs + go (Just (fp, offs)) ((sourceFirstLine -> lineno, diffs):cs) = chunkHeader <> chunk <> go (Just (fp, offs + adds - dels)) cs where - chunkHeader = printf "@@ -%d,%d +%d,%d @@\n" lineno dels (lineno+offs) adds where + chunkHeader = T.pack $ printf "@@ -%d,%d +%d,%d @@\n" lineno dels (lineno+offs) adds where (dels, adds) = foldl' countDiff (0, 0) diffs - chunk = concatMap renderLine diffs - fileHeader fp = printf "--- %s\n+++ %s\n" fp fp + chunk = foldMap renderLine diffs + fileHeader fp = "--- " <> T.pack fp <> "\n+++ " <> T.pack fp <> "\n" countDiff (dels, adds) = \case Del _ -> (dels + 1, adds) @@ -113,9 +115,9 @@ renderPatch = go Nothing . sortOn fst where Ctx _ -> (dels + 1, adds + 1) renderLine = \case - Del s -> '-' : s ++ "\n" - Add s -> '+' : s ++ "\n" - Ctx s -> ' ' : s ++ "\n" + Del s -> "-" <> s <> "\n" + Add s -> "+" <> s <> "\n" + Ctx s -> " " <> s <> "\n" diffTxn :: Journal -> Transaction -> Transaction -> Chunk diffTxn j t t' = @@ -124,18 +126,18 @@ diffTxn j t t' = -- TODO: use range and produce two chunks: one removes part of -- original file, other adds transaction to new file with -- suffix .ledger (generated). I.e. move transaction from one file to another. - diffs :: [DiffLine String] + diffs :: [DiffLine Text] diffs = concat . map (traverse showPostingLines . mapDiff) $ D.getDiff (tpostings t) (tpostings t') pos@(JournalSourcePos fp (line, line')) -> (pos, diffs) where -- We do diff for original lines vs generated ones. Often leads -- to big diff because of re-format effect. - diffs :: [DiffLine String] + diffs :: [DiffLine Text] diffs = map mapDiff $ D.getDiff source changed' - source | Just contents <- lookup fp $ jfiles j = map T.unpack . drop (line-1) . take line' $ T.lines contents + source | Just contents <- lookup fp $ jfiles j = drop (line-1) . take line' $ T.lines contents | otherwise = [] - changed = lines $ showTransaction t' + changed = T.lines $ showTransaction t' changed' | null changed = changed - | null $ last changed = init changed + | T.null $ last changed = init changed | otherwise = changed data DiffLine a = Del a | Add a | Ctx a