mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-20 02:37:12 +03:00
lib,cli,ui: Replace some uses of String with Text, get rid of some unpacks, clean up showMixed options.
This commit is contained in:
Stephen Morgan
parent
07a7c3d3a8
commit
e4e533eb9f
@ -30,8 +30,8 @@ instance Show Account where
|
||||
aname
|
||||
(if aboring then "y" else "n" :: String)
|
||||
anumpostings
|
||||
(showMixedAmount aebalance)
|
||||
(showMixedAmount aibalance)
|
||||
(wbUnpack $ showMixed noColour aebalance)
|
||||
(wbUnpack $ showMixed noColour aibalance)
|
||||
|
||||
instance Eq Account where
|
||||
(==) a b = aname a == aname b -- quick equality test for speed
|
||||
@ -265,6 +265,6 @@ showAccountsBoringFlag = unlines . map (show . aboring) . flattenAccounts
|
||||
|
||||
showAccountDebug a = printf "%-25s %4s %4s %s"
|
||||
(aname a)
|
||||
(showMixedAmount $ aebalance a)
|
||||
(showMixedAmount $ aibalance a)
|
||||
(wbUnpack . showMixed noColour $ aebalance a)
|
||||
(wbUnpack . showMixed noColour $ aibalance a)
|
||||
(if aboring a then "b" else " " :: String)
|
||||
|
||||
@ -208,31 +208,31 @@ clipOrEllipsifyAccountName (Just 0) = const "..."
|
||||
clipOrEllipsifyAccountName n = clipAccountName n
|
||||
|
||||
-- | Escape an AccountName for use within a regular expression.
|
||||
-- >>> putStr $ escapeName "First?!#$*?$(*) !@^#*? %)*!@#"
|
||||
-- >>> putStr . T.unpack $ escapeName "First?!#$*?$(*) !@^#*? %)*!@#"
|
||||
-- First\?!#\$\*\?\$\(\*\) !@\^#\*\? %\)\*!@#
|
||||
escapeName :: AccountName -> String
|
||||
escapeName = T.unpack . T.concatMap escapeChar
|
||||
escapeName :: AccountName -> Text
|
||||
escapeName = T.concatMap escapeChar
|
||||
where
|
||||
escapeChar c = if c `elem` escapedChars then T.snoc "\\" c else T.singleton c
|
||||
escapedChars = ['[', '?', '+', '|', '(', ')', '*', '$', '^', '\\']
|
||||
|
||||
-- | Convert an account name to a regular expression matching it and its subaccounts.
|
||||
accountNameToAccountRegex :: AccountName -> Regexp
|
||||
accountNameToAccountRegex a = toRegex' $ '^' : escapeName a ++ "(:|$)" -- PARTIAL: Is this safe after escapeName?
|
||||
accountNameToAccountRegex a = toRegex' $ "^" <> escapeName a <> "(:|$)" -- PARTIAL: Is this safe after escapeName?
|
||||
|
||||
-- | Convert an account name to a regular expression matching it and its subaccounts,
|
||||
-- case insensitively.
|
||||
accountNameToAccountRegexCI :: AccountName -> Regexp
|
||||
accountNameToAccountRegexCI a = toRegexCI' $ '^' : escapeName a ++ "(:|$)" -- PARTIAL: Is this safe after escapeName?
|
||||
accountNameToAccountRegexCI a = toRegexCI' $ "^" <> escapeName a <> "(:|$)" -- PARTIAL: Is this safe after escapeName?
|
||||
|
||||
-- | Convert an account name to a regular expression matching it but not its subaccounts.
|
||||
accountNameToAccountOnlyRegex :: AccountName -> Regexp
|
||||
accountNameToAccountOnlyRegex a = toRegex' $ '^' : escapeName a ++ "$" -- PARTIAL: Is this safe after escapeName?
|
||||
accountNameToAccountOnlyRegex a = toRegex' $ "^" <> escapeName a <> "$" -- PARTIAL: Is this safe after escapeName?
|
||||
|
||||
-- | Convert an account name to a regular expression matching it but not its subaccounts,
|
||||
-- case insensitively.
|
||||
accountNameToAccountOnlyRegexCI :: AccountName -> Regexp
|
||||
accountNameToAccountOnlyRegexCI a = toRegexCI' $ '^' : escapeName a ++ "$" -- PARTIAL: Is this safe after escapeName?
|
||||
accountNameToAccountOnlyRegexCI a = toRegexCI' $ "^" <> escapeName a <> "$" -- PARTIAL: Is this safe after escapeName?
|
||||
|
||||
-- -- | Does this string look like an exact account-matching regular expression ?
|
||||
--isAccountRegex :: String -> Bool
|
||||
|
||||
@ -167,9 +167,13 @@ data AmountDisplayOpts = AmountDisplayOpts
|
||||
, displayMaxWidth :: Maybe Int -- ^ Maximum width to clip to
|
||||
} deriving (Show)
|
||||
|
||||
instance Default AmountDisplayOpts where
|
||||
def = AmountDisplayOpts { displayPrice = True
|
||||
, displayColour = True
|
||||
-- | Display Amount and MixedAmount with no colour.
|
||||
instance Default AmountDisplayOpts where def = noColour
|
||||
|
||||
-- | Display Amount and MixedAmount with no colour.
|
||||
noColour :: AmountDisplayOpts
|
||||
noColour = AmountDisplayOpts { displayPrice = True
|
||||
, displayColour = False
|
||||
, displayZeroCommodity = False
|
||||
, displayNormalised = True
|
||||
, displayOneLine = False
|
||||
@ -177,10 +181,6 @@ instance Default AmountDisplayOpts where
|
||||
, displayMaxWidth = Nothing
|
||||
}
|
||||
|
||||
-- | Display Amount and MixedAmount with no colour.
|
||||
noColour :: AmountDisplayOpts
|
||||
noColour = def{displayColour=False}
|
||||
|
||||
-- | Display Amount and MixedAmount with no prices.
|
||||
noPrice :: AmountDisplayOpts
|
||||
noPrice = def{displayPrice=False}
|
||||
@ -427,7 +427,7 @@ cshowAmount = wbUnpack . showAmountB def
|
||||
|
||||
-- | Get the string representation of an amount, without any \@ price.
|
||||
showAmountWithoutPrice :: Amount -> String
|
||||
showAmountWithoutPrice = wbUnpack . showAmountB noPrice{displayColour=False}
|
||||
showAmountWithoutPrice = wbUnpack . showAmountB noPrice
|
||||
|
||||
-- | Like showAmount, but show a zero amount's commodity if it has one.
|
||||
showAmountWithZeroCommodity :: Amount -> String
|
||||
@ -669,7 +669,7 @@ showMixedAmount = wbUnpack . showMixed noColour
|
||||
|
||||
-- | Get the one-line string representation of a mixed amount.
|
||||
showMixedAmountOneLine :: MixedAmount -> String
|
||||
showMixedAmountOneLine = wbUnpack . showMixed oneLine{displayColour=False}
|
||||
showMixedAmountOneLine = wbUnpack . showMixed oneLine
|
||||
|
||||
-- | Like showMixedAmount, but zero amounts are shown with their
|
||||
-- commodity if they have one.
|
||||
|
||||
@ -161,7 +161,7 @@ originalPosting p = fromMaybe p $ poriginal p
|
||||
-- XXX once rendered user output, but just for debugging now; clean up
|
||||
showPosting :: Posting -> String
|
||||
showPosting p@Posting{paccount=a,pamount=amt,ptype=t} =
|
||||
unlines $ [concatTopPadded [show (postingDate p) ++ " ", showaccountname a ++ " ", showamount amt, showComment (pcomment p)]]
|
||||
unlines $ [concatTopPadded [show (postingDate p) ++ " ", showaccountname a ++ " ", showamount amt, T.unpack . showComment $ pcomment p]]
|
||||
where
|
||||
ledger3ishlayout = False
|
||||
acctnamewidth = if ledger3ishlayout then 25 else 22
|
||||
@ -173,8 +173,8 @@ showPosting p@Posting{paccount=a,pamount=amt,ptype=t} =
|
||||
showamount = wbUnpack . showMixed noColour{displayMinWidth=Just 12}
|
||||
|
||||
|
||||
showComment :: Text -> String
|
||||
showComment t = if T.null t then "" else " ;" ++ T.unpack t
|
||||
showComment :: Text -> Text
|
||||
showComment t = if T.null t then "" else " ;" <> t
|
||||
|
||||
isReal :: Posting -> Bool
|
||||
isReal p = ptype p == RegularPosting
|
||||
|
||||
@ -66,6 +66,7 @@ import Data.Maybe (fromMaybe, isJust, mapMaybe)
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Monoid ((<>))
|
||||
#endif
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar (Day, fromGregorian )
|
||||
import Safe (readDef, readMay, maximumByMay, maximumMay, minimumMay)
|
||||
@ -107,11 +108,11 @@ data Query = Any -- ^ always match
|
||||
instance Default Query where def = Any
|
||||
|
||||
-- | Construct a payee tag
|
||||
payeeTag :: Maybe String -> Either RegexError Query
|
||||
payeeTag :: Maybe Text -> Either RegexError Query
|
||||
payeeTag = fmap (Tag (toRegexCI' "payee")) . maybe (pure Nothing) (fmap Just . toRegexCI)
|
||||
|
||||
-- | Construct a note tag
|
||||
noteTag :: Maybe String -> Either RegexError Query
|
||||
noteTag :: Maybe Text -> Either RegexError Query
|
||||
noteTag = fmap (Tag (toRegexCI' "note")) . maybe (pure Nothing) (fmap Just . toRegexCI)
|
||||
|
||||
-- | Construct a generated-transaction tag
|
||||
@ -262,11 +263,11 @@ parseQueryTerm d (T.stripPrefix "not:" -> Just s) =
|
||||
Right (Left m) -> Right $ Left $ Not m
|
||||
Right (Right _) -> Right $ Left Any -- not:somequeryoption will be ignored
|
||||
Left err -> Left err
|
||||
parseQueryTerm _ (T.stripPrefix "code:" -> Just s) = Left . Code <$> toRegexCI (T.unpack s)
|
||||
parseQueryTerm _ (T.stripPrefix "desc:" -> Just s) = Left . Desc <$> toRegexCI (T.unpack s)
|
||||
parseQueryTerm _ (T.stripPrefix "payee:" -> Just s) = Left <$> payeeTag (Just $ T.unpack s)
|
||||
parseQueryTerm _ (T.stripPrefix "note:" -> Just s) = Left <$> noteTag (Just $ T.unpack s)
|
||||
parseQueryTerm _ (T.stripPrefix "acct:" -> Just s) = Left . Acct <$> toRegexCI (T.unpack s)
|
||||
parseQueryTerm _ (T.stripPrefix "code:" -> Just s) = Left . Code <$> toRegexCI s
|
||||
parseQueryTerm _ (T.stripPrefix "desc:" -> Just s) = Left . Desc <$> toRegexCI s
|
||||
parseQueryTerm _ (T.stripPrefix "payee:" -> Just s) = Left <$> payeeTag (Just s)
|
||||
parseQueryTerm _ (T.stripPrefix "note:" -> Just s) = Left <$> noteTag (Just s)
|
||||
parseQueryTerm _ (T.stripPrefix "acct:" -> Just s) = Left . Acct <$> toRegexCI s
|
||||
parseQueryTerm d (T.stripPrefix "date2:" -> Just s) =
|
||||
case parsePeriodExpr d s of Left e -> Left $ "\"date2:"++T.unpack s++"\" gave a "++showDateParseError e
|
||||
Right (_,span) -> Right $ Left $ Date2 span
|
||||
@ -283,7 +284,7 @@ parseQueryTerm _ (T.stripPrefix "depth:" -> Just s)
|
||||
| otherwise = Left "depth: should have a positive number"
|
||||
where n = readDef 0 (T.unpack s)
|
||||
|
||||
parseQueryTerm _ (T.stripPrefix "cur:" -> Just s) = Left . Sym <$> toRegexCI ('^' : T.unpack s ++ "$") -- support cur: as an alias
|
||||
parseQueryTerm _ (T.stripPrefix "cur:" -> Just s) = Left . Sym <$> toRegexCI ("^" <> s <> "$") -- support cur: as an alias
|
||||
parseQueryTerm _ (T.stripPrefix "tag:" -> Just s) = Left <$> parseTag s
|
||||
parseQueryTerm _ "" = Right $ Left $ Any
|
||||
parseQueryTerm d s = parseQueryTerm d $ defaultprefix<>":"<>s
|
||||
@ -322,20 +323,19 @@ parseAmountQueryTerm amtarg =
|
||||
(parse ">" -> Just q) -> Right (AbsGt ,q)
|
||||
(parse "=" -> Just q) -> Right (AbsEq ,q)
|
||||
(parse "" -> Just q) -> Right (AbsEq ,q)
|
||||
_ -> Left $
|
||||
"could not parse as a comparison operator followed by an optionally-signed number: "
|
||||
++ T.unpack amtarg
|
||||
_ -> Left . T.unpack $
|
||||
"could not parse as a comparison operator followed by an optionally-signed number: " <> amtarg
|
||||
where
|
||||
-- Strip outer whitespace from the text, require and remove the
|
||||
-- specified prefix, remove all whitespace from the remainder, and
|
||||
-- read it as a simple integer or decimal if possible.
|
||||
parse :: T.Text -> T.Text -> Maybe Quantity
|
||||
parse p s = (T.stripPrefix p . T.strip) s >>= readMay . filter (not.(==' ')) . T.unpack
|
||||
parse p s = (T.stripPrefix p . T.strip) s >>= readMay . T.unpack . T.filter (/=' ')
|
||||
|
||||
parseTag :: T.Text -> Either RegexError Query
|
||||
parseTag s = do
|
||||
tag <- toRegexCI . T.unpack $ if T.null v then s else n
|
||||
body <- if T.null v then pure Nothing else Just <$> toRegexCI (tail $ T.unpack v)
|
||||
tag <- toRegexCI $ if T.null v then s else n
|
||||
body <- if T.null v then pure Nothing else Just <$> toRegexCI (T.tail v)
|
||||
return $ Tag tag body
|
||||
where (n,v) = T.break (=='=') s
|
||||
|
||||
@ -554,7 +554,7 @@ matchesAccount (None) _ = False
|
||||
matchesAccount (Not m) a = not $ matchesAccount m a
|
||||
matchesAccount (Or ms) a = any (`matchesAccount` a) ms
|
||||
matchesAccount (And ms) a = all (`matchesAccount` a) ms
|
||||
matchesAccount (Acct r) a = regexMatch r $ T.unpack a -- XXX pack
|
||||
matchesAccount (Acct r) a = regexMatchText r a
|
||||
matchesAccount (Depth d) a = accountNameLevel a <= d
|
||||
matchesAccount (Tag _ _) _ = False
|
||||
matchesAccount _ _ = True
|
||||
@ -564,7 +564,7 @@ matchesMixedAmount q (Mixed []) = q `matchesAmount` nullamt
|
||||
matchesMixedAmount q (Mixed as) = any (q `matchesAmount`) as
|
||||
|
||||
matchesCommodity :: Query -> CommoditySymbol -> Bool
|
||||
matchesCommodity (Sym r) = regexMatch r . T.unpack
|
||||
matchesCommodity (Sym r) = regexMatchText r
|
||||
matchesCommodity _ = const True
|
||||
|
||||
-- | Does the match expression match this (simple) amount ?
|
||||
@ -603,10 +603,10 @@ matchesPosting (Any) _ = True
|
||||
matchesPosting (None) _ = False
|
||||
matchesPosting (Or qs) p = any (`matchesPosting` p) qs
|
||||
matchesPosting (And qs) p = all (`matchesPosting` p) qs
|
||||
matchesPosting (Code r) p = regexMatch r $ maybe "" (T.unpack . tcode) $ ptransaction p
|
||||
matchesPosting (Desc r) p = regexMatch r $ maybe "" (T.unpack . tdescription) $ ptransaction p
|
||||
matchesPosting (Code r) p = maybe False (regexMatchText r . tcode) $ ptransaction p
|
||||
matchesPosting (Desc r) p = maybe False (regexMatchText r . tdescription) $ ptransaction p
|
||||
matchesPosting (Acct r) p = matches p || matches (originalPosting p)
|
||||
where matches p = regexMatch r . T.unpack $ paccount p -- XXX pack
|
||||
where matches = regexMatchText r . paccount
|
||||
matchesPosting (Date span) p = span `spanContainsDate` postingDate p
|
||||
matchesPosting (Date2 span) p = span `spanContainsDate` postingDate2 p
|
||||
matchesPosting (StatusQ s) p = postingStatus p == s
|
||||
@ -615,8 +615,8 @@ matchesPosting q@(Depth _) Posting{paccount=a} = q `matchesAccount` a
|
||||
matchesPosting q@(Amt _ _) Posting{pamount=amt} = q `matchesMixedAmount` amt
|
||||
matchesPosting (Sym r) Posting{pamount=Mixed as} = any (matchesCommodity (Sym r)) $ map acommodity as
|
||||
matchesPosting (Tag n v) p = case (reString n, v) of
|
||||
("payee", Just v) -> maybe False (regexMatch v . T.unpack . transactionPayee) $ ptransaction p
|
||||
("note", Just v) -> maybe False (regexMatch v . T.unpack . transactionNote) $ ptransaction p
|
||||
("payee", Just v) -> maybe False (regexMatchText v . transactionPayee) $ ptransaction p
|
||||
("note", Just v) -> maybe False (regexMatchText v . transactionNote) $ ptransaction p
|
||||
(_, v) -> matchesTags n v $ postingAllTags p
|
||||
|
||||
-- | Does the match expression match this transaction ?
|
||||
@ -626,8 +626,8 @@ matchesTransaction (Any) _ = True
|
||||
matchesTransaction (None) _ = False
|
||||
matchesTransaction (Or qs) t = any (`matchesTransaction` t) qs
|
||||
matchesTransaction (And qs) t = all (`matchesTransaction` t) qs
|
||||
matchesTransaction (Code r) t = regexMatch r $ T.unpack $ tcode t
|
||||
matchesTransaction (Desc r) t = regexMatch r $ T.unpack $ tdescription t
|
||||
matchesTransaction (Code r) t = regexMatchText r $ tcode t
|
||||
matchesTransaction (Desc r) t = regexMatchText r $ tdescription t
|
||||
matchesTransaction q@(Acct _) t = any (q `matchesPosting`) $ tpostings t
|
||||
matchesTransaction (Date span) t = spanContainsDate span $ tdate t
|
||||
matchesTransaction (Date2 span) t = spanContainsDate span $ transactionDate2 t
|
||||
@ -637,15 +637,15 @@ matchesTransaction q@(Amt _ _) t = any (q `matchesPosting`) $ tpostings t
|
||||
matchesTransaction (Depth d) t = any (Depth d `matchesPosting`) $ tpostings t
|
||||
matchesTransaction q@(Sym _) t = any (q `matchesPosting`) $ tpostings t
|
||||
matchesTransaction (Tag n v) t = case (reString n, v) of
|
||||
("payee", Just v) -> regexMatch v . T.unpack . transactionPayee $ t
|
||||
("note", Just v) -> regexMatch v . T.unpack . transactionNote $ t
|
||||
("payee", Just v) -> regexMatchText v $ transactionPayee t
|
||||
("note", Just v) -> regexMatchText v $ transactionNote t
|
||||
(_, v) -> matchesTags n v $ transactionAllTags t
|
||||
|
||||
-- | Does the query match the name and optionally the value of any of these tags ?
|
||||
matchesTags :: Regexp -> Maybe Regexp -> [Tag] -> Bool
|
||||
matchesTags namepat valuepat = not . null . filter (matches namepat valuepat)
|
||||
where
|
||||
matches npat vpat (n,v) = regexMatch npat (T.unpack n) && maybe (const True) regexMatch vpat (T.unpack v)
|
||||
matches npat vpat (n,v) = regexMatchText npat n && maybe (const True) regexMatchText vpat v
|
||||
|
||||
-- | Does the query match this market price ?
|
||||
matchesPriceDirective :: Query -> PriceDirective -> Bool
|
||||
|
||||
@ -1144,7 +1144,7 @@ digitgroupp :: TextParser m DigitGrp
|
||||
digitgroupp = label "digits"
|
||||
$ makeGroup <$> takeWhile1P (Just "digit") isDigit
|
||||
where
|
||||
makeGroup = uncurry DigitGrp . foldl' step (0, 0) . T.unpack
|
||||
makeGroup = uncurry DigitGrp . T.foldl' step (0, 0)
|
||||
step (!l, !a) c = (l+1, a*10 + fromIntegral (digitToInt c))
|
||||
|
||||
--- *** comments
|
||||
@ -1483,7 +1483,7 @@ regexaliasp = do
|
||||
char '='
|
||||
skipNonNewlineSpaces
|
||||
repl <- anySingle `manyTill` eolof
|
||||
case toRegexCI re of
|
||||
case toRegexCI $ T.pack re of
|
||||
Right r -> return $! RegexAlias r repl
|
||||
Left e -> customFailure $! parseErrorAtRegion off1 off2 e
|
||||
|
||||
|
||||
@ -206,7 +206,7 @@ expandIncludes dir content = mapM (expandLine dir) (T.lines content) >>= return
|
||||
case line of
|
||||
(T.stripPrefix "include " -> Just f) -> expandIncludes dir' =<< T.readFile f'
|
||||
where
|
||||
f' = dir </> dropWhile isSpace (T.unpack f)
|
||||
f' = dir </> T.unpack (T.dropWhile isSpace f)
|
||||
dir' = takeDirectory f'
|
||||
_ -> return line
|
||||
|
||||
@ -653,8 +653,7 @@ csvfieldreferencep :: CsvRulesParser CsvFieldReference
|
||||
csvfieldreferencep = do
|
||||
lift $ dbgparse 8 "trying csvfieldreferencep"
|
||||
char '%'
|
||||
f <- T.unpack <$> fieldnamep -- XXX unpack and then pack
|
||||
return . T.pack $ '%' : quoteIfNeeded f
|
||||
T.cons '%' . textQuoteIfNeeded <$> fieldnamep
|
||||
|
||||
-- A single regular expression
|
||||
regexp :: CsvRulesParser () -> CsvRulesParser Regexp
|
||||
@ -663,7 +662,7 @@ regexp end = do
|
||||
-- notFollowedBy matchoperatorp
|
||||
c <- lift nonspace
|
||||
cs <- anySingle `manyTill` end
|
||||
case toRegexCI . strip $ c:cs of
|
||||
case toRegexCI . T.strip . T.pack $ c:cs of
|
||||
Left x -> Fail.fail $ "CSV parser: " ++ x
|
||||
Right x -> return x
|
||||
|
||||
@ -777,7 +776,7 @@ readJournalFromCsv mrulesfile csvfile csvdata =
|
||||
|
||||
when (not rulesfileexists) $ do
|
||||
dbg1IO "creating conversion rules file" rulesfile
|
||||
writeFile rulesfile $ T.unpack rulestext
|
||||
T.writeFile rulesfile rulestext
|
||||
|
||||
return $ Right nulljournal{jtxns=txns''}
|
||||
|
||||
@ -920,9 +919,9 @@ transactionFromCsvRecord sourcepos rules record = t
|
||||
Nothing -> Unmarked
|
||||
Just s -> either statuserror id $ runParser (statusp <* eof) "" s
|
||||
where
|
||||
statuserror err = error' $ unlines
|
||||
["error: could not parse \""<>T.unpack s<>"\" as a cleared status (should be *, ! or empty)"
|
||||
,"the parse error is: "++customErrorBundlePretty err
|
||||
statuserror err = error' . T.unpack $ T.unlines
|
||||
["error: could not parse \""<>s<>"\" as a cleared status (should be *, ! or empty)"
|
||||
,"the parse error is: "<>T.pack (customErrorBundlePretty err)
|
||||
]
|
||||
code = maybe "" singleline $ fieldval "code"
|
||||
description = maybe "" singleline $ fieldval "description"
|
||||
@ -1025,7 +1024,7 @@ getAmount rules record currency p1IsVirtual n =
|
||||
]
|
||||
++ [" assignment: " <> f <> " " <>
|
||||
fromMaybe "" (hledgerField rules record f) <>
|
||||
"\t=> value: " <> T.pack (showMixedAmount a) -- XXX not sure this is showing all the right info
|
||||
"\t=> value: " <> wbToText (showMixed noColour 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,
|
||||
@ -1207,7 +1206,7 @@ getEffectiveAssignment rules record f = lastMay $ map snd $ assignments
|
||||
where
|
||||
-- does this individual matcher match the current csv record ?
|
||||
matcherMatches :: Matcher -> Bool
|
||||
matcherMatches (RecordMatcher _ pat) = regexMatch pat' wholecsvline
|
||||
matcherMatches (RecordMatcher _ pat) = regexMatchText pat' wholecsvline
|
||||
where
|
||||
pat' = dbg7 "regex" pat
|
||||
-- A synthetic whole CSV record to match against. Note, this can be
|
||||
@ -1216,8 +1215,8 @@ 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" . T.unpack $ T.intercalate "," record
|
||||
matcherMatches (FieldMatcher _ csvfieldref pat) = regexMatch pat $ T.unpack csvfieldvalue
|
||||
wholecsvline = dbg7 "wholecsvline" $ T.intercalate "," record
|
||||
matcherMatches (FieldMatcher _ csvfieldref pat) = regexMatchText pat csvfieldvalue
|
||||
where
|
||||
-- the value of the referenced CSV field to match against.
|
||||
csvfieldvalue = dbg7 "csvfieldvalue" $ replaceCsvFieldReference rules record csvfieldref
|
||||
|
||||
@ -380,8 +380,8 @@ parseAccountTypeCode s =
|
||||
"c" -> Right Cash
|
||||
_ -> Left err
|
||||
where
|
||||
err = "invalid account type code "++T.unpack s++", should be one of " ++
|
||||
(intercalate ", " $ ["A","L","E","R","X","C","Asset","Liability","Equity","Revenue","Expense","Cash"])
|
||||
err = T.unpack $ "invalid account type code "<>s<>", should be one of " <>
|
||||
T.intercalate ", " ["A","L","E","R","X","C","Asset","Liability","Equity","Revenue","Expense","Cash"]
|
||||
|
||||
-- Add an account declaration to the journal, auto-numbering it.
|
||||
addAccountDeclaration :: (AccountName,Text,[Tag]) -> JournalParser m ()
|
||||
|
||||
@ -380,7 +380,7 @@ budgetReportAsCsv
|
||||
|
||||
where
|
||||
flattentuples abs = concat [[a,b] | (a,b) <- abs]
|
||||
showmamt = maybe "" (T.pack . showMixedAmountOneLineWithoutPrice False)
|
||||
showmamt = maybe "" (wbToText . showMixed oneLine)
|
||||
|
||||
-- tests
|
||||
|
||||
|
||||
@ -1,5 +1,7 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
{-|
|
||||
@ -54,6 +56,7 @@ module Hledger.Utils.Regex (
|
||||
,RegexError
|
||||
-- * total regex operations
|
||||
,regexMatch
|
||||
,regexMatchText
|
||||
,regexReplace
|
||||
,regexReplaceUnmemo
|
||||
,regexReplaceAllBy
|
||||
@ -66,6 +69,10 @@ import Data.Array ((!), elems, indices)
|
||||
import Data.Char (isDigit)
|
||||
import Data.List (foldl')
|
||||
import Data.MemoUgly (memo)
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Semigroup ((<>))
|
||||
#endif
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Text.Regex.TDFA (
|
||||
Regex, CompOption(..), defaultCompOpt, defaultExecOpt,
|
||||
@ -78,8 +85,8 @@ import Hledger.Utils.UTF8IOCompat (error')
|
||||
|
||||
-- | Regular expression. Extended regular expression-ish syntax ? But does not support eg (?i) syntax.
|
||||
data Regexp
|
||||
= Regexp { reString :: String, reCompiled :: Regex }
|
||||
| RegexpCI { reString :: String, reCompiled :: Regex }
|
||||
= Regexp { reString :: Text, reCompiled :: Regex }
|
||||
| RegexpCI { reString :: Text, reCompiled :: Regex }
|
||||
|
||||
instance Eq Regexp where
|
||||
Regexp s1 _ == Regexp s2 _ = s1 == s2
|
||||
@ -93,7 +100,7 @@ instance Ord Regexp where
|
||||
RegexpCI _ _ `compare` Regexp _ _ = GT
|
||||
|
||||
instance Show Regexp where
|
||||
showsPrec d r = showParen (d > app_prec) $ reCons . showsPrec (app_prec+1) (reString r)
|
||||
showsPrec d r = showParen (d > app_prec) $ reCons . showsPrec (app_prec+1) (T.unpack $ reString r)
|
||||
where app_prec = 10
|
||||
reCons = case r of Regexp _ _ -> showString "Regexp "
|
||||
RegexpCI _ _ -> showString "RegexpCI "
|
||||
@ -108,8 +115,8 @@ instance Read Regexp where
|
||||
where app_prec = 10
|
||||
|
||||
instance ToJSON Regexp where
|
||||
toJSON (Regexp s _) = String . T.pack $ "Regexp " ++ s
|
||||
toJSON (RegexpCI s _) = String . T.pack $ "RegexpCI " ++ s
|
||||
toJSON (Regexp s _) = String $ "Regexp " <> s
|
||||
toJSON (RegexpCI s _) = String $ "RegexpCI " <> s
|
||||
|
||||
instance RegexLike Regexp String where
|
||||
matchOnce = matchOnce . reCompiled
|
||||
@ -124,24 +131,24 @@ instance RegexContext Regexp String String where
|
||||
matchM = matchM . reCompiled
|
||||
|
||||
-- Convert a Regexp string to a compiled Regex, or return an error message.
|
||||
toRegex :: String -> Either RegexError Regexp
|
||||
toRegex :: Text -> Either RegexError Regexp
|
||||
toRegex = memo $ \s -> mkRegexErr s (Regexp s <$> makeRegexM s)
|
||||
|
||||
-- Like toRegex, but make a case-insensitive Regex.
|
||||
toRegexCI :: String -> Either RegexError Regexp
|
||||
toRegexCI :: Text -> Either RegexError Regexp
|
||||
toRegexCI = memo $ \s -> mkRegexErr s (RegexpCI s <$> makeRegexOptsM defaultCompOpt{caseSensitive=False} defaultExecOpt s)
|
||||
|
||||
-- | Make a nice error message for a regexp error.
|
||||
mkRegexErr :: String -> Maybe a -> Either RegexError a
|
||||
mkRegexErr :: Text -> Maybe a -> Either RegexError a
|
||||
mkRegexErr s = maybe (Left errmsg) Right
|
||||
where errmsg = "this regular expression could not be compiled: " ++ s
|
||||
where errmsg = T.unpack $ "this regular expression could not be compiled: " <> s
|
||||
|
||||
-- Convert a Regexp string to a compiled Regex, throw an error
|
||||
toRegex' :: String -> Regexp
|
||||
toRegex' :: Text -> Regexp
|
||||
toRegex' = either error' id . toRegex
|
||||
|
||||
-- Like toRegex', but make a case-insensitive Regex.
|
||||
toRegexCI' :: String -> Regexp
|
||||
toRegexCI' :: Text -> Regexp
|
||||
toRegexCI' = either error' id . toRegexCI
|
||||
|
||||
-- | A replacement pattern. May include numeric backreferences (\N).
|
||||
@ -159,6 +166,13 @@ type RegexError = String
|
||||
regexMatch :: Regexp -> String -> Bool
|
||||
regexMatch = matchTest
|
||||
|
||||
-- | Tests whether a Regexp matches a Text.
|
||||
--
|
||||
-- This currently unpacks the Text to a String an works on that. This is due to
|
||||
-- a performance bug in regex-tdfa (#9), which may or may not be relevant here.
|
||||
regexMatchText :: Regexp -> Text -> Bool
|
||||
regexMatchText r = matchTest r . T.unpack
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- new total functions
|
||||
|
||||
|
||||
@ -349,4 +349,4 @@ stripAnsi :: String -> String
|
||||
stripAnsi s = either err id $ regexReplace ansire "" s
|
||||
where
|
||||
err = error "stripAnsi: invalid replacement pattern" -- PARTIAL, shouldn't happen
|
||||
ansire = toRegex' "\ESC\\[([0-9]+;)*([0-9]+)?[ABCDHJKfmsu]" -- PARTIAL, should succeed
|
||||
ansire = toRegex' $ T.pack "\ESC\\[([0-9]+;)*([0-9]+)?[ABCDHJKfmsu]" -- PARTIAL, should succeed
|
||||
|
||||
@ -124,7 +124,7 @@ formatText leftJustified minwidth maxwidth t =
|
||||
-- double-quoted.
|
||||
quoteIfSpaced :: T.Text -> T.Text
|
||||
quoteIfSpaced s | isSingleQuoted s || isDoubleQuoted s = s
|
||||
| not $ any (`elem` (T.unpack s)) whitespacechars = s
|
||||
| not $ any (\c -> T.any (==c) s) whitespacechars = s
|
||||
| otherwise = textQuoteIfNeeded s
|
||||
|
||||
-- -- | Wrap a string in double quotes, and \-prefix any embedded single
|
||||
@ -138,7 +138,7 @@ quoteIfSpaced s | isSingleQuoted s || isDoubleQuoted s = s
|
||||
-- -- | Double-quote this string if it contains whitespace, single quotes
|
||||
-- -- or double-quotes, escaping the quotes as needed.
|
||||
textQuoteIfNeeded :: T.Text -> T.Text
|
||||
textQuoteIfNeeded s | any (`elem` T.unpack s) (quotechars++whitespacechars) = "\"" <> escapeDoubleQuotes s <> "\""
|
||||
textQuoteIfNeeded s | any (\c -> T.any (==c) s) (quotechars++whitespacechars) = "\"" <> escapeDoubleQuotes s <> "\""
|
||||
| otherwise = s
|
||||
|
||||
-- -- | Single-quote this string if it contains whitespace or double-quotes.
|
||||
@ -375,7 +375,7 @@ linesPrepend2 prefix1 prefix2 s = T.unlines $ case T.lines s of
|
||||
-- | Read a decimal number from a Text. Assumes the input consists only of digit
|
||||
-- characters.
|
||||
readDecimal :: Text -> Integer
|
||||
readDecimal = foldl' step 0 . T.unpack
|
||||
readDecimal = T.foldl' step 0
|
||||
where step a c = a * 10 + toInteger (digitToInt c)
|
||||
|
||||
|
||||
|
||||
@ -175,7 +175,7 @@ asDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}
|
||||
<+> toggles
|
||||
<+> str (" account " ++ if ishistorical then "balances" else "changes")
|
||||
<+> borderPeriodStr (if ishistorical then "at end of" else "in") (period_ ropts)
|
||||
<+> borderQueryStr (unwords . map (quoteIfNeeded . T.unpack) $ querystring_ ropts)
|
||||
<+> borderQueryStr (T.unpack . T.unwords . map textQuoteIfNeeded $ querystring_ ropts)
|
||||
<+> borderDepthStr mdepth
|
||||
<+> str (" ("++curidx++"/"++totidx++")")
|
||||
<+> (if ignore_assertions_ $ inputopts_ copts
|
||||
|
||||
@ -141,8 +141,8 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportspec_=rsp
|
||||
where
|
||||
acct = headDef (error' $ "--register "++apat++" did not match any account") -- PARTIAL:
|
||||
. filterAccts $ journalAccountNames j
|
||||
filterAccts = case toRegexCI apat of
|
||||
Right re -> filter (regexMatch re . T.unpack)
|
||||
filterAccts = case toRegexCI $ T.pack apat of
|
||||
Right re -> filter (regexMatchText re)
|
||||
Left _ -> const []
|
||||
-- Initialising the accounts screen is awkward, requiring
|
||||
-- another temporary UIState value..
|
||||
|
||||
@ -203,7 +203,7 @@ rsDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}
|
||||
<+> togglefilters
|
||||
<+> str " transactions"
|
||||
-- <+> str (if ishistorical then " historical total" else " period total")
|
||||
<+> borderQueryStr (unwords . map (quoteIfNeeded . T.unpack) $ querystring_ ropts)
|
||||
<+> borderQueryStr (T.unpack . T.unwords . map textQuoteIfNeeded $ querystring_ ropts)
|
||||
-- <+> str " and subs"
|
||||
<+> borderPeriodStr "in" (period_ ropts)
|
||||
<+> str " ("
|
||||
|
||||
@ -308,7 +308,7 @@ showMinibuffer :: UIState -> UIState
|
||||
showMinibuffer ui = setMode (Minibuffer e) ui
|
||||
where
|
||||
e = applyEdit gotoEOL $ editor MinibufferEditor (Just 1) oldq
|
||||
oldq = unwords . map (quoteIfNeeded . T.unpack)
|
||||
oldq = T.unpack . T.unwords . map textQuoteIfNeeded
|
||||
. querystring_ . rsOpts . reportspec_ . cliopts_ $ aopts ui
|
||||
|
||||
-- | Close the minibuffer, discarding any edit in progress.
|
||||
|
||||
@ -167,7 +167,8 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _)
|
||||
{ esArgs = drop 1 esArgs
|
||||
, esDefDate = date
|
||||
}
|
||||
dateAndCodeString = formatTime defaultTimeLocale yyyymmddFormat date ++ (if T.null code then "" else " (" ++ T.unpack code ++ ")")
|
||||
dateAndCodeString = formatTime defaultTimeLocale yyyymmddFormat date
|
||||
++ T.unpack (if T.null code then "" else " (" <> code <> ")")
|
||||
yyyymmddFormat = iso8601DateFormat Nothing
|
||||
confirmedTransactionWizard prevInput{prevDateAndCode=Just dateAndCodeString} es' (EnterDescAndComment (date, code) : stack)
|
||||
Nothing ->
|
||||
@ -237,7 +238,7 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _)
|
||||
,pcomment=comment
|
||||
,ptype=accountNamePostingType $ T.pack account
|
||||
}
|
||||
amountAndCommentString = showAmount amount ++ (if T.null comment then "" else " ;" ++ T.unpack comment)
|
||||
amountAndCommentString = showAmount amount ++ T.unpack (if T.null comment then "" else " ;" <> comment)
|
||||
prevAmountAndCmnt' = replaceNthOrAppend (length esPostings) amountAndCommentString (prevAmountAndCmnt prevInput)
|
||||
es' = es{esPostings=esPostings++[posting], esArgs=drop 2 esArgs}
|
||||
confirmedTransactionWizard prevInput{prevAmountAndCmnt=prevAmountAndCmnt'} es' (EnterNewPosting txnParams (Just posting) : stack)
|
||||
|
||||
@ -80,8 +80,8 @@ aregister opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
|
||||
let
|
||||
acct = headDef (error' $ show apat++" did not match any account") -- PARTIAL:
|
||||
. filterAccts $ journalAccountNames j
|
||||
filterAccts = case toRegexCI apat of
|
||||
Right re -> filter (regexMatch re . T.unpack)
|
||||
filterAccts = case toRegexCI $ T.pack apat of
|
||||
Right re -> filter (regexMatchText re)
|
||||
Left _ -> const []
|
||||
-- gather report options
|
||||
inclusive = True -- tree_ ropts
|
||||
@ -134,8 +134,8 @@ accountTransactionsReportItemAsCsvRecord
|
||||
where
|
||||
idx = T.pack $ show tindex
|
||||
date = showDate $ transactionRegisterDate reportq thisacctq t
|
||||
amt = T.pack $ showMixedAmountOneLineWithoutPrice False change
|
||||
bal = T.pack $ showMixedAmountOneLineWithoutPrice False balance
|
||||
amt = wbToText $ showMixed oneLine change
|
||||
bal = wbToText $ showMixed oneLine balance
|
||||
|
||||
-- | Render a register report as plain text suitable for console output.
|
||||
accountTransactionsReportAsText :: CliOpts -> Query -> Query -> AccountTransactionsReport -> TL.Text
|
||||
@ -146,7 +146,7 @@ accountTransactionsReportAsText copts reportq thisacctq items
|
||||
where
|
||||
amtwidth = maximumStrict $ 12 : map (wbWidth . showamt . itemamt) items
|
||||
balwidth = maximumStrict $ 12 : map (wbWidth . showamt . itembal) items
|
||||
showamt = showMixed oneLine{displayMinWidth=Just 12, displayMaxWidth=mmax, displayColour=False} -- color_
|
||||
showamt = showMixed oneLine{displayMinWidth=Just 12, displayMaxWidth=mmax} -- color_
|
||||
where mmax = if no_elide_ . rsOpts . reportspec_ $ copts then Nothing else Just 32
|
||||
itemamt (_,_,_,_,a,_) = a
|
||||
itembal (_,_,_,_,_,a) = a
|
||||
@ -155,7 +155,7 @@ accountTransactionsReportAsText copts reportq thisacctq items
|
||||
where
|
||||
-- XXX temporary hack ? recover the account name from the query
|
||||
macct = case filterQuery queryIsAcct thisacctq of
|
||||
Acct r -> Just . T.drop 1 . T.dropEnd 5 . T.pack $ reString r -- Acct "^JS:expenses(:|$)"
|
||||
Acct r -> Just . T.drop 1 . T.dropEnd 5 $ reString r -- Acct "^JS:expenses(:|$)"
|
||||
_ -> Nothing -- shouldn't happen
|
||||
|
||||
-- | Render one account register report line item as plain text. Layout is like so:
|
||||
|
||||
@ -357,11 +357,11 @@ balance opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
|
||||
balanceReportAsCsv :: ReportOpts -> BalanceReport -> CSV
|
||||
balanceReportAsCsv opts (items, total) =
|
||||
["account","balance"] :
|
||||
[[a, T.pack $ showMixedAmountOneLineWithoutPrice False b] | (a, _, _, b) <- items]
|
||||
[[a, wbToText $ showMixed oneLine b] | (a, _, _, b) <- items]
|
||||
++
|
||||
if no_total_ opts
|
||||
then []
|
||||
else [["total", T.pack $ showMixedAmountOneLineWithoutPrice False total]]
|
||||
else [["total", wbToText $ showMixed oneLine total]]
|
||||
|
||||
-- | Render a single-column balance report as plain text.
|
||||
balanceReportAsText :: ReportOpts -> BalanceReport -> TB.Builder
|
||||
@ -454,7 +454,7 @@ multiBalanceReportAsCsv opts@ReportOpts{average_, row_total_}
|
||||
++ ["Average" | average_]
|
||||
) :
|
||||
[displayFull a :
|
||||
map (T.pack . showMixedAmountOneLineWithoutPrice False)
|
||||
map (wbToText . showMixed oneLine)
|
||||
(amts
|
||||
++ [rowtot | row_total_]
|
||||
++ [rowavg | average_])
|
||||
@ -463,7 +463,7 @@ multiBalanceReportAsCsv opts@ReportOpts{average_, row_total_}
|
||||
if no_total_ opts
|
||||
then []
|
||||
else ["Total:" :
|
||||
map (T.pack . showMixedAmountOneLineWithoutPrice False) (
|
||||
map (wbToText . showMixed oneLine) (
|
||||
coltotals
|
||||
++ [tot | row_total_]
|
||||
++ [avg | average_]
|
||||
@ -637,9 +637,9 @@ tests_Balance = tests "Balance" [
|
||||
test "unicode in balance layout" $ do
|
||||
j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
|
||||
let rspec = defreportspec{rsOpts=defreportopts{no_total_=True}}
|
||||
TL.unpack (TB.toLazyText $ balanceReportAsText (rsOpts rspec) (balanceReport rspec{rsToday=fromGregorian 2008 11 26} j))
|
||||
TB.toLazyText (balanceReportAsText (rsOpts rspec) (balanceReport rspec{rsToday=fromGregorian 2008 11 26} j))
|
||||
@?=
|
||||
unlines
|
||||
TL.unlines
|
||||
[" -100 актив:наличные"
|
||||
," 100 расходы:покупки"
|
||||
]
|
||||
|
||||
@ -1,3 +1,5 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Hledger.Cli.Commands.Check.Uniqueleafnames (
|
||||
journalCheckUniqueleafnames
|
||||
)
|
||||
@ -6,21 +8,22 @@ where
|
||||
import Data.Function
|
||||
import Data.List
|
||||
import Data.List.Extra (nubSort)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import Hledger
|
||||
import Text.Printf
|
||||
|
||||
journalCheckUniqueleafnames :: Journal -> Either String ()
|
||||
journalCheckUniqueleafnames j = do
|
||||
let dupes = checkdupes' $ accountsNames j
|
||||
if null dupes
|
||||
then Right ()
|
||||
else Left $
|
||||
else Left . T.unpack $
|
||||
-- XXX make output more like Checkdates.hs, Check.hs etc.
|
||||
concatMap render dupes
|
||||
foldMap render dupes
|
||||
where
|
||||
render (leafName, accountNameL) =
|
||||
printf "%s as %s\n" leafName (intercalate ", " (map T.unpack accountNameL))
|
||||
leafName <> " as " <> T.intercalate ", " accountNameL
|
||||
|
||||
checkdupes' :: (Ord k, Eq k) => [(k, v)] -> [(k, [v])]
|
||||
checkdupes' l = zip dupLeafs dupAccountNames
|
||||
@ -31,8 +34,8 @@ checkdupes' l = zip dupLeafs dupAccountNames
|
||||
. groupBy ((==) `on` fst)
|
||||
. sortBy (compare `on` fst)
|
||||
|
||||
accountsNames :: Journal -> [(String, AccountName)]
|
||||
accountsNames :: Journal -> [(Text, AccountName)]
|
||||
accountsNames j = map leafAndAccountName as
|
||||
where leafAndAccountName a = (T.unpack $ accountLeafName a, a)
|
||||
where leafAndAccountName a = (accountLeafName a, a)
|
||||
ps = journalPostings j
|
||||
as = nubSort $ map paccount ps
|
||||
|
||||
@ -18,7 +18,6 @@ import Data.Ord (comparing)
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.Time (diffDays)
|
||||
import Data.Either (partitionEithers)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import System.Exit (exitFailure)
|
||||
|
||||
@ -107,7 +106,7 @@ diff CliOpts{file_=[f1, f2], reportspec_=ReportSpec{rsQuery=Acct acctRe}} _ = do
|
||||
j1 <- readJournalFile' f1
|
||||
j2 <- readJournalFile' f2
|
||||
|
||||
let acct = T.pack $ reString acctRe
|
||||
let acct = reString acctRe
|
||||
let pp1 = matchingPostings acct j1
|
||||
let pp2 = matchingPostings acct j2
|
||||
|
||||
|
||||
@ -4,7 +4,6 @@ The @files@ command lists included files.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module Hledger.Cli.Commands.Files (
|
||||
@ -12,8 +11,8 @@ module Hledger.Cli.Commands.Files (
|
||||
,files
|
||||
) where
|
||||
|
||||
import Data.List
|
||||
import Safe
|
||||
import qualified Data.Text as T
|
||||
import Safe (headMay)
|
||||
|
||||
import Hledger
|
||||
import Prelude hiding (putStrLn)
|
||||
@ -33,7 +32,7 @@ filesmode = hledgerCommandMode
|
||||
files :: CliOpts -> Journal -> IO ()
|
||||
files CliOpts{rawopts_=rawopts} j = do
|
||||
let args = listofstringopt "args" rawopts
|
||||
regex <- mapM (either fail pure . toRegex) $ headMay args
|
||||
regex <- mapM (either fail pure . toRegex . T.pack) $ headMay args
|
||||
let files = maybe id (filter . regexMatch) regex
|
||||
$ map fst
|
||||
$ jfiles j
|
||||
|
||||
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module Hledger.Cli.Commands.Prices (
|
||||
@ -10,6 +11,7 @@ import qualified Data.Map as M
|
||||
import Data.Maybe
|
||||
import Data.List
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import Data.Time
|
||||
import Hledger
|
||||
import Hledger.Cli.CliOptions
|
||||
@ -33,7 +35,7 @@ prices opts j = do
|
||||
cprices = map (stylePriceDirectiveExceptPrecision styles) $ concatMap postingsPriceDirectivesFromCosts ps
|
||||
icprices = map (stylePriceDirectiveExceptPrecision styles) $ concatMap postingsPriceDirectivesFromCosts $ mapAmount invertPrice ps
|
||||
allprices = mprices ++ ifBoolOpt "costs" cprices ++ ifBoolOpt "inverted-costs" icprices
|
||||
mapM_ (putStrLn . showPriceDirective) $
|
||||
mapM_ (T.putStrLn . showPriceDirective) $
|
||||
sortOn pddate $
|
||||
filter (matchesPriceDirective q) $
|
||||
allprices
|
||||
@ -41,8 +43,8 @@ prices opts j = do
|
||||
ifBoolOpt opt | boolopt opt $ rawopts_ opts = id
|
||||
| otherwise = const []
|
||||
|
||||
showPriceDirective :: PriceDirective -> String
|
||||
showPriceDirective mp = unwords ["P", show $ pddate mp, T.unpack . quoteCommoditySymbolIfNeeded $ pdcommodity mp, showAmountWithZeroCommodity $ pdamount mp]
|
||||
showPriceDirective :: PriceDirective -> T.Text
|
||||
showPriceDirective mp = T.unwords ["P", T.pack . show $ pddate mp, quoteCommoditySymbolIfNeeded $ pdcommodity mp, wbToText . showAmountB noColour{displayZeroCommodity=True} $ pdamount mp]
|
||||
|
||||
divideAmount' :: Quantity -> Amount -> Amount
|
||||
divideAmount' n a = a' where
|
||||
|
||||
@ -166,9 +166,10 @@ 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 = 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
|
||||
let showamt = TL.toStrict . TB.toLazyText . wbBuilder . showAmountB noColour in
|
||||
let amount = showamt a_ in
|
||||
let credit = if q < 0 then showamt $ negate a_ else "" in
|
||||
let debit = if q >= 0 then showamt a_ else "" in
|
||||
[account, amount, c, credit, debit, status, comment])
|
||||
amounts
|
||||
where
|
||||
|
||||
@ -87,8 +87,8 @@ postingsReportItemAsCsvRecord (_, _, _, p, b) = [idx,date,code,desc,acct,amt,bal
|
||||
BalancedVirtualPosting -> wrap "[" "]"
|
||||
VirtualPosting -> wrap "(" ")"
|
||||
_ -> id
|
||||
amt = T.pack $ showMixedAmountOneLineWithoutPrice False $ pamount p
|
||||
bal = T.pack $ showMixedAmountOneLineWithoutPrice False b
|
||||
amt = wbToText . showMixed oneLine $ pamount p
|
||||
bal = wbToText $ showMixed oneLine b
|
||||
|
||||
-- | Render a register report as plain text suitable for console output.
|
||||
postingsReportAsText :: CliOpts -> PostingsReport -> TL.Text
|
||||
@ -102,7 +102,7 @@ postingsReportAsText opts items =
|
||||
itembal (_,_,_,_,a) = a
|
||||
unlinesB [] = mempty
|
||||
unlinesB xs = mconcat (intersperse (TB.fromText "\n") xs) <> TB.fromText "\n"
|
||||
showAmt = showMixed noColour{displayMinWidth=Just 12,displayColour=False}
|
||||
showAmt = showMixed noColour{displayMinWidth=Just 12}
|
||||
|
||||
-- | Render one register report line item as plain text. Layout is like so:
|
||||
-- @
|
||||
|
||||
@ -29,7 +29,7 @@ tags :: CliOpts -> Journal -> IO ()
|
||||
tags CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
|
||||
d <- getCurrentDay
|
||||
let args = listofstringopt "args" rawopts
|
||||
mtagpat <- mapM (either Fail.fail pure . toRegexCI) $ headMay args
|
||||
mtagpat <- mapM (either Fail.fail pure . toRegexCI . T.pack) $ headMay args
|
||||
let
|
||||
querystring = map T.pack $ drop 1 args
|
||||
values = boolopt "values" rawopts
|
||||
@ -44,7 +44,7 @@ tags CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
|
||||
(if parsed then id else nubSort)
|
||||
[ r
|
||||
| (t,v) <- concatMap transactionAllTags txns
|
||||
, maybe True (`regexMatch` T.unpack t) mtagpat
|
||||
, maybe True (`regexMatchText` t) mtagpat
|
||||
, let r = if values then v else t
|
||||
, not (values && T.null v && not empty)
|
||||
]
|
||||
|
||||
@ -263,7 +263,7 @@ compoundBalanceReportAsCsv ropts (CompoundPeriodicReport title colspans subrepor
|
||||
| no_total_ ropts || length subreports == 1 = id
|
||||
| otherwise = (++
|
||||
["Net:" :
|
||||
map (T.pack . showMixedAmountOneLineWithoutPrice False) (
|
||||
map (wbToText . showMixed oneLine) (
|
||||
coltotals
|
||||
++ (if row_total_ ropts then [grandtotal] else [])
|
||||
++ (if average_ ropts then [grandavg] else [])
|
||||
@ -307,14 +307,12 @@ compoundBalanceReportAsHtml ropts cbr =
|
||||
totalrows | no_total_ ropts || length subreports == 1 = []
|
||||
| otherwise =
|
||||
let defstyle = style_ "text-align:right"
|
||||
in
|
||||
[tr_ $ mconcat $
|
||||
th_ [class_ "", style_ "text-align:left"] "Net:"
|
||||
: [th_ [class_ "amount coltotal", defstyle] (toHtml $ showMixedAmountOneLineWithoutPrice False a) | a <- coltotals]
|
||||
++ (if row_total_ ropts then [th_ [class_ "amount coltotal", defstyle] $ toHtml $ showMixedAmountOneLineWithoutPrice False grandtotal] else [])
|
||||
++ (if average_ ropts then [th_ [class_ "amount colaverage", defstyle] $ toHtml $ showMixedAmountOneLineWithoutPrice False grandavg] else [])
|
||||
orEmpty b x = if b then x else mempty
|
||||
in [tr_ $ th_ [class_ "", style_ "text-align:left"] "Net:"
|
||||
<> foldMap (th_ [class_ "amount coltotal", defstyle] . toHtml . wbUnpack . showMixed oneLine) coltotals
|
||||
<> orEmpty (row_total_ ropts) (th_ [class_ "amount coltotal", defstyle] . toHtml . wbUnpack $ showMixed oneLine grandtotal)
|
||||
<> orEmpty (average_ ropts) (th_ [class_ "amount colaverage", defstyle] . toHtml . wbUnpack $ showMixed oneLine grandavg)
|
||||
]
|
||||
|
||||
in do
|
||||
style_ (T.unlines [""
|
||||
,"td { padding:0 0.5em; }"
|
||||
|
||||
Loading…
Reference in New Issue
Block a user