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

lib,cli: Make showTransaction return Text rather than String.

Browse Source
This commit is contained in:
Stephen Morgan 2020-10-28 12:53:37 +11:00
parent dbe7015502
commit 74b296f865
14 changed files with 132 additions and 121 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
hledger-lib/Hledger/Data/Journal.hs
View File

@ -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
]
--

5
hledger-lib/Hledger/Data/PeriodicTransaction.hs
View File

@ -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

4
hledger-lib/Hledger/Data/Timeclock.hs
View File

@ -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,

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

@ -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
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)
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.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
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,22 +236,24 @@ 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
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 . T.pack . pacctstr) pstoalignwith
pstatusandacct p' = pstatusprefix p' ++ pacctstr p'
pstatusprefix p' | null s = ""
| otherwise = s ++ " "
where s = show $ pstatus p'
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
@ -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
@ -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

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

@ -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

5
hledger-lib/Hledger/Utils/Text.hs
View File

@ -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

7
hledger-ui/Hledger/UI/TransactionScreen.hs
View File

@ -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 =

2
hledger-web/templates/chart.hamlet
View File

@ -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}
],
/* [] */

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

@ -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

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

@ -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

5
hledger/Hledger/Cli/Commands/Diff.hs
View File

@ -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"

3
hledger/Hledger/Cli/Commands/Import.hs
View File

@ -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

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

@ -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.

34
hledger/Hledger/Cli/Commands/Rewrite.hs
View File

@ -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