lib,cli: Make showTransaction return Text rather than String.
This commit is contained in:
Stephen Morgan
parent
dbe7015502
commit
74b296f865
@ -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
|
||||
]
|
||||
|
||||
--
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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,
|
||||
|
||||
@ -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
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 =
|
||||
|
||||
@ -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}
|
||||
],
|
||||
/* [] */
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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"
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user