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

lib,cli,ui: Replace some uses of String with Text, get rid of some unpacks, clean up showMixed options.

Browse Source
This commit is contained in:
Stephen Morgan 2020-12-27 10:52:39 +11:00
parent 07a7c3d3a8
commit e4e533eb9f
27 changed files with 153 additions and 137 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
hledger-lib/Hledger/Data/Account.hs
View File

@ -30,8 +30,8 @@ instance Show Account where
aname aname
(if aboring then "y" else "n" :: String) (if aboring then "y" else "n" :: String)
anumpostings anumpostings
(showMixedAmount aebalance) (wbUnpack $ showMixed noColour aebalance)
(showMixedAmount aibalance) (wbUnpack $ showMixed noColour aibalance)
instance Eq Account where instance Eq Account where
(==) a b = aname a == aname b -- quick equality test for speed (==) 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" showAccountDebug a = printf "%-25s %4s %4s %s"
(aname a) (aname a)
(showMixedAmount $ aebalance a) (wbUnpack . showMixed noColour $ aebalance a)
(showMixedAmount $ aibalance a) (wbUnpack . showMixed noColour $ aibalance a)
(if aboring a then "b" else " " :: String) (if aboring a then "b" else " " :: String)

14
hledger-lib/Hledger/Data/AccountName.hs
View File

@ -208,31 +208,31 @@ clipOrEllipsifyAccountName (Just 0) = const "..."
clipOrEllipsifyAccountName n = clipAccountName n clipOrEllipsifyAccountName n = clipAccountName n
-- | Escape an AccountName for use within a regular expression. -- | Escape an AccountName for use within a regular expression.
-- >>> putStr $ escapeName "First?!#$*?$(*) !@^#*? %)*!@#" -- >>> putStr . T.unpack $ escapeName "First?!#$*?$(*) !@^#*? %)*!@#"
-- First\?!#\$\*\?\$\(\*\) !@\^#\*\? %\)\*!@# -- First\?!#\$\*\?\$\(\*\) !@\^#\*\? %\)\*!@#
escapeName :: AccountName -> String escapeName :: AccountName -> Text
escapeName = T.unpack . T.concatMap escapeChar escapeName = T.concatMap escapeChar
where where
escapeChar c = if c `elem` escapedChars then T.snoc "\\" c else T.singleton c escapeChar c = if c `elem` escapedChars then T.snoc "\\" c else T.singleton c
escapedChars = ['[', '?', '+', '|', '(', ')', '*', '$', '^', '\\'] escapedChars = ['[', '?', '+', '|', '(', ')', '*', '$', '^', '\\']
-- | Convert an account name to a regular expression matching it and its subaccounts. -- | Convert an account name to a regular expression matching it and its subaccounts.
accountNameToAccountRegex :: AccountName -> Regexp 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, -- | Convert an account name to a regular expression matching it and its subaccounts,
-- case insensitively. -- case insensitively.
accountNameToAccountRegexCI :: AccountName -> Regexp 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. -- | Convert an account name to a regular expression matching it but not its subaccounts.
accountNameToAccountOnlyRegex :: AccountName -> Regexp 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, -- | Convert an account name to a regular expression matching it but not its subaccounts,
-- case insensitively. -- case insensitively.
accountNameToAccountOnlyRegexCI :: AccountName -> Regexp 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 ? -- -- | Does this string look like an exact account-matching regular expression ?
--isAccountRegex :: String -> Bool --isAccountRegex :: String -> Bool

18
hledger-lib/Hledger/Data/Amount.hs
View File

@ -167,9 +167,13 @@ data AmountDisplayOpts = AmountDisplayOpts
, displayMaxWidth :: Maybe Int -- ^ Maximum width to clip to , displayMaxWidth :: Maybe Int -- ^ Maximum width to clip to
} deriving (Show) } deriving (Show)
instance Default AmountDisplayOpts where -- | Display Amount and MixedAmount with no colour.
def = AmountDisplayOpts { displayPrice = True instance Default AmountDisplayOpts where def = noColour
, displayColour = True
-- | Display Amount and MixedAmount with no colour.
noColour :: AmountDisplayOpts
noColour = AmountDisplayOpts { displayPrice = True
, displayColour = False
, displayZeroCommodity = False , displayZeroCommodity = False
, displayNormalised = True , displayNormalised = True
, displayOneLine = False , displayOneLine = False
@ -177,10 +181,6 @@ instance Default AmountDisplayOpts where
, displayMaxWidth = Nothing , displayMaxWidth = Nothing
} }
-- | Display Amount and MixedAmount with no colour.
noColour :: AmountDisplayOpts
noColour = def{displayColour=False}
-- | Display Amount and MixedAmount with no prices. -- | Display Amount and MixedAmount with no prices.
noPrice :: AmountDisplayOpts noPrice :: AmountDisplayOpts
noPrice = def{displayPrice=False} noPrice = def{displayPrice=False}
@ -427,7 +427,7 @@ cshowAmount = wbUnpack . showAmountB def
-- | Get the string representation of an amount, without any \@ price. -- | Get the string representation of an amount, without any \@ price.
showAmountWithoutPrice :: Amount -> String 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. -- | Like showAmount, but show a zero amount's commodity if it has one.
showAmountWithZeroCommodity :: Amount -> String showAmountWithZeroCommodity :: Amount -> String
@ -669,7 +669,7 @@ showMixedAmount = wbUnpack . showMixed noColour
-- | Get the one-line string representation of a mixed amount. -- | Get the one-line string representation of a mixed amount.
showMixedAmountOneLine :: MixedAmount -> String showMixedAmountOneLine :: MixedAmount -> String
showMixedAmountOneLine = wbUnpack . showMixed oneLine{displayColour=False} showMixedAmountOneLine = wbUnpack . showMixed oneLine
-- | Like showMixedAmount, but zero amounts are shown with their -- | Like showMixedAmount, but zero amounts are shown with their
-- commodity if they have one. -- commodity if they have one.

6
hledger-lib/Hledger/Data/Posting.hs
View File

@ -161,7 +161,7 @@ originalPosting p = fromMaybe p $ poriginal p
-- XXX once rendered user output, but just for debugging now; clean up -- XXX once rendered user output, but just for debugging now; clean up
showPosting :: Posting -> String showPosting :: Posting -> String
showPosting p@Posting{paccount=a,pamount=amt,ptype=t} = 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 where
ledger3ishlayout = False ledger3ishlayout = False
acctnamewidth = if ledger3ishlayout then 25 else 22 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} showamount = wbUnpack . showMixed noColour{displayMinWidth=Just 12}
showComment :: Text -> String showComment :: Text -> Text
showComment t = if T.null t then "" else " ;" ++ T.unpack t showComment t = if T.null t then "" else " ;" <> t
isReal :: Posting -> Bool isReal :: Posting -> Bool
isReal p = ptype p == RegularPosting isReal p = ptype p == RegularPosting

52
hledger-lib/Hledger/Query.hs
View File

@ -66,6 +66,7 @@ import Data.Maybe (fromMaybe, isJust, mapMaybe)
#if !(MIN_VERSION_base(4,11,0)) #if !(MIN_VERSION_base(4,11,0))
import Data.Monoid ((<>)) import Data.Monoid ((<>))
#endif #endif
import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Calendar (Day, fromGregorian ) import Data.Time.Calendar (Day, fromGregorian )
import Safe (readDef, readMay, maximumByMay, maximumMay, minimumMay) import Safe (readDef, readMay, maximumByMay, maximumMay, minimumMay)
@ -107,11 +108,11 @@ data Query = Any -- ^ always match
instance Default Query where def = Any instance Default Query where def = Any
-- | Construct a payee tag -- | 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) payeeTag = fmap (Tag (toRegexCI' "payee")) . maybe (pure Nothing) (fmap Just . toRegexCI)
-- | Construct a note tag -- | 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) noteTag = fmap (Tag (toRegexCI' "note")) . maybe (pure Nothing) (fmap Just . toRegexCI)
-- | Construct a generated-transaction tag -- | Construct a generated-transaction tag
@ -262,11 +263,11 @@ parseQueryTerm d (T.stripPrefix "not:" -> Just s) =
Right (Left m) -> Right $ Left $ Not m Right (Left m) -> Right $ Left $ Not m
Right (Right _) -> Right $ Left Any -- not:somequeryoption will be ignored Right (Right _) -> Right $ Left Any -- not:somequeryoption will be ignored
Left err -> Left err Left err -> Left err
parseQueryTerm _ (T.stripPrefix "code:" -> Just s) = Left . Code <$> toRegexCI (T.unpack s) parseQueryTerm _ (T.stripPrefix "code:" -> Just s) = Left . Code <$> toRegexCI s
parseQueryTerm _ (T.stripPrefix "desc:" -> Just s) = Left . Desc <$> toRegexCI (T.unpack s) parseQueryTerm _ (T.stripPrefix "desc:" -> Just s) = Left . Desc <$> toRegexCI s
parseQueryTerm _ (T.stripPrefix "payee:" -> Just s) = Left <$> payeeTag (Just $ T.unpack s) parseQueryTerm _ (T.stripPrefix "payee:" -> Just s) = Left <$> payeeTag (Just s)
parseQueryTerm _ (T.stripPrefix "note:" -> Just s) = Left <$> noteTag (Just $ T.unpack s) parseQueryTerm _ (T.stripPrefix "note:" -> Just s) = Left <$> noteTag (Just s)
parseQueryTerm _ (T.stripPrefix "acct:" -> Just s) = Left . Acct <$> toRegexCI (T.unpack s) parseQueryTerm _ (T.stripPrefix "acct:" -> Just s) = Left . Acct <$> toRegexCI s
parseQueryTerm d (T.stripPrefix "date2:" -> Just s) = parseQueryTerm d (T.stripPrefix "date2:" -> Just s) =
case parsePeriodExpr d s of Left e -> Left $ "\"date2:"++T.unpack s++"\" gave a "++showDateParseError e case parsePeriodExpr d s of Left e -> Left $ "\"date2:"++T.unpack s++"\" gave a "++showDateParseError e
Right (_,span) -> Right $ Left $ Date2 span Right (_,span) -> Right $ Left $ Date2 span
@ -283,7 +284,7 @@ parseQueryTerm _ (T.stripPrefix "depth:" -> Just s)
| otherwise = Left "depth: should have a positive number" | otherwise = Left "depth: should have a positive number"
where n = readDef 0 (T.unpack s) 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 _ (T.stripPrefix "tag:" -> Just s) = Left <$> parseTag s
parseQueryTerm _ "" = Right $ Left $ Any parseQueryTerm _ "" = Right $ Left $ Any
parseQueryTerm d s = parseQueryTerm d $ defaultprefix<>":"<>s parseQueryTerm d s = parseQueryTerm d $ defaultprefix<>":"<>s
@ -322,20 +323,19 @@ parseAmountQueryTerm amtarg =
(parse ">" -> Just q) -> Right (AbsGt ,q) (parse ">" -> Just q) -> Right (AbsGt ,q)
(parse "=" -> Just q) -> Right (AbsEq ,q) (parse "=" -> Just q) -> Right (AbsEq ,q)
(parse "" -> Just q) -> Right (AbsEq ,q) (parse "" -> Just q) -> Right (AbsEq ,q)
_ -> Left $ _ -> Left . T.unpack $
"could not parse as a comparison operator followed by an optionally-signed number: " "could not parse as a comparison operator followed by an optionally-signed number: " <> amtarg
++ T.unpack amtarg
where where
-- Strip outer whitespace from the text, require and remove the -- Strip outer whitespace from the text, require and remove the
-- specified prefix, remove all whitespace from the remainder, and -- specified prefix, remove all whitespace from the remainder, and
-- read it as a simple integer or decimal if possible. -- read it as a simple integer or decimal if possible.
parse :: T.Text -> T.Text -> Maybe Quantity 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 :: T.Text -> Either RegexError Query
parseTag s = do parseTag s = do
tag <- toRegexCI . T.unpack $ if T.null v then s else n tag <- toRegexCI $ if T.null v then s else n
body <- if T.null v then pure Nothing else Just <$> toRegexCI (tail $ T.unpack v) body <- if T.null v then pure Nothing else Just <$> toRegexCI (T.tail v)
return $ Tag tag body return $ Tag tag body
where (n,v) = T.break (=='=') s where (n,v) = T.break (=='=') s
@ -554,7 +554,7 @@ matchesAccount (None) _ = False
matchesAccount (Not m) a = not $ matchesAccount m a matchesAccount (Not m) a = not $ matchesAccount m a
matchesAccount (Or ms) a = any (`matchesAccount` a) ms matchesAccount (Or ms) a = any (`matchesAccount` a) ms
matchesAccount (And ms) a = all (`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 (Depth d) a = accountNameLevel a <= d
matchesAccount (Tag _ _) _ = False matchesAccount (Tag _ _) _ = False
matchesAccount _ _ = True matchesAccount _ _ = True
@ -564,7 +564,7 @@ matchesMixedAmount q (Mixed []) = q `matchesAmount` nullamt
matchesMixedAmount q (Mixed as) = any (q `matchesAmount`) as matchesMixedAmount q (Mixed as) = any (q `matchesAmount`) as
matchesCommodity :: Query -> CommoditySymbol -> Bool matchesCommodity :: Query -> CommoditySymbol -> Bool
matchesCommodity (Sym r) = regexMatch r . T.unpack matchesCommodity (Sym r) = regexMatchText r
matchesCommodity _ = const True matchesCommodity _ = const True
-- | Does the match expression match this (simple) amount ? -- | Does the match expression match this (simple) amount ?
@ -603,10 +603,10 @@ matchesPosting (Any) _ = True
matchesPosting (None) _ = False matchesPosting (None) _ = False
matchesPosting (Or qs) p = any (`matchesPosting` p) qs matchesPosting (Or qs) p = any (`matchesPosting` p) qs
matchesPosting (And qs) p = all (`matchesPosting` p) qs matchesPosting (And qs) p = all (`matchesPosting` p) qs
matchesPosting (Code r) p = regexMatch r $ maybe "" (T.unpack . tcode) $ ptransaction p matchesPosting (Code r) p = maybe False (regexMatchText r . tcode) $ ptransaction p
matchesPosting (Desc r) p = regexMatch r $ maybe "" (T.unpack . tdescription) $ ptransaction p matchesPosting (Desc r) p = maybe False (regexMatchText r . tdescription) $ ptransaction p
matchesPosting (Acct r) p = matches p || matches (originalPosting 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 (Date span) p = span `spanContainsDate` postingDate p
matchesPosting (Date2 span) p = span `spanContainsDate` postingDate2 p matchesPosting (Date2 span) p = span `spanContainsDate` postingDate2 p
matchesPosting (StatusQ s) p = postingStatus p == s 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 q@(Amt _ _) Posting{pamount=amt} = q `matchesMixedAmount` amt
matchesPosting (Sym r) Posting{pamount=Mixed as} = any (matchesCommodity (Sym r)) $ map acommodity as matchesPosting (Sym r) Posting{pamount=Mixed as} = any (matchesCommodity (Sym r)) $ map acommodity as
matchesPosting (Tag n v) p = case (reString n, v) of matchesPosting (Tag n v) p = case (reString n, v) of
("payee", Just v) -> maybe False (regexMatch v . T.unpack . transactionPayee) $ ptransaction p ("payee", Just v) -> maybe False (regexMatchText v . transactionPayee) $ ptransaction p
("note", Just v) -> maybe False (regexMatch v . T.unpack . transactionNote) $ ptransaction p ("note", Just v) -> maybe False (regexMatchText v . transactionNote) $ ptransaction p
(_, v) -> matchesTags n v $ postingAllTags p (_, v) -> matchesTags n v $ postingAllTags p
-- | Does the match expression match this transaction ? -- | Does the match expression match this transaction ?
@ -626,8 +626,8 @@ matchesTransaction (Any) _ = True
matchesTransaction (None) _ = False matchesTransaction (None) _ = False
matchesTransaction (Or qs) t = any (`matchesTransaction` t) qs matchesTransaction (Or qs) t = any (`matchesTransaction` t) qs
matchesTransaction (And qs) t = all (`matchesTransaction` t) qs matchesTransaction (And qs) t = all (`matchesTransaction` t) qs
matchesTransaction (Code r) t = regexMatch r $ T.unpack $ tcode t matchesTransaction (Code r) t = regexMatchText r $ tcode t
matchesTransaction (Desc r) t = regexMatch r $ T.unpack $ tdescription t matchesTransaction (Desc r) t = regexMatchText r $ tdescription t
matchesTransaction q@(Acct _) t = any (q `matchesPosting`) $ tpostings t matchesTransaction q@(Acct _) t = any (q `matchesPosting`) $ tpostings t
matchesTransaction (Date span) t = spanContainsDate span $ tdate t matchesTransaction (Date span) t = spanContainsDate span $ tdate t
matchesTransaction (Date2 span) t = spanContainsDate span $ transactionDate2 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 (Depth d) t = any (Depth d `matchesPosting`) $ tpostings t
matchesTransaction q@(Sym _) t = any (q `matchesPosting`) $ tpostings t matchesTransaction q@(Sym _) t = any (q `matchesPosting`) $ tpostings t
matchesTransaction (Tag n v) t = case (reString n, v) of matchesTransaction (Tag n v) t = case (reString n, v) of
("payee", Just v) -> regexMatch v . T.unpack . transactionPayee $ t ("payee", Just v) -> regexMatchText v $ transactionPayee t
("note", Just v) -> regexMatch v . T.unpack . transactionNote $ t ("note", Just v) -> regexMatchText v $ transactionNote t
(_, v) -> matchesTags n v $ transactionAllTags t (_, v) -> matchesTags n v $ transactionAllTags t
-- | Does the query match the name and optionally the value of any of these tags ? -- | Does the query match the name and optionally the value of any of these tags ?
matchesTags :: Regexp -> Maybe Regexp -> [Tag] -> Bool matchesTags :: Regexp -> Maybe Regexp -> [Tag] -> Bool
matchesTags namepat valuepat = not . null . filter (matches namepat valuepat) matchesTags namepat valuepat = not . null . filter (matches namepat valuepat)
where 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 ? -- | Does the query match this market price ?
matchesPriceDirective :: Query -> PriceDirective -> Bool matchesPriceDirective :: Query -> PriceDirective -> Bool

4
hledger-lib/Hledger/Read/Common.hs
View File

@ -1144,7 +1144,7 @@ digitgroupp :: TextParser m DigitGrp
digitgroupp = label "digits" digitgroupp = label "digits"
$ makeGroup <$> takeWhile1P (Just "digit") isDigit $ makeGroup <$> takeWhile1P (Just "digit") isDigit
where 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)) step (!l, !a) c = (l+1, a*10 + fromIntegral (digitToInt c))
--- *** comments --- *** comments
@ -1483,7 +1483,7 @@ regexaliasp = do
char '=' char '='
skipNonNewlineSpaces skipNonNewlineSpaces
repl <- anySingle `manyTill` eolof repl <- anySingle `manyTill` eolof
case toRegexCI re of case toRegexCI $ T.pack re of
Right r -> return $! RegexAlias r repl Right r -> return $! RegexAlias r repl
Left e -> customFailure $! parseErrorAtRegion off1 off2 e Left e -> customFailure $! parseErrorAtRegion off1 off2 e

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

@ -206,7 +206,7 @@ expandIncludes dir content = mapM (expandLine dir) (T.lines content) >>= return
case line of case line of
(T.stripPrefix "include " -> Just f) -> expandIncludes dir' =<< T.readFile f' (T.stripPrefix "include " -> Just f) -> expandIncludes dir' =<< T.readFile f'
where where
f' = dir </> dropWhile isSpace (T.unpack f) f' = dir </> T.unpack (T.dropWhile isSpace f)
dir' = takeDirectory f' dir' = takeDirectory f'
_ -> return line _ -> return line
@ -653,8 +653,7 @@ csvfieldreferencep :: CsvRulesParser CsvFieldReference
csvfieldreferencep = do csvfieldreferencep = do
lift $ dbgparse 8 "trying csvfieldreferencep" lift $ dbgparse 8 "trying csvfieldreferencep"
char '%' char '%'
f <- T.unpack <$> fieldnamep -- XXX unpack and then pack T.cons '%' . textQuoteIfNeeded <$> fieldnamep
return . T.pack $ '%' : quoteIfNeeded f
-- A single regular expression -- A single regular expression
regexp :: CsvRulesParser () -> CsvRulesParser Regexp regexp :: CsvRulesParser () -> CsvRulesParser Regexp
@ -663,7 +662,7 @@ regexp end = do
-- notFollowedBy matchoperatorp -- notFollowedBy matchoperatorp
c <- lift nonspace c <- lift nonspace
cs <- anySingle `manyTill` end 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 Left x -> Fail.fail $ "CSV parser: " ++ x
Right x -> return x Right x -> return x
@ -777,7 +776,7 @@ readJournalFromCsv mrulesfile csvfile csvdata =
when (not rulesfileexists) $ do when (not rulesfileexists) $ do
dbg1IO "creating conversion rules file" rulesfile dbg1IO "creating conversion rules file" rulesfile
writeFile rulesfile $ T.unpack rulestext T.writeFile rulesfile rulestext
return $ Right nulljournal{jtxns=txns''} return $ Right nulljournal{jtxns=txns''}
@ -920,9 +919,9 @@ transactionFromCsvRecord sourcepos rules record = t
Nothing -> Unmarked Nothing -> Unmarked
Just s -> either statuserror id $ runParser (statusp <* eof) "" s Just s -> either statuserror id $ runParser (statusp <* eof) "" s
where where
statuserror err = error' $ unlines statuserror err = error' . T.unpack $ T.unlines
["error: could not parse \""<>T.unpack s<>"\" as a cleared status (should be *, ! or empty)" ["error: could not parse \""<>s<>"\" as a cleared status (should be *, ! or empty)"
,"the parse error is: "++customErrorBundlePretty err ,"the parse error is: "<>T.pack (customErrorBundlePretty err)
] ]
code = maybe "" singleline $ fieldval "code" code = maybe "" singleline $ fieldval "code"
description = maybe "" singleline $ fieldval "description" description = maybe "" singleline $ fieldval "description"
@ -1025,7 +1024,7 @@ getAmount rules record currency p1IsVirtual n =
] ]
++ [" assignment: " <> f <> " " <> ++ [" assignment: " <> f <> " " <>
fromMaybe "" (hledgerField rules record 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] | (f,a) <- fs]
-- | Figure out the expected balance (assertion or assignment) specified for posting N, -- | 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 where
-- does this individual matcher match the current csv record ? -- does this individual matcher match the current csv record ?
matcherMatches :: Matcher -> Bool matcherMatches :: Matcher -> Bool
matcherMatches (RecordMatcher _ pat) = regexMatch pat' wholecsvline matcherMatches (RecordMatcher _ pat) = regexMatchText pat' wholecsvline
where where
pat' = dbg7 "regex" pat pat' = dbg7 "regex" pat
-- A synthetic whole CSV record to match against. Note, this can be -- 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 -- - any quotes enclosing field values are removed
-- - and the field separator is always comma -- - and the field separator is always comma
-- which means that a field containing a comma will look like two fields. -- which means that a field containing a comma will look like two fields.
wholecsvline = dbg7 "wholecsvline" . T.unpack $ T.intercalate "," record wholecsvline = dbg7 "wholecsvline" $ T.intercalate "," record
matcherMatches (FieldMatcher _ csvfieldref pat) = regexMatch pat $ T.unpack csvfieldvalue matcherMatches (FieldMatcher _ csvfieldref pat) = regexMatchText pat csvfieldvalue
where where
-- the value of the referenced CSV field to match against. -- the value of the referenced CSV field to match against.
csvfieldvalue = dbg7 "csvfieldvalue" $ replaceCsvFieldReference rules record csvfieldref csvfieldvalue = dbg7 "csvfieldvalue" $ replaceCsvFieldReference rules record csvfieldref

4
hledger-lib/Hledger/Read/JournalReader.hs
View File

@ -380,8 +380,8 @@ parseAccountTypeCode s =
"c" -> Right Cash "c" -> Right Cash
_ -> Left err _ -> Left err
where where
err = "invalid account type code "++T.unpack s++", should be one of " ++ err = T.unpack $ "invalid account type code "<>s<>", should be one of " <>
(intercalate ", " $ ["A","L","E","R","X","C","Asset","Liability","Equity","Revenue","Expense","Cash"]) T.intercalate ", " ["A","L","E","R","X","C","Asset","Liability","Equity","Revenue","Expense","Cash"]
-- Add an account declaration to the journal, auto-numbering it. -- Add an account declaration to the journal, auto-numbering it.
addAccountDeclaration :: (AccountName,Text,[Tag]) -> JournalParser m () addAccountDeclaration :: (AccountName,Text,[Tag]) -> JournalParser m ()

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

@ -380,7 +380,7 @@ budgetReportAsCsv
where where
flattentuples abs = concat [[a,b] | (a,b) <- abs] flattentuples abs = concat [[a,b] | (a,b) <- abs]
showmamt = maybe "" (T.pack . showMixedAmountOneLineWithoutPrice False) showmamt = maybe "" (wbToText . showMixed oneLine)
-- tests -- tests

36
hledger-lib/Hledger/Utils/Regex.hs
View File

@ -1,5 +1,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeSynonymInstances #-}
{-| {-|
@ -54,6 +56,7 @@ module Hledger.Utils.Regex (
,RegexError ,RegexError
-- * total regex operations -- * total regex operations
,regexMatch ,regexMatch
,regexMatchText
,regexReplace ,regexReplace
,regexReplaceUnmemo ,regexReplaceUnmemo
,regexReplaceAllBy ,regexReplaceAllBy
@ -66,6 +69,10 @@ import Data.Array ((!), elems, indices)
import Data.Char (isDigit) import Data.Char (isDigit)
import Data.List (foldl') import Data.List (foldl')
import Data.MemoUgly (memo) 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 qualified Data.Text as T
import Text.Regex.TDFA ( import Text.Regex.TDFA (
Regex, CompOption(..), defaultCompOpt, defaultExecOpt, 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. -- | Regular expression. Extended regular expression-ish syntax ? But does not support eg (?i) syntax.
data Regexp data Regexp
= Regexp { reString :: String, reCompiled :: Regex } = Regexp { reString :: Text, reCompiled :: Regex }
| RegexpCI { reString :: String, reCompiled :: Regex } | RegexpCI { reString :: Text, reCompiled :: Regex }
instance Eq Regexp where instance Eq Regexp where
Regexp s1 _ == Regexp s2 _ = s1 == s2 Regexp s1 _ == Regexp s2 _ = s1 == s2
@ -93,7 +100,7 @@ instance Ord Regexp where
RegexpCI _ _ `compare` Regexp _ _ = GT RegexpCI _ _ `compare` Regexp _ _ = GT
instance Show Regexp where 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 where app_prec = 10
reCons = case r of Regexp _ _ -> showString "Regexp " reCons = case r of Regexp _ _ -> showString "Regexp "
RegexpCI _ _ -> showString "RegexpCI " RegexpCI _ _ -> showString "RegexpCI "
@ -108,8 +115,8 @@ instance Read Regexp where
where app_prec = 10 where app_prec = 10
instance ToJSON Regexp where instance ToJSON Regexp where
toJSON (Regexp s _) = String . T.pack $ "Regexp " ++ s toJSON (Regexp s _) = String $ "Regexp " <> s
toJSON (RegexpCI s _) = String . T.pack $ "RegexpCI " ++ s toJSON (RegexpCI s _) = String $ "RegexpCI " <> s
instance RegexLike Regexp String where instance RegexLike Regexp String where
matchOnce = matchOnce . reCompiled matchOnce = matchOnce . reCompiled
@ -124,24 +131,24 @@ instance RegexContext Regexp String String where
matchM = matchM . reCompiled matchM = matchM . reCompiled
-- Convert a Regexp string to a compiled Regex, or return an error message. -- 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) toRegex = memo $ \s -> mkRegexErr s (Regexp s <$> makeRegexM s)
-- Like toRegex, but make a case-insensitive Regex. -- 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) toRegexCI = memo $ \s -> mkRegexErr s (RegexpCI s <$> makeRegexOptsM defaultCompOpt{caseSensitive=False} defaultExecOpt s)
-- | Make a nice error message for a regexp error. -- | 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 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 -- Convert a Regexp string to a compiled Regex, throw an error
toRegex' :: String -> Regexp toRegex' :: Text -> Regexp
toRegex' = either error' id . toRegex toRegex' = either error' id . toRegex
-- Like toRegex', but make a case-insensitive Regex. -- Like toRegex', but make a case-insensitive Regex.
toRegexCI' :: String -> Regexp toRegexCI' :: Text -> Regexp
toRegexCI' = either error' id . toRegexCI toRegexCI' = either error' id . toRegexCI
-- | A replacement pattern. May include numeric backreferences (\N). -- | A replacement pattern. May include numeric backreferences (\N).
@ -159,6 +166,13 @@ type RegexError = String
regexMatch :: Regexp -> String -> Bool regexMatch :: Regexp -> String -> Bool
regexMatch = matchTest 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 -- new total functions

2
hledger-lib/Hledger/Utils/String.hs
View File

@ -349,4 +349,4 @@ stripAnsi :: String -> String
stripAnsi s = either err id $ regexReplace ansire "" s stripAnsi s = either err id $ regexReplace ansire "" s
where where
err = error "stripAnsi: invalid replacement pattern" -- PARTIAL, shouldn't happen 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

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

@ -124,7 +124,7 @@ formatText leftJustified minwidth maxwidth t =
-- double-quoted. -- double-quoted.
quoteIfSpaced :: T.Text -> T.Text quoteIfSpaced :: T.Text -> T.Text
quoteIfSpaced s | isSingleQuoted s || isDoubleQuoted s = s 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 | otherwise = textQuoteIfNeeded s
-- -- | Wrap a string in double quotes, and \-prefix any embedded single -- -- | 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 -- -- | Double-quote this string if it contains whitespace, single quotes
-- -- or double-quotes, escaping the quotes as needed. -- -- or double-quotes, escaping the quotes as needed.
textQuoteIfNeeded :: T.Text -> T.Text 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 | otherwise = s
-- -- | Single-quote this string if it contains whitespace or double-quotes. -- -- | 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 -- | Read a decimal number from a Text. Assumes the input consists only of digit
-- characters. -- characters.
readDecimal :: Text -> Integer readDecimal :: Text -> Integer
readDecimal = foldl' step 0 . T.unpack readDecimal = T.foldl' step 0
where step a c = a * 10 + toInteger (digitToInt c) where step a c = a * 10 + toInteger (digitToInt c)

2
hledger-ui/Hledger/UI/AccountsScreen.hs
View File

@ -175,7 +175,7 @@ asDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}
<+> toggles <+> toggles
<+> str (" account " ++ if ishistorical then "balances" else "changes") <+> str (" account " ++ if ishistorical then "balances" else "changes")
<+> borderPeriodStr (if ishistorical then "at end of" else "in") (period_ ropts) <+> 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 <+> borderDepthStr mdepth
<+> str (" ("++curidx++"/"++totidx++")") <+> str (" ("++curidx++"/"++totidx++")")
<+> (if ignore_assertions_ $ inputopts_ copts <+> (if ignore_assertions_ $ inputopts_ copts

4
hledger-ui/Hledger/UI/Main.hs
View File

@ -141,8 +141,8 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportspec_=rsp
where where
acct = headDef (error' $ "--register "++apat++" did not match any account") -- PARTIAL: acct = headDef (error' $ "--register "++apat++" did not match any account") -- PARTIAL:
. filterAccts $ journalAccountNames j . filterAccts $ journalAccountNames j
filterAccts = case toRegexCI apat of filterAccts = case toRegexCI $ T.pack apat of
Right re -> filter (regexMatch re . T.unpack) Right re -> filter (regexMatchText re)
Left _ -> const [] Left _ -> const []
-- Initialising the accounts screen is awkward, requiring -- Initialising the accounts screen is awkward, requiring
-- another temporary UIState value.. -- another temporary UIState value..

2
hledger-ui/Hledger/UI/RegisterScreen.hs
View File

@ -203,7 +203,7 @@ rsDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}
<+> togglefilters <+> togglefilters
<+> str " transactions" <+> str " transactions"
-- <+> str (if ishistorical then " historical total" else " period total") -- <+> 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" -- <+> str " and subs"
<+> borderPeriodStr "in" (period_ ropts) <+> borderPeriodStr "in" (period_ ropts)
<+> str " (" <+> str " ("

2
hledger-ui/Hledger/UI/UIState.hs
View File

@ -308,7 +308,7 @@ showMinibuffer :: UIState -> UIState
showMinibuffer ui = setMode (Minibuffer e) ui showMinibuffer ui = setMode (Minibuffer e) ui
where where
e = applyEdit gotoEOL $ editor MinibufferEditor (Just 1) oldq 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 . querystring_ . rsOpts . reportspec_ . cliopts_ $ aopts ui
-- | Close the minibuffer, discarding any edit in progress. -- | Close the minibuffer, discarding any edit in progress.

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

@ -167,7 +167,8 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _)
{ esArgs = drop 1 esArgs { esArgs = drop 1 esArgs
, esDefDate = date , 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 yyyymmddFormat = iso8601DateFormat Nothing
confirmedTransactionWizard prevInput{prevDateAndCode=Just dateAndCodeString} es' (EnterDescAndComment (date, code) : stack) confirmedTransactionWizard prevInput{prevDateAndCode=Just dateAndCodeString} es' (EnterDescAndComment (date, code) : stack)
Nothing -> Nothing ->
@ -237,7 +238,7 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _)
,pcomment=comment ,pcomment=comment
,ptype=accountNamePostingType $ T.pack account ,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) prevAmountAndCmnt' = replaceNthOrAppend (length esPostings) amountAndCommentString (prevAmountAndCmnt prevInput)
es' = es{esPostings=esPostings++[posting], esArgs=drop 2 esArgs} es' = es{esPostings=esPostings++[posting], esArgs=drop 2 esArgs}
confirmedTransactionWizard prevInput{prevAmountAndCmnt=prevAmountAndCmnt'} es' (EnterNewPosting txnParams (Just posting) : stack) confirmedTransactionWizard prevInput{prevAmountAndCmnt=prevAmountAndCmnt'} es' (EnterNewPosting txnParams (Just posting) : stack)

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

@ -80,8 +80,8 @@ aregister opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
let let
acct = headDef (error' $ show apat++" did not match any account") -- PARTIAL: acct = headDef (error' $ show apat++" did not match any account") -- PARTIAL:
. filterAccts $ journalAccountNames j . filterAccts $ journalAccountNames j
filterAccts = case toRegexCI apat of filterAccts = case toRegexCI $ T.pack apat of
Right re -> filter (regexMatch re . T.unpack) Right re -> filter (regexMatchText re)
Left _ -> const [] Left _ -> const []
-- gather report options -- gather report options
inclusive = True -- tree_ ropts inclusive = True -- tree_ ropts
@ -134,8 +134,8 @@ accountTransactionsReportItemAsCsvRecord
where where
idx = T.pack $ show tindex idx = T.pack $ show tindex
date = showDate $ transactionRegisterDate reportq thisacctq t date = showDate $ transactionRegisterDate reportq thisacctq t
amt = T.pack $ showMixedAmountOneLineWithoutPrice False change amt = wbToText $ showMixed oneLine change
bal = T.pack $ showMixedAmountOneLineWithoutPrice False balance bal = wbToText $ showMixed oneLine balance
-- | Render a register report as plain text suitable for console output. -- | Render a register report as plain text suitable for console output.
accountTransactionsReportAsText :: CliOpts -> Query -> Query -> AccountTransactionsReport -> TL.Text accountTransactionsReportAsText :: CliOpts -> Query -> Query -> AccountTransactionsReport -> TL.Text
@ -146,7 +146,7 @@ accountTransactionsReportAsText copts reportq thisacctq items
where where
amtwidth = maximumStrict $ 12 : map (wbWidth . showamt . itemamt) items amtwidth = maximumStrict $ 12 : map (wbWidth . showamt . itemamt) items
balwidth = maximumStrict $ 12 : map (wbWidth . showamt . itembal) 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 where mmax = if no_elide_ . rsOpts . reportspec_ $ copts then Nothing else Just 32
itemamt (_,_,_,_,a,_) = a itemamt (_,_,_,_,a,_) = a
itembal (_,_,_,_,_,a) = a itembal (_,_,_,_,_,a) = a
@ -155,7 +155,7 @@ accountTransactionsReportAsText copts reportq thisacctq items
where where
-- XXX temporary hack ? recover the account name from the query -- XXX temporary hack ? recover the account name from the query
macct = case filterQuery queryIsAcct thisacctq of 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 _ -> Nothing -- shouldn't happen
-- | Render one account register report line item as plain text. Layout is like so: -- | Render one account register report line item as plain text. Layout is like so:

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

@ -357,11 +357,11 @@ balance opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
balanceReportAsCsv :: ReportOpts -> BalanceReport -> CSV balanceReportAsCsv :: ReportOpts -> BalanceReport -> CSV
balanceReportAsCsv opts (items, total) = balanceReportAsCsv opts (items, total) =
["account","balance"] : ["account","balance"] :
[[a, T.pack $ showMixedAmountOneLineWithoutPrice False b] | (a, _, _, b) <- items] [[a, wbToText $ showMixed oneLine b] | (a, _, _, b) <- items]
++ ++
if no_total_ opts if no_total_ opts
then [] then []
else [["total", T.pack $ showMixedAmountOneLineWithoutPrice False total]] else [["total", wbToText $ showMixed oneLine total]]
-- | Render a single-column balance report as plain text. -- | Render a single-column balance report as plain text.
balanceReportAsText :: ReportOpts -> BalanceReport -> TB.Builder balanceReportAsText :: ReportOpts -> BalanceReport -> TB.Builder
@ -454,7 +454,7 @@ multiBalanceReportAsCsv opts@ReportOpts{average_, row_total_}
++ ["Average" | average_] ++ ["Average" | average_]
) : ) :
[displayFull a : [displayFull a :
map (T.pack . showMixedAmountOneLineWithoutPrice False) map (wbToText . showMixed oneLine)
(amts (amts
++ [rowtot | row_total_] ++ [rowtot | row_total_]
++ [rowavg | average_]) ++ [rowavg | average_])
@ -463,7 +463,7 @@ multiBalanceReportAsCsv opts@ReportOpts{average_, row_total_}
if no_total_ opts if no_total_ opts
then [] then []
else ["Total:" : else ["Total:" :
map (T.pack . showMixedAmountOneLineWithoutPrice False) ( map (wbToText . showMixed oneLine) (
coltotals coltotals
++ [tot | row_total_] ++ [tot | row_total_]
++ [avg | average_] ++ [avg | average_]
@ -637,9 +637,9 @@ tests_Balance = tests "Balance" [
test "unicode in balance layout" $ do test "unicode in balance layout" $ do
j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
let rspec = defreportspec{rsOpts=defreportopts{no_total_=True}} 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 актив:наличные"
," 100 расходы:покупки" ," 100 расходы:покупки"
] ]

15
hledger/Hledger/Cli/Commands/Check/Uniqueleafnames.hs
View File

@ -1,3 +1,5 @@
{-# LANGUAGE OverloadedStrings #-}
module Hledger.Cli.Commands.Check.Uniqueleafnames ( module Hledger.Cli.Commands.Check.Uniqueleafnames (
journalCheckUniqueleafnames journalCheckUniqueleafnames
) )
@ -6,21 +8,22 @@ where
import Data.Function import Data.Function
import Data.List import Data.List
import Data.List.Extra (nubSort) import Data.List.Extra (nubSort)
import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as T
import Hledger import Hledger
import Text.Printf
journalCheckUniqueleafnames :: Journal -> Either String () journalCheckUniqueleafnames :: Journal -> Either String ()
journalCheckUniqueleafnames j = do journalCheckUniqueleafnames j = do
let dupes = checkdupes' $ accountsNames j let dupes = checkdupes' $ accountsNames j
if null dupes if null dupes
then Right () then Right ()
else Left $ else Left . T.unpack $
-- XXX make output more like Checkdates.hs, Check.hs etc. -- XXX make output more like Checkdates.hs, Check.hs etc.
concatMap render dupes foldMap render dupes
where where
render (leafName, accountNameL) = 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' :: (Ord k, Eq k) => [(k, v)] -> [(k, [v])]
checkdupes' l = zip dupLeafs dupAccountNames checkdupes' l = zip dupLeafs dupAccountNames
@ -31,8 +34,8 @@ checkdupes' l = zip dupLeafs dupAccountNames
. groupBy ((==) `on` fst) . groupBy ((==) `on` fst)
. sortBy (compare `on` fst) . sortBy (compare `on` fst)
accountsNames :: Journal -> [(String, AccountName)] accountsNames :: Journal -> [(Text, AccountName)]
accountsNames j = map leafAndAccountName as accountsNames j = map leafAndAccountName as
where leafAndAccountName a = (T.unpack $ accountLeafName a, a) where leafAndAccountName a = (accountLeafName a, a)
ps = journalPostings j ps = journalPostings j
as = nubSort $ map paccount ps as = nubSort $ map paccount ps

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

@ -18,7 +18,6 @@ import Data.Ord (comparing)
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Data.Time (diffDays) import Data.Time (diffDays)
import Data.Either (partitionEithers) import Data.Either (partitionEithers)
import qualified Data.Text as T
import qualified Data.Text.IO as T import qualified Data.Text.IO as T
import System.Exit (exitFailure) import System.Exit (exitFailure)
@ -107,7 +106,7 @@ diff CliOpts{file_=[f1, f2], reportspec_=ReportSpec{rsQuery=Acct acctRe}} _ = do
j1 <- readJournalFile' f1 j1 <- readJournalFile' f1
j2 <- readJournalFile' f2 j2 <- readJournalFile' f2
let acct = T.pack $ reString acctRe let acct = reString acctRe
let pp1 = matchingPostings acct j1 let pp1 = matchingPostings acct j1
let pp2 = matchingPostings acct j2 let pp2 = matchingPostings acct j2

7
hledger/Hledger/Cli/Commands/Files.hs
View File

@ -4,7 +4,6 @@ The @files@ command lists included files.
-} -}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Hledger.Cli.Commands.Files ( module Hledger.Cli.Commands.Files (
@ -12,8 +11,8 @@ module Hledger.Cli.Commands.Files (
,files ,files
) where ) where
import Data.List import qualified Data.Text as T
import Safe import Safe (headMay)
import Hledger import Hledger
import Prelude hiding (putStrLn) import Prelude hiding (putStrLn)
@ -33,7 +32,7 @@ filesmode = hledgerCommandMode
files :: CliOpts -> Journal -> IO () files :: CliOpts -> Journal -> IO ()
files CliOpts{rawopts_=rawopts} j = do files CliOpts{rawopts_=rawopts} j = do
let args = listofstringopt "args" rawopts 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 let files = maybe id (filter . regexMatch) regex
$ map fst $ map fst
$ jfiles j $ jfiles j

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

@ -1,3 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Hledger.Cli.Commands.Prices ( module Hledger.Cli.Commands.Prices (
@ -10,6 +11,7 @@ import qualified Data.Map as M
import Data.Maybe import Data.Maybe
import Data.List import Data.List
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Time import Data.Time
import Hledger import Hledger
import Hledger.Cli.CliOptions import Hledger.Cli.CliOptions
@ -33,7 +35,7 @@ prices opts j = do
cprices = map (stylePriceDirectiveExceptPrecision styles) $ concatMap postingsPriceDirectivesFromCosts ps cprices = map (stylePriceDirectiveExceptPrecision styles) $ concatMap postingsPriceDirectivesFromCosts ps
icprices = map (stylePriceDirectiveExceptPrecision styles) $ concatMap postingsPriceDirectivesFromCosts $ mapAmount invertPrice ps icprices = map (stylePriceDirectiveExceptPrecision styles) $ concatMap postingsPriceDirectivesFromCosts $ mapAmount invertPrice ps
allprices = mprices ++ ifBoolOpt "costs" cprices ++ ifBoolOpt "inverted-costs" icprices allprices = mprices ++ ifBoolOpt "costs" cprices ++ ifBoolOpt "inverted-costs" icprices
mapM_ (putStrLn . showPriceDirective) $ mapM_ (T.putStrLn . showPriceDirective) $
sortOn pddate $ sortOn pddate $
filter (matchesPriceDirective q) $ filter (matchesPriceDirective q) $
allprices allprices
@ -41,8 +43,8 @@ prices opts j = do
ifBoolOpt opt | boolopt opt $ rawopts_ opts = id ifBoolOpt opt | boolopt opt $ rawopts_ opts = id
| otherwise = const [] | otherwise = const []
showPriceDirective :: PriceDirective -> String showPriceDirective :: PriceDirective -> T.Text
showPriceDirective mp = unwords ["P", show $ pddate mp, T.unpack . quoteCommoditySymbolIfNeeded $ pdcommodity mp, showAmountWithZeroCommodity $ pdamount mp] 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' :: Quantity -> Amount -> Amount
divideAmount' n a = a' where divideAmount' n a = a' where

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

@ -166,9 +166,10 @@ postingToCSV p =
-- commodity goes into separate column, so we suppress it, along with digit group -- commodity goes into separate column, so we suppress it, along with digit group
-- separators and prices -- separators and prices
let a_ = a{acommodity="",astyle=(astyle a){asdigitgroups=Nothing},aprice=Nothing} in let a_ = a{acommodity="",astyle=(astyle a){asdigitgroups=Nothing},aprice=Nothing} in
let amount = T.pack $ showAmount a_ in let showamt = TL.toStrict . TB.toLazyText . wbBuilder . showAmountB noColour in
let credit = if q < 0 then T.pack . showAmount $ negate a_ else "" in let amount = showamt a_ in
let debit = if q >= 0 then T.pack $ showAmount a_ else "" 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]) [account, amount, c, credit, debit, status, comment])
amounts amounts
where where

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

@ -87,8 +87,8 @@ postingsReportItemAsCsvRecord (_, _, _, p, b) = [idx,date,code,desc,acct,amt,bal
BalancedVirtualPosting -> wrap "[" "]" BalancedVirtualPosting -> wrap "[" "]"
VirtualPosting -> wrap "(" ")" VirtualPosting -> wrap "(" ")"
_ -> id _ -> id
amt = T.pack $ showMixedAmountOneLineWithoutPrice False $ pamount p amt = wbToText . showMixed oneLine $ pamount p
bal = T.pack $ showMixedAmountOneLineWithoutPrice False b bal = wbToText $ showMixed oneLine b
-- | Render a register report as plain text suitable for console output. -- | Render a register report as plain text suitable for console output.
postingsReportAsText :: CliOpts -> PostingsReport -> TL.Text postingsReportAsText :: CliOpts -> PostingsReport -> TL.Text
@ -102,7 +102,7 @@ postingsReportAsText opts items =
itembal (_,_,_,_,a) = a itembal (_,_,_,_,a) = a
unlinesB [] = mempty unlinesB [] = mempty
unlinesB xs = mconcat (intersperse (TB.fromText "\n") xs) <> TB.fromText "\n" 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: -- | Render one register report line item as plain text. Layout is like so:
-- @ -- @

4
hledger/Hledger/Cli/Commands/Tags.hs
View File

@ -29,7 +29,7 @@ tags :: CliOpts -> Journal -> IO ()
tags CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do tags CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
d <- getCurrentDay d <- getCurrentDay
let args = listofstringopt "args" rawopts 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 let
querystring = map T.pack $ drop 1 args querystring = map T.pack $ drop 1 args
values = boolopt "values" rawopts values = boolopt "values" rawopts
@ -44,7 +44,7 @@ tags CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
(if parsed then id else nubSort) (if parsed then id else nubSort)
[ r [ r
| (t,v) <- concatMap transactionAllTags txns | (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 , let r = if values then v else t
, not (values && T.null v && not empty) , not (values && T.null v && not empty)
] ]

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

@ -263,7 +263,7 @@ compoundBalanceReportAsCsv ropts (CompoundPeriodicReport title colspans subrepor
| no_total_ ropts || length subreports == 1 = id | no_total_ ropts || length subreports == 1 = id
| otherwise = (++ | otherwise = (++
["Net:" : ["Net:" :
map (T.pack . showMixedAmountOneLineWithoutPrice False) ( map (wbToText . showMixed oneLine) (
coltotals coltotals
++ (if row_total_ ropts then [grandtotal] else []) ++ (if row_total_ ropts then [grandtotal] else [])
++ (if average_ ropts then [grandavg] else []) ++ (if average_ ropts then [grandavg] else [])
@ -307,14 +307,12 @@ compoundBalanceReportAsHtml ropts cbr =
totalrows | no_total_ ropts || length subreports == 1 = [] totalrows | no_total_ ropts || length subreports == 1 = []
| otherwise = | otherwise =
let defstyle = style_ "text-align:right" let defstyle = style_ "text-align:right"
in orEmpty b x = if b then x else mempty
[tr_ $ mconcat $ in [tr_ $ th_ [class_ "", style_ "text-align:left"] "Net:"
th_ [class_ "", style_ "text-align:left"] "Net:" <> foldMap (th_ [class_ "amount coltotal", defstyle] . toHtml . wbUnpack . showMixed oneLine) coltotals
: [th_ [class_ "amount coltotal", defstyle] (toHtml $ showMixedAmountOneLineWithoutPrice False a) | a <- coltotals] <> orEmpty (row_total_ ropts) (th_ [class_ "amount coltotal", defstyle] . toHtml . wbUnpack $ showMixed oneLine grandtotal)
++ (if row_total_ ropts then [th_ [class_ "amount coltotal", defstyle] $ toHtml $ showMixedAmountOneLineWithoutPrice False grandtotal] else []) <> orEmpty (average_ ropts) (th_ [class_ "amount colaverage", defstyle] . toHtml . wbUnpack $ showMixed oneLine grandavg)
++ (if average_ ropts then [th_ [class_ "amount colaverage", defstyle] $ toHtml $ showMixedAmountOneLineWithoutPrice False grandavg] else [])
] ]
in do in do
style_ (T.unlines ["" style_ (T.unlines [""
,"td { padding:0 0.5em; }" ,"td { padding:0 0.5em; }"