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

lib,cli: Use Text for CSV values.

Browse Source
This commit is contained in:
Stephen Morgan 2020-11-05 18:59:35 +11:00
parent e3ec01c3c6
commit 541c4fc18c
9 changed files with 217 additions and 226 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

276
hledger-lib/Hledger/Read/CsvReader.hs
View File

@ -52,7 +52,6 @@ import Control.Monad.Trans.Class (lift)
import Data.Char (toLower, isDigit, isSpace, isAlphaNum, isAscii, ord)
import Data.Bifunctor (first)
import "base-compat-batteries" Data.List.Compat
import qualified Data.List.Split as LS (splitOn)
import Data.Maybe (catMaybes, fromMaybe, isJust)
import Data.MemoUgly (memo)
import Data.Ord (comparing)
@ -61,6 +60,8 @@ import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding 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 Data.Time.Calendar (Day)
import Data.Time.Format (parseTimeM, defaultTimeLocale)
import Safe (atMay, headMay, lastMay, readDef, readMay)
@ -88,7 +89,7 @@ import Hledger.Read.Common (aliasesFromOpts, Reader(..),InputOpts(..), amountp,
type CSV = [CsvRecord]
type CsvRecord = [CsvValue]
type CsvValue = String
type CsvValue = Text
--- ** reader
@ -164,7 +165,7 @@ defaultRulesText csvfile = T.pack $ unlines
," account2 assets:bank:savings\n"
]
addDirective :: (DirectiveName, String) -> CsvRulesParsed -> CsvRulesParsed
addDirective :: (DirectiveName, Text) -> CsvRulesParsed -> CsvRulesParsed
addDirective d r = r{rdirectives=d:rdirectives r}
addAssignment :: (HledgerFieldName, FieldTemplate) -> CsvRulesParsed -> CsvRulesParsed
@ -181,7 +182,7 @@ addAssignmentsFromList fs r = foldl' maybeAddAssignment r journalfieldnames
where
maybeAddAssignment rules f = (maybe id addAssignmentFromIndex $ elemIndex f fs) rules
where
addAssignmentFromIndex i = addAssignment (f, "%"++show (i+1))
addAssignmentFromIndex i = addAssignment (f, T.pack $ '%':show (i+1))
addConditionalBlock :: ConditionalBlock -> CsvRulesParsed -> CsvRulesParsed
addConditionalBlock b r = r{rconditionalblocks=b:rconditionalblocks r}
@ -240,7 +241,7 @@ validateRules rules = do
-- | A set of data definitions and account-matching patterns sufficient to
-- convert a particular CSV data file into meaningful journal transactions.
data CsvRules' a = CsvRules' {
rdirectives :: [(DirectiveName,String)],
rdirectives :: [(DirectiveName,Text)],
-- ^ top-level rules, as (keyword, value) pairs
rcsvfieldindexes :: [(CsvFieldName, CsvFieldIndex)],
-- ^ csv field names and their column number, if declared by a fields list
@ -260,7 +261,7 @@ type CsvRulesParsed = CsvRules' ()
-- | Type used after parsing is done. Directives, assignments and conditional blocks
-- are in the same order as they were in the unput file and rblocksassigning is functional.
-- Ready to be used for CSV record processing
type CsvRules = CsvRules' (String -> [ConditionalBlock])
type CsvRules = CsvRules' (Text -> [ConditionalBlock])
instance Eq CsvRules where
r1 == r2 = (rdirectives r1, rcsvfieldindexes r1, rassignments r1) ==
@ -277,27 +278,27 @@ instance Show CsvRules where
type CsvRulesParser a = StateT CsvRulesParsed SimpleTextParser a
-- | The keyword of a CSV rule - "fields", "skip", "if", etc.
type DirectiveName = String
type DirectiveName = Text
-- | CSV field name.
type CsvFieldName = String
type CsvFieldName = Text
-- | 1-based CSV column number.
type CsvFieldIndex = Int
-- | Percent symbol followed by a CSV field name or column number. Eg: %date, %1.
type CsvFieldReference = String
type CsvFieldReference = Text
-- | One of the standard hledger fields or pseudo-fields that can be assigned to.
-- Eg date, account1, amount, amount1-in, date-format.
type HledgerFieldName = String
type HledgerFieldName = Text
-- | A text value to be assigned to a hledger field, possibly
-- containing csv field references to be interpolated.
type FieldTemplate = String
type FieldTemplate = Text
-- | A strptime date parsing pattern, as supported by Data.Time.Format.
type DateFormat = String
type DateFormat = Text
-- | A prefix for a matcher test, either & or none (implicit or).
data MatcherPrefix = And | None
@ -453,16 +454,16 @@ commentlinep = lift skipNonNewlineSpaces >> commentcharp >> lift restofline >> r
commentcharp :: CsvRulesParser Char
commentcharp = oneOf (";#*" :: [Char])
directivep :: CsvRulesParser (DirectiveName, String)
directivep :: CsvRulesParser (DirectiveName, Text)
directivep = (do
lift $ dbgparse 8 "trying directive"
d <- fmap T.unpack $ choiceInState $ map (lift . string . T.pack) directives
d <- choiceInState $ map (lift . string) directives
v <- (((char ':' >> lift (many spacenonewline)) <|> lift (some spacenonewline)) >> directivevalp)
<|> (optional (char ':') >> lift skipNonNewlineSpaces >> lift eolof >> return "")
return (d, v)
) <?> "directive"
directives :: [String]
directives :: [Text]
directives =
["date-format"
,"decimal-mark"
@ -474,8 +475,8 @@ directives =
, "balance-type"
]
directivevalp :: CsvRulesParser String
directivevalp = anySingle `manyTill` lift eolof
directivevalp :: CsvRulesParser Text
directivevalp = T.pack <$> anySingle `manyTill` lift eolof
fieldnamelistp :: CsvRulesParser [CsvFieldName]
fieldnamelistp = (do
@ -487,21 +488,18 @@ fieldnamelistp = (do
f <- fromMaybe "" <$> optional fieldnamep
fs <- some $ (separator >> fromMaybe "" <$> optional fieldnamep)
lift restofline
return $ map (map toLower) $ f:fs
return . map T.toLower $ f:fs
) <?> "field name list"
fieldnamep :: CsvRulesParser String
fieldnamep :: CsvRulesParser Text
fieldnamep = quotedfieldnamep <|> barefieldnamep
quotedfieldnamep :: CsvRulesParser String
quotedfieldnamep = do
char '"'
f <- some $ noneOf ("\"\n:;#~" :: [Char])
char '"'
return f
quotedfieldnamep :: CsvRulesParser Text
quotedfieldnamep =
char '"' *> takeWhile1P Nothing (`notElem` ("\"\n:;#~" :: [Char])) <* char '"'
barefieldnamep :: CsvRulesParser String
barefieldnamep = some $ noneOf (" \t\n,;#~" :: [Char])
barefieldnamep :: CsvRulesParser Text
barefieldnamep = takeWhile1P Nothing (`notElem` (" \t\n,;#~" :: [Char]))
fieldassignmentp :: CsvRulesParser (HledgerFieldName, FieldTemplate)
fieldassignmentp = do
@ -513,10 +511,10 @@ fieldassignmentp = do
return (f,v)
<?> "field assignment"
journalfieldnamep :: CsvRulesParser String
journalfieldnamep :: CsvRulesParser Text
journalfieldnamep = do
lift (dbgparse 8 "trying journalfieldnamep")
T.unpack <$> choiceInState (map (lift . string . T.pack) journalfieldnames)
choiceInState $ map (lift . string) journalfieldnames
maxpostings = 99
@ -524,14 +522,14 @@ maxpostings = 99
-- Names must precede any other name they contain, for the parser
-- (amount-in before amount; date2 before date). TODO: fix
journalfieldnames =
concat [[ "account" ++ i
,"amount" ++ i ++ "-in"
,"amount" ++ i ++ "-out"
,"amount" ++ i
,"balance" ++ i
,"comment" ++ i
,"currency" ++ i
] | x <- [maxpostings, (maxpostings-1)..1], let i = show x]
concat [[ "account" <> i
,"amount" <> i <> "-in"
,"amount" <> i <> "-out"
,"amount" <> i
,"balance" <> i
,"comment" <> i
,"currency" <> i
] | x <- [maxpostings, (maxpostings-1)..1], let i = T.pack $ show x]
++
["amount-in"
,"amount-out"
@ -556,10 +554,10 @@ assignmentseparatorp = do
]
return ()
fieldvalp :: CsvRulesParser String
fieldvalp :: CsvRulesParser Text
fieldvalp = do
lift $ dbgparse 8 "trying fieldvalp"
anySingle `manyTill` lift eolof
T.pack <$> anySingle `manyTill` lift eolof
-- A conditional block: one or more matchers, one per line, followed by one or more indented rules.
conditionalblockp :: CsvRulesParser ConditionalBlock
@ -594,7 +592,7 @@ conditionaltablep = do
body <- flip manyTill (lift eolof) $ do
off <- getOffset
m <- matcherp' (char sep >> return ())
vs <- LS.splitOn [sep] <$> lift restofline
vs <- T.split (==sep) . T.pack <$> lift restofline
if (length vs /= length fields)
then customFailure $ parseErrorAt off $ ((printf "line of conditional table should have %d values, but this one has only %d\n" (length fields) (length vs)) :: String)
else return (m,vs)
@ -655,8 +653,8 @@ csvfieldreferencep :: CsvRulesParser CsvFieldReference
csvfieldreferencep = do
lift $ dbgparse 8 "trying csvfieldreferencep"
char '%'
f <- fieldnamep
return $ '%' : quoteIfNeeded f
f <- T.unpack <$> fieldnamep -- XXX unpack and then pack
return . T.pack $ '%' : quoteIfNeeded f
-- A single regular expression
regexp :: CsvRulesParser () -> CsvRulesParser Regexp
@ -721,7 +719,7 @@ readJournalFromCsv mrulesfile csvfile csvdata =
let skiplines = case getDirective "skip" rules of
Nothing -> 0
Just "" -> 1
Just s -> readDef (throwerr $ "could not parse skip value: " ++ show s) s
Just s -> readDef (throwerr $ "could not parse skip value: " ++ show s) $ T.unpack s
-- parse csv
let
@ -785,12 +783,11 @@ readJournalFromCsv mrulesfile csvfile csvdata =
-- | Parse special separator names TAB and SPACE, or return the first
-- character. Return Nothing on empty string
parseSeparator :: String -> Maybe Char
parseSeparator = specials . map toLower
parseSeparator :: Text -> Maybe Char
parseSeparator = specials . T.toLower
where specials "space" = Just ' '
specials "tab" = Just '\t'
specials (x:_) = Just x
specials [] = Nothing
specials xs = fst <$> T.uncons xs
parseCsv :: Char -> FilePath -> Text -> IO (Either String CSV)
parseCsv separator filePath csvdata =
@ -813,15 +810,13 @@ parseResultToCsv :: (Foldable t, Functor t) => t (t B.ByteString) -> CSV
parseResultToCsv = toListList . unpackFields
where
toListList = toList . fmap toList
unpackFields = (fmap . fmap) (T.unpack . T.decodeUtf8)
unpackFields = (fmap . fmap) T.decodeUtf8
printCSV :: CSV -> String
printCSV records = unlined (printRecord `map` records)
where printRecord = concat . intersperse "," . map printField
printField f = "\"" ++ concatMap escape f ++ "\""
escape '"' = "\"\""
escape x = [x]
unlined = concat . intersperse "\n"
printCSV :: CSV -> TL.Text
printCSV = TB.toLazyText . unlined . map printRecord
where printRecord = mconcat . map TB.fromText . intersperse "," . map printField
printField = wrap "\"" "\"" . T.replace "\"" "\\\"\\\""
unlined = (<> TB.fromText "\n") . mconcat . intersperse "\n"
-- | Return the cleaned up and validated CSV data (can be empty), or an error.
validateCsv :: CsvRules -> Int -> Either String CSV -> Either String [CsvRecord]
@ -834,7 +829,7 @@ validateCsv rules numhdrlines (Right rs) = validate $ applyConditionalSkips $ dr
(Nothing, Nothing) -> Nothing
(Just _, _) -> Just maxBound
(Nothing, Just "") -> Just 1
(Nothing, Just x) -> Just (read x)
(Nothing, Just x) -> Just (read $ T.unpack x)
applyConditionalSkips [] = []
applyConditionalSkips (r:rest) =
case skipCount r of
@ -866,7 +861,7 @@ validateCsv rules numhdrlines (Right rs) = validate $ applyConditionalSkips $ dr
--- ** converting csv records to transactions
showRules rules record =
unlines $ catMaybes [ (("the "++fld++" rule is: ")++) <$> getEffectiveAssignment rules record fld | fld <- journalfieldnames]
T.unlines $ catMaybes [ (("the "<>fld<>" rule is: ")<>) <$> getEffectiveAssignment rules record fld | fld <- journalfieldnames]
-- | Look up the value (template) of a csv rule by rule keyword.
csvRule :: CsvRules -> DirectiveName -> Maybe FieldTemplate
@ -880,7 +875,7 @@ hledgerField = getEffectiveAssignment
-- | Look up the final value assigned to a hledger field, with csv field
-- references interpolated.
hledgerFieldValue :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe String
hledgerFieldValue :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe Text
hledgerFieldValue rules record = fmap (renderTemplate rules record) . hledgerField rules record
transactionFromCsvRecord :: SourcePos -> CsvRules -> CsvRecord -> Transaction
@ -892,18 +887,18 @@ transactionFromCsvRecord sourcepos rules record = t
rule = csvRule rules :: DirectiveName -> Maybe FieldTemplate
-- ruleval = csvRuleValue rules record :: DirectiveName -> Maybe String
field = hledgerField rules record :: HledgerFieldName -> Maybe FieldTemplate
fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe String
fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text
parsedate = parseDateWithCustomOrDefaultFormats (rule "date-format")
mkdateerror datefield datevalue mdateformat = unlines
["error: could not parse \""++datevalue++"\" as a date using date format "
++maybe "\"YYYY/M/D\", \"YYYY-M-D\" or \"YYYY.M.D\"" show mdateformat
mkdateerror datefield datevalue mdateformat = T.unpack $ T.unlines
["error: could not parse \""<>datevalue<>"\" as a date using date format "
<>maybe "\"YYYY/M/D\", \"YYYY-M-D\" or \"YYYY.M.D\"" (T.pack . show) mdateformat
,showRecord record
,"the "++datefield++" rule is: "++(fromMaybe "required, but missing" $ field datefield)
,"the date-format is: "++fromMaybe "unspecified" mdateformat
,"the "<>datefield<>" rule is: "<>(fromMaybe "required, but missing" $ field datefield)
,"the date-format is: "<>fromMaybe "unspecified" mdateformat
,"you may need to "
++"change your "++datefield++" rule, "
++maybe "add a" (const "change your") mdateformat++" date-format rule, "
++"or "++maybe "add a" (const "change your") mskip++" skip rule"
<>"change your "<>datefield<>" rule, "
<>maybe "add a" (const "change your") mdateformat<>" date-format rule, "
<>"or "<>maybe "add a" (const "change your") mskip<>" skip rule"
,"for m/d/y or d/m/y dates, use date-format %-m/%-d/%Y or date-format %-d/%-m/%Y"
]
where
@ -923,10 +918,10 @@ transactionFromCsvRecord sourcepos rules record = t
status =
case fieldval "status" of
Nothing -> Unmarked
Just s -> either statuserror id $ runParser (statusp <* eof) "" $ T.pack s
Just s -> either statuserror id $ runParser (statusp <* eof) "" s
where
statuserror err = error' $ unlines
["error: could not parse \""++s++"\" as a cleared status (should be *, ! or empty)"
["error: could not parse \""<>T.unpack s<>"\" as a cleared status (should be *, ! or empty)"
,"the parse error is: "++customErrorBundlePretty err
]
code = maybe "" singleline $ fieldval "code"
@ -934,14 +929,16 @@ transactionFromCsvRecord sourcepos rules record = t
comment = maybe "" singleline $ fieldval "comment"
precomment = maybe "" singleline $ fieldval "precomment"
singleline = T.unwords . filter (not . T.null) . map T.strip . T.lines
----------------------------------------------------------------------
-- 3. Generate the postings for which an account has been assigned
-- (possibly indirectly due to an amount or balance assignment)
p1IsVirtual = (accountNamePostingType . T.pack <$> fieldval "account1") == Just VirtualPosting
p1IsVirtual = (accountNamePostingType <$> fieldval "account1") == Just VirtualPosting
ps = [p | n <- [1..maxpostings]
,let comment = T.pack $ fromMaybe "" $ fieldval ("comment"++show n)
,let currency = fromMaybe "" (fieldval ("currency"++show n) <|> fieldval "currency")
,let comment = fromMaybe "" $ fieldval ("comment"<> T.pack (show n))
,let currency = fromMaybe "" (fieldval ("currency"<> T.pack (show n)) <|> fieldval "currency")
,let mamount = getAmount rules record currency p1IsVirtual n
,let mbalance = getBalance rules record currency n
,Just (acct,isfinal) <- [getAccount rules record mamount mbalance n] -- skips Nothings
@ -965,10 +962,10 @@ transactionFromCsvRecord sourcepos rules record = t
,tdate = date'
,tdate2 = mdate2'
,tstatus = status
,tcode = T.pack code
,tdescription = T.pack description
,tcomment = T.pack comment
,tprecedingcomment = T.pack precomment
,tcode = code
,tdescription = description
,tcomment = comment
,tprecedingcomment = precomment
,tpostings = ps
}
@ -979,7 +976,7 @@ transactionFromCsvRecord sourcepos rules record = t
-- For postings 1 or 2 it also looks at "amount", "amount-in", "amount-out".
-- If more than one of these has a value, it looks for one that is non-zero.
-- If there's multiple non-zeros, or no non-zeros but multiple zeros, it throws an error.
getAmount :: CsvRules -> CsvRecord -> String -> Bool -> Int -> Maybe MixedAmount
getAmount :: CsvRules -> CsvRecord -> Text -> Bool -> Int -> Maybe MixedAmount
getAmount rules record currency p1IsVirtual n =
-- Warning, many tricky corner cases here.
-- docs: hledger_csv.m4.md #### amount
@ -988,14 +985,15 @@ getAmount rules record currency p1IsVirtual n =
unnumberedfieldnames = ["amount","amount-in","amount-out"]
-- amount field names which can affect this posting
fieldnames = map (("amount"++show n)++) ["","-in","-out"]
fieldnames = map (("amount"<> T.pack(show n))<>) ["","-in","-out"]
-- For posting 1, also recognise the old amount/amount-in/amount-out names.
-- For posting 2, the same but only if posting 1 needs balancing.
++ if n==1 || n==2 && not p1IsVirtual then unnumberedfieldnames else []
-- assignments to any of these field names with non-empty values
assignments = [(f,a') | f <- fieldnames
, Just v@(_:_) <- [strip . renderTemplate rules record <$> hledgerField rules record f]
, Just v <- [T.strip . renderTemplate rules record <$> hledgerField rules record f]
, not $ T.null v
, let a = parseAmount rules record currency v
-- With amount/amount-in/amount-out, in posting 2,
-- flip the sign and convert to cost, as they did before 1.17
@ -1006,7 +1004,7 @@ getAmount rules record currency p1IsVirtual n =
assignments' | any isnumbered assignments = filter isnumbered assignments
| otherwise = assignments
where
isnumbered (f,_) = any (flip elem ['0'..'9']) f
isnumbered (f,_) = T.any (flip elem ['0'..'9']) f
-- if there's more than one value and only some are zeros, discard the zeros
assignments''
@ -1017,24 +1015,24 @@ getAmount rules record currency p1IsVirtual n =
in case -- dbg0 ("amounts for posting "++show n)
assignments'' of
[] -> Nothing
[(f,a)] | "-out" `isSuffixOf` f -> Just (-a) -- for -out fields, flip the sign
[(f,a)] | "-out" `T.isSuffixOf` f -> Just (-a) -- for -out fields, flip the sign
[(_,a)] -> Just a
fs -> error' $ unlines $ [ -- PARTIAL:
fs -> error' . T.unpack . T.unlines $ [ -- PARTIAL:
"multiple non-zero amounts or multiple zero amounts assigned,"
,"please ensure just one. (https://hledger.org/csv.html#amount)"
," " ++ showRecord record
," for posting: " ++ show n
," " <> showRecord record
," for posting: " <> T.pack (show n)
]
++ [" assignment: " ++ f ++ " " ++
fromMaybe "" (hledgerField rules record f) ++
"\t=> value: " ++ showMixedAmount a -- XXX not sure this is showing all the right info
++ [" assignment: " <> f <> " " <>
fromMaybe "" (hledgerField rules record f) <>
"\t=> value: " <> T.pack (showMixedAmount a) -- XXX not sure this is showing all the right info
| (f,a) <- fs]
-- | Figure out the expected balance (assertion or assignment) specified for posting N,
-- if any (and its parse position).
getBalance :: CsvRules -> CsvRecord -> String -> Int -> Maybe (Amount, GenericSourcePos)
getBalance :: CsvRules -> CsvRecord -> Text -> Int -> Maybe (Amount, GenericSourcePos)
getBalance rules record currency n = do
v <- (fieldval ("balance"++show n)
v <- (fieldval ("balance"<> T.pack (show n))
-- for posting 1, also recognise the old field name
<|> if n==1 then fieldval "balance" else Nothing)
case v of
@ -1043,30 +1041,29 @@ getBalance rules record currency n = do
parseBalanceAmount rules record currency n s
,nullsourcepos -- parse position to show when assertion fails,
) -- XXX the csv record's line number would be good
where
fieldval = fmap strip . hledgerFieldValue rules record :: HledgerFieldName -> Maybe String
fieldval = fmap T.strip . hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text
-- | Given a non-empty amount string (from CSV) to parse, along with a
-- possibly non-empty currency symbol to prepend,
-- parse as a hledger MixedAmount (as in journal format), or raise an error.
-- The whole CSV record is provided for the error message.
parseAmount :: CsvRules -> CsvRecord -> String -> String -> MixedAmount
parseAmount :: CsvRules -> CsvRecord -> Text -> Text -> MixedAmount
parseAmount rules record currency s =
either mkerror (Mixed . (:[])) $ -- PARTIAL:
runParser (evalStateT (amountp <* eof) journalparsestate) "" $
T.pack $ (currency++) $ simplifySign s
currency <> simplifySign s
where
journalparsestate = nulljournal{jparsedecimalmark=parseDecimalMark rules}
mkerror e = error' $ unlines
["error: could not parse \""++s++"\" as an amount"
mkerror e = error' . T.unpack $ T.unlines
["error: could not parse \"" <> s <> "\" as an amount"
,showRecord record
,showRules rules record
-- ,"the default-currency is: "++fromMaybe "unspecified" (getDirective "default-currency" rules)
,"the parse error is: "++customErrorBundlePretty e
,"you may need to "
++"change your amount*, balance*, or currency* rules, "
++"or add or change your skip rule"
,"the parse error is: " <> T.pack (customErrorBundlePretty e)
,"you may need to \
\change your amount*, balance*, or currency* rules, \
\or add or change your skip rule"
]
-- XXX unify these ^v
@ -1076,30 +1073,30 @@ parseAmount rules record currency s =
-- possibly non-empty currency symbol to prepend,
-- parse as a hledger Amount (as in journal format), or raise an error.
-- The CSV record and the field's numeric suffix are provided for the error message.
parseBalanceAmount :: CsvRules -> CsvRecord -> String -> Int -> String -> Amount
parseBalanceAmount :: CsvRules -> CsvRecord -> Text -> Int -> Text -> Amount
parseBalanceAmount rules record currency n s =
either (mkerror n s) id $
runParser (evalStateT (amountp <* eof) journalparsestate) "" $
T.pack $ (currency++) $ simplifySign s
currency <> simplifySign s
-- the csv record's line number would be good
where
journalparsestate = nulljournal{jparsedecimalmark=parseDecimalMark rules}
mkerror n s e = error' $ unlines
["error: could not parse \""++s++"\" as balance"++show n++" amount"
mkerror n s e = error' . T.unpack $ T.unlines
["error: could not parse \"" <> s <> "\" as balance"<> T.pack (show n) <> " amount"
,showRecord record
,showRules rules record
-- ,"the default-currency is: "++fromMaybe "unspecified" mdefaultcurrency
,"the parse error is: "++customErrorBundlePretty e
,"the parse error is: "<> T.pack (customErrorBundlePretty e)
]
-- Read a valid decimal mark from the decimal-mark rule, if any.
-- If the rule is present with an invalid argument, raise an error.
parseDecimalMark :: CsvRules -> Maybe DecimalMark
parseDecimalMark rules =
case rules `csvRule` "decimal-mark" of
Nothing -> Nothing
Just [c] | isDecimalMark c -> Just c
Just s -> error' $ "decimal-mark's argument should be \".\" or \",\" (not \""++s++"\")"
parseDecimalMark rules = do
s <- rules `csvRule` "decimal-mark"
case T.uncons s of
Just (c, rest) | T.null rest && isDecimalMark c -> return c
_ -> error' . T.unpack $ "decimal-mark's argument should be \".\" or \",\" (not \""<>s<>"\")"
-- | Make a balance assertion for the given amount, with the given parse
-- position (to be shown in assertion failures), with the assertion type
@ -1116,8 +1113,8 @@ mkBalanceAssertion rules record (amt, pos) = assrt{baamount=amt, baposition=pos}
Just "==" -> nullassertion{batotal=True}
Just "=*" -> nullassertion{bainclusive=True}
Just "==*" -> nullassertion{batotal=True, bainclusive=True}
Just x -> error' $ unlines -- PARTIAL:
[ "balance-type \"" ++ x ++"\" is invalid. Use =, ==, =* or ==*."
Just x -> error' . T.unpack $ T.unlines -- PARTIAL:
[ "balance-type \"" <> x <>"\" is invalid. Use =, ==, =* or ==*."
, showRecord record
, showRules rules record
]
@ -1128,8 +1125,8 @@ mkBalanceAssertion rules record (amt, pos) = assrt{baamount=amt, baposition=pos}
getAccount :: CsvRules -> CsvRecord -> Maybe MixedAmount -> Maybe (Amount, GenericSourcePos) -> Int -> Maybe (AccountName, Bool)
getAccount rules record mamount mbalance n =
let
fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe String
maccount = T.pack <$> fieldval ("account"++show n)
fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text
maccount = fieldval ("account"<> T.pack (show n))
in case maccount of
-- accountN is set to the empty string - no posting will be generated
Just "" -> Nothing
@ -1150,7 +1147,7 @@ getAccount rules record mamount mbalance n =
unknownExpenseAccount = "expenses:unknown"
unknownIncomeAccount = "income:unknown"
type CsvAmountString = String
type CsvAmountString = Text
-- | Canonicalise the sign in a CSV amount string.
-- Such strings can have a minus sign, negating parentheses,
@ -1171,18 +1168,20 @@ type CsvAmountString = String
-- >>> simplifySign "((1))"
-- "1"
simplifySign :: CsvAmountString -> CsvAmountString
simplifySign ('(':s) | lastMay s == Just ')' = simplifySign $ negateStr $ init s
simplifySign ('-':'(':s) | lastMay s == Just ')' = simplifySign $ init s
simplifySign ('-':'-':s) = s
simplifySign s = s
simplifySign amtstr
| Just ('(',t) <- T.uncons amtstr, Just (amt,')') <- T.unsnoc t = simplifySign $ negateStr amt
| Just ('-',b) <- T.uncons amtstr, Just ('(',t) <- T.uncons b, Just (amt,')') <- T.unsnoc t = simplifySign amt
| Just ('-',m) <- T.uncons amtstr, Just ('-',amt) <- T.uncons m = amt
| otherwise = amtstr
negateStr :: String -> String
negateStr ('-':s) = s
negateStr s = '-':s
negateStr :: Text -> Text
negateStr amtstr = case T.uncons amtstr of
Just ('-',s) -> s
_ -> T.cons '-' amtstr
-- | Show a (approximate) recreation of the original CSV record.
showRecord :: CsvRecord -> String
showRecord r = "record values: "++intercalate "," (map show r)
showRecord :: CsvRecord -> Text
showRecord r = "record values: "<>T.intercalate "," (map (wrap "\"" "\"") r)
-- | Given the conversion rules, a CSV record and a hledger field name, find
-- the value template ultimately assigned to this field, if any, by a field
@ -1217,47 +1216,48 @@ getEffectiveAssignment rules record f = lastMay $ map snd $ assignments
-- - any quotes enclosing field values are removed
-- - and the field separator is always comma
-- which means that a field containing a comma will look like two fields.
wholecsvline = dbg7 "wholecsvline" $ intercalate "," record
matcherMatches (FieldMatcher _ csvfieldref pat) = regexMatch pat csvfieldvalue
wholecsvline = dbg7 "wholecsvline" . T.unpack $ T.intercalate "," record
matcherMatches (FieldMatcher _ csvfieldref pat) = regexMatch pat $ T.unpack csvfieldvalue
where
-- the value of the referenced CSV field to match against.
csvfieldvalue = dbg7 "csvfieldvalue" $ replaceCsvFieldReference rules record csvfieldref
-- | Render a field assignment's template, possibly interpolating referenced
-- CSV field values. Outer whitespace is removed from interpolated values.
renderTemplate :: CsvRules -> CsvRecord -> FieldTemplate -> String
renderTemplate rules record t = maybe t concat $ parseMaybe
renderTemplate :: CsvRules -> CsvRecord -> FieldTemplate -> Text
renderTemplate rules record t = maybe t mconcat $ parseMaybe
(many $ takeWhile1P Nothing (/='%')
<|> replaceCsvFieldReference rules record <$> referencep)
t
where
referencep = liftA2 (:) (char '%') (takeWhile1P (Just "reference") isDescriptorChar) :: Parsec CustomErr String String
referencep = liftA2 T.cons (char '%') (takeWhile1P (Just "reference") isDescriptorChar) :: Parsec CustomErr Text Text
isDescriptorChar c = isAscii c && (isAlphaNum c || c == '_' || c == '-')
-- | Replace something that looks like a reference to a csv field ("%date" or "%1)
-- with that field's value. If it doesn't look like a field reference, or if we
-- can't find such a field, leave it unchanged.
replaceCsvFieldReference :: CsvRules -> CsvRecord -> CsvFieldReference -> String
replaceCsvFieldReference rules record s@('%':fieldname) = fromMaybe s $ csvFieldValue rules record fieldname
replaceCsvFieldReference _ _ s = s
replaceCsvFieldReference :: CsvRules -> CsvRecord -> CsvFieldReference -> Text
replaceCsvFieldReference rules record s = case T.uncons s of
Just ('%', fieldname) -> fromMaybe s $ csvFieldValue rules record fieldname
_ -> s
-- | Get the (whitespace-stripped) value of a CSV field, identified by its name or
-- column number, ("date" or "1"), from the given CSV record, if such a field exists.
csvFieldValue :: CsvRules -> CsvRecord -> CsvFieldName -> Maybe String
csvFieldValue :: CsvRules -> CsvRecord -> CsvFieldName -> Maybe Text
csvFieldValue rules record fieldname = do
fieldindex <- if | all isDigit fieldname -> readMay fieldname
| otherwise -> lookup (map toLower fieldname) $ rcsvfieldindexes rules
fieldvalue <- strip <$> atMay record (fieldindex-1)
fieldindex <- if | T.all isDigit fieldname -> readMay $ T.unpack fieldname
| otherwise -> lookup (T.toLower fieldname) $ rcsvfieldindexes rules
fieldvalue <- T.strip <$> atMay record (fieldindex-1)
return fieldvalue
-- | Parse the date string using the specified date-format, or if unspecified
-- the "simple date" formats (YYYY/MM/DD, YYYY-MM-DD, YYYY.MM.DD, leading
-- zeroes optional).
parseDateWithCustomOrDefaultFormats :: Maybe DateFormat -> String -> Maybe Day
parseDateWithCustomOrDefaultFormats :: Maybe DateFormat -> Text -> Maybe Day
parseDateWithCustomOrDefaultFormats mformat s = asum $ map parsewith formats
where
parsewith = flip (parseTimeM True defaultTimeLocale) s
formats = maybe
parsewith = flip (parseTimeM True defaultTimeLocale) (T.unpack s)
formats = map T.unpack $ maybe
["%Y/%-m/%-d"
,"%Y-%-m-%-d"
,"%Y.%-m.%-d"

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

@ -351,13 +351,13 @@ budgetReportAsCsv
-- heading row
("Account" :
concatMap (\span -> [T.unpack $ showDateSpan span, "budget"]) colspans
concatMap (\span -> [showDateSpan span, "budget"]) colspans
++ concat [["Total" ,"budget"] | row_total_]
++ concat [["Average","budget"] | average_]
) :
-- account rows
[T.unpack (displayFull a) :
[displayFull a :
map showmamt (flattentuples abamts)
++ concat [[showmamt mactualrowtot, showmamt mbudgetrowtot] | row_total_]
++ concat [[showmamt mactualrowavg, showmamt mbudgetrowavg] | average_]
@ -377,7 +377,7 @@ budgetReportAsCsv
where
flattentuples abs = concat [[a,b] | (a,b) <- abs]
showmamt = maybe "" (showMixedAmountOneLineWithoutPrice False)
showmamt = maybe "" (T.pack . showMixedAmountOneLineWithoutPrice False)
-- tests

5
hledger-lib/hledger-lib.cabal
View File

@ -1,6 +1,6 @@
cabal-version: 1.12
-- This file has been generated from package.yaml by hpack version 0.33.0.
-- This file has been generated from package.yaml by hpack version 0.34.2.
--
-- see: https://github.com/sol/hpack
--
@ -125,7 +125,6 @@ library
, pretty-simple >4 && <5
, regex-tdfa
, safe >=0.2
, split >=0.1
, tabular >=0.2
, tasty >=1.2.3
, tasty-hunit >=0.10.0.2
@ -176,7 +175,6 @@ test-suite doctest
, pretty-simple >4 && <5
, regex-tdfa
, safe >=0.2
, split >=0.1
, tabular >=0.2
, tasty >=1.2.3
, tasty-hunit >=0.10.0.2
@ -229,7 +227,6 @@ test-suite unittest
, pretty-simple >4 && <5
, regex-tdfa
, safe >=0.2
, split >=0.1
, tabular >=0.2
, tasty >=1.2.3
, tasty-hunit >=0.10.0.2

1
hledger-lib/package.yaml
View File

@ -58,7 +58,6 @@ dependencies:
- pretty-simple >4 && <5
- regex-tdfa
- safe >=0.2
- split >=0.1
- tabular >=0.2
- tasty >=1.2.3
- tasty-hunit >=0.10.0.2

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

@ -113,7 +113,7 @@ aregister opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
reverse items
-- select renderer
render | fmt=="txt" = accountTransactionsReportAsText opts reportq thisacctq
| fmt=="csv" = TL.pack . printCSV . accountTransactionsReportAsCsv reportq thisacctq
| fmt=="csv" = printCSV . accountTransactionsReportAsCsv reportq thisacctq
| fmt=="json" = toJsonText
| otherwise = error' $ unsupportedOutputFormatError fmt -- PARTIAL:
where
@ -130,14 +130,12 @@ accountTransactionsReportItemAsCsvRecord :: Query -> Query -> AccountTransaction
accountTransactionsReportItemAsCsvRecord
reportq thisacctq
(t@Transaction{tindex,tcode,tdescription}, _, _issplit, otheracctsstr, change, balance)
= [idx,date,code,desc,T.unpack otheracctsstr,amt,bal]
= [idx,date,tcode,tdescription,otheracctsstr,amt,bal]
where
idx = show tindex
date = T.unpack . showDate $ transactionRegisterDate reportq thisacctq t
code = T.unpack tcode
desc = T.unpack tdescription
amt = showMixedAmountOneLineWithoutPrice False change
bal = showMixedAmountOneLineWithoutPrice False balance
idx = T.pack $ show tindex
date = showDate $ transactionRegisterDate reportq thisacctq t
amt = T.pack $ showMixedAmountOneLineWithoutPrice False change
bal = T.pack $ showMixedAmountOneLineWithoutPrice False balance
-- | Render a register report as plain text suitable for console output.
accountTransactionsReportAsText :: CliOpts -> Query -> Query -> AccountTransactionsReport -> TL.Text

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

@ -321,8 +321,8 @@ balance opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
assrt = not $ ignore_assertions_ $ inputopts_ opts
render = case fmt of
"txt" -> budgetReportAsText ropts
"json" -> (++"\n") . TL.unpack . toJsonText
"csv" -> (++"\n") . printCSV . budgetReportAsCsv ropts
"json" -> TL.unpack . (<>"\n") . toJsonText
"csv" -> TL.unpack . printCSV . budgetReportAsCsv ropts
_ -> const $ error' $ unsupportedOutputFormatError fmt
writeOutput opts $ render budgetreport
@ -330,21 +330,21 @@ balance opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
if multiperiod then do -- multi period balance report
let report = multiBalanceReport rspec j
render = case fmt of
"txt" -> multiBalanceReportAsText ropts
"csv" -> (++"\n") . printCSV . multiBalanceReportAsCsv ropts
"html" -> (++"\n") . TL.unpack . L.renderText . multiBalanceReportAsHtml ropts
"json" -> (++"\n") . TL.unpack . toJsonText
"txt" -> TL.pack . multiBalanceReportAsText ropts
"csv" -> printCSV . multiBalanceReportAsCsv ropts
"html" -> (<>"\n") . L.renderText . multiBalanceReportAsHtml ropts
"json" -> (<>"\n") . toJsonText
_ -> const $ error' $ unsupportedOutputFormatError fmt -- PARTIAL:
writeOutput opts $ render report
writeOutputLazyText opts $ render report
else do -- single period simple balance report
let report = balanceReport rspec j -- simple Ledger-style balance report
render = case fmt of
"txt" -> balanceReportAsText
"csv" -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r
"json" -> const $ (++"\n") . TL.unpack . toJsonText
_ -> const $ error' $ unsupportedOutputFormatError fmt -- PARTIAL:
writeOutput opts $ render ropts report
"txt" -> \ropts -> TL.pack . balanceReportAsText ropts
"csv" -> \ropts -> printCSV . balanceReportAsCsv ropts
"json" -> const $ (<>"\n") . toJsonText
_ -> error' $ unsupportedOutputFormatError fmt -- PARTIAL:
writeOutputLazyText opts $ render ropts report
-- XXX should all the per-report, per-format rendering code live in the command module,
@ -356,11 +356,11 @@ balance opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
balanceReportAsCsv :: ReportOpts -> BalanceReport -> CSV
balanceReportAsCsv opts (items, total) =
["account","balance"] :
[[T.unpack a, showMixedAmountOneLineWithoutPrice False b] | (a, _, _, b) <- items]
[[a, T.pack $ showMixedAmountOneLineWithoutPrice False b] | (a, _, _, b) <- items]
++
if no_total_ opts
then []
else [["total", showMixedAmountOneLineWithoutPrice False total]]
else [["total", T.pack $ showMixedAmountOneLineWithoutPrice False total]]
-- | Render a single-column balance report as plain text.
balanceReportAsText :: ReportOpts -> BalanceReport -> String
@ -446,12 +446,12 @@ multiBalanceReportAsCsv :: ReportOpts -> MultiBalanceReport -> CSV
multiBalanceReportAsCsv opts@ReportOpts{average_, row_total_}
(PeriodicReport colspans items (PeriodicReportRow _ coltotals tot avg)) =
maybetranspose $
("Account" : map (T.unpack . showDateSpan) colspans
("Account" : map showDateSpan colspans
++ ["Total" | row_total_]
++ ["Average" | average_]
) :
[T.unpack (displayFull a) :
map (showMixedAmountOneLineWithoutPrice False)
[displayFull a :
map (T.pack . showMixedAmountOneLineWithoutPrice False)
(amts
++ [rowtot | row_total_]
++ [rowavg | average_])
@ -460,7 +460,7 @@ multiBalanceReportAsCsv opts@ReportOpts{average_, row_total_}
if no_total_ opts
then []
else ["Total:" :
map (showMixedAmountOneLineWithoutPrice False) (
map (T.pack . showMixedAmountOneLineWithoutPrice False) (
coltotals
++ [tot | row_total_]
++ [avg | average_]
@ -496,7 +496,7 @@ multiBalanceReportHtmlRows ropts mbr =
)
-- | Render one MultiBalanceReport heading row as a HTML table row.
multiBalanceReportHtmlHeadRow :: ReportOpts -> [String] -> Html ()
multiBalanceReportHtmlHeadRow :: ReportOpts -> [T.Text] -> Html ()
multiBalanceReportHtmlHeadRow _ [] = mempty -- shouldn't happen
multiBalanceReportHtmlHeadRow ropts (acct:rest) =
let
@ -514,7 +514,7 @@ multiBalanceReportHtmlHeadRow ropts (acct:rest) =
++ [td_ [class_ "rowaverage", defstyle] (toHtml a) | a <- avg]
-- | Render one MultiBalanceReport data row as a HTML table row.
multiBalanceReportHtmlBodyRow :: ReportOpts -> [String] -> Html ()
multiBalanceReportHtmlBodyRow :: ReportOpts -> [T.Text] -> Html ()
multiBalanceReportHtmlBodyRow _ [] = mempty -- shouldn't happen
multiBalanceReportHtmlBodyRow ropts (label:rest) =
let
@ -532,7 +532,7 @@ multiBalanceReportHtmlBodyRow ropts (label:rest) =
++ [td_ [class_ "amount rowaverage", defstyle] (toHtml a) | a <- avg]
-- | Render one MultiBalanceReport totals row as a HTML table row.
multiBalanceReportHtmlFootRow :: ReportOpts -> [String] -> Html ()
multiBalanceReportHtmlFootRow :: ReportOpts -> [T.Text] -> Html ()
multiBalanceReportHtmlFootRow _ropts [] = mempty
-- TODO pad totals row with zeros when subreport is empty
-- multiBalanceReportHtmlFootRow ropts $

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

@ -60,7 +60,7 @@ printEntries opts@CliOpts{reportspec_=rspec} j =
where
fmt = outputFormatFromOpts opts
render | fmt=="txt" = entriesReportAsText opts
| fmt=="csv" = TL.pack . printCSV . entriesReportAsCsv
| fmt=="csv" = printCSV . entriesReportAsCsv
| fmt=="json" = toJsonText
| fmt=="sql" = entriesReportAsSql
| otherwise = error' $ unsupportedOutputFormatError fmt -- PARTIAL:
@ -137,9 +137,7 @@ entriesReportAsSql txns = TB.toLazyText $ mconcat
where
values vs = TB.fromText "(" <> mconcat (intersperse (TB.fromText ",") $ map toSql vs) <> TB.fromText ")\n"
toSql "" = TB.fromText "NULL"
toSql s = TB.fromText "'" <> TB.fromString (concatMap quoteChar s) <> TB.fromText "'"
quoteChar '\'' = "''"
quoteChar c = [c]
toSql s = TB.fromText "'" <> TB.fromText (T.replace "'" "''" s) <> TB.fromText "'"
csv = concatMap transactionToCSV txns
entriesReportAsCsv :: EntriesReport -> CSV
@ -151,16 +149,16 @@ entriesReportAsCsv txns =
-- The txnidx field (transaction index) allows postings to be grouped back into transactions.
transactionToCSV :: Transaction -> CSV
transactionToCSV t =
map (\p -> show idx:date:date2:status:code:description:comment:p)
map (\p -> T.pack (show idx):date:date2:status:code:description:comment:p)
(concatMap postingToCSV $ tpostings t)
where
idx = tindex t
description = T.unpack $ tdescription 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
description = tdescription t
date = showDate (tdate t)
date2 = maybe "" showDate $ tdate2 t
status = T.pack . show $ tstatus t
code = tcode t
comment = T.strip $ tcomment t
postingToCSV :: Posting -> CSV
postingToCSV p =
@ -168,17 +166,16 @@ postingToCSV p =
-- commodity goes into separate column, so we suppress it, along with digit group
-- separators and prices
let a_ = a{acommodity="",astyle=(astyle a){asdigitgroups=Nothing},aprice=Nothing} in
let amount = showAmount a_ in
let commodity = T.unpack c in
let credit = if q < 0 then showAmount $ negate a_ else "" in
let debit = if q >= 0 then showAmount a_ else "" in
[account, amount, commodity, credit, debit, status, comment])
let amount = T.pack $ showAmount a_ in
let credit = if q < 0 then T.pack . showAmount $ negate a_ else "" in
let debit = if q >= 0 then T.pack $ showAmount a_ else "" in
[account, amount, c, credit, debit, status, comment])
amounts
where
Mixed amounts = pamount p
status = show $ pstatus p
account = T.unpack $ showAccountName Nothing (ptype p) (paccount p)
comment = T.unpack . textChomp . T.strip $ pcomment p
status = T.pack . show $ pstatus p
account = showAccountName Nothing (ptype p) (paccount p)
comment = T.strip $ pcomment p
-- --match

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

@ -64,7 +64,7 @@ register opts@CliOpts{reportspec_=rspec} j =
where
fmt = outputFormatFromOpts opts
render | fmt=="txt" = postingsReportAsText opts
| fmt=="csv" = TL.pack . printCSV . postingsReportAsCsv
| fmt=="csv" = printCSV . postingsReportAsCsv
| fmt=="json" = toJsonText
| otherwise = error' $ unsupportedOutputFormatError fmt -- PARTIAL:
@ -77,18 +77,18 @@ postingsReportAsCsv is =
postingsReportItemAsCsvRecord :: PostingsReportItem -> CsvRecord
postingsReportItemAsCsvRecord (_, _, _, p, b) = [idx,date,code,desc,acct,amt,bal]
where
idx = show $ maybe 0 tindex $ ptransaction p
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
acct = T.unpack . bracket $ paccount p
idx = T.pack . show . maybe 0 tindex $ ptransaction p
date = showDate $ postingDate p -- XXX csv should show date2 with --date2
code = maybe "" tcode $ ptransaction p
desc = maybe "" tdescription $ ptransaction p
acct = bracket $ paccount p
where
bracket = case ptype p of
BalancedVirtualPosting -> wrap "[" "]"
VirtualPosting -> wrap "(" ")"
_ -> id
amt = showMixedAmountOneLineWithoutPrice False $ pamount p
bal = showMixedAmountOneLineWithoutPrice False b
amt = T.pack $ showMixedAmountOneLineWithoutPrice False $ pamount p
bal = T.pack $ showMixedAmountOneLineWithoutPrice False b
-- | Render a register report as plain text suitable for console output.
postingsReportAsText :: CliOpts -> PostingsReport -> TL.Text

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

@ -154,7 +154,7 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportspec_=r
-- render appropriately
render = case outputFormatFromOpts opts of
"txt" -> TL.pack . compoundBalanceReportAsText ropts'
"csv" -> TL.pack . printCSV . compoundBalanceReportAsCsv ropts'
"csv" -> printCSV . compoundBalanceReportAsCsv ropts'
"html" -> L.renderText . compoundBalanceReportAsHtml ropts'
"json" -> toJsonText
x -> error' $ unsupportedOutputFormatError x
@ -231,17 +231,17 @@ concatTables (Table hLeft hTop dat) (Table hLeft' _ dat') =
compoundBalanceReportAsCsv :: ReportOpts -> CompoundPeriodicReport DisplayName MixedAmount -> CSV
compoundBalanceReportAsCsv ropts (CompoundPeriodicReport title colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg)) =
addtotals $
padRow title :
map T.unpack ("Account" :
map showDateSpanMonthAbbrev colspans
padRow (T.pack title)
: ( "Account"
: map showDateSpanMonthAbbrev colspans
++ (if row_total_ ropts then ["Total"] else [])
++ (if average_ ropts then ["Average"] else [])
) :
concatMap (subreportAsCsv ropts) subreports
)
: concatMap (subreportAsCsv ropts) subreports
where
-- | Add a subreport title row and drop the heading row.
subreportAsCsv ropts (subreporttitle, multibalreport, _) =
padRow subreporttitle :
padRow (T.pack subreporttitle) :
tail (multiBalanceReportAsCsv ropts multibalreport)
padRow s = take numcols $ s : repeat ""
where
@ -257,7 +257,7 @@ compoundBalanceReportAsCsv ropts (CompoundPeriodicReport title colspans subrepor
| no_total_ ropts || length subreports == 1 = id
| otherwise = (++
["Net:" :
map (showMixedAmountOneLineWithoutPrice False) (
map (T.pack . showMixedAmountOneLineWithoutPrice False) (
coltotals
++ (if row_total_ ropts then [grandtotal] else [])
++ (if average_ ropts then [grandavg] else [])