mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-20 02:37:12 +03:00
lib,cli: Use Text for CSV values.
This commit is contained in:
parent
e3ec01c3c6
commit
541c4fc18c
@ -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"
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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 $
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
@ -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 [])
|
||||
|
Loading…
Reference in New Issue
Block a user