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 2020-12-27 10:52:39 +11:00
parent 07a7c3d3a8
commit e4e533eb9f
27 changed files with 153 additions and 137 deletions

View File

@ -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)

View File

@ -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

View File

@ -167,19 +167,19 @@ data AmountDisplayOpts = AmountDisplayOpts
, displayMaxWidth :: Maybe Int -- ^ Maximum width to clip to
} deriving (Show)
instance Default AmountDisplayOpts where
def = AmountDisplayOpts { displayPrice = True
, displayColour = True
, displayZeroCommodity = False
, displayNormalised = True
, displayOneLine = False
, displayMinWidth = Nothing
, displayMaxWidth = Nothing
}
-- | Display Amount and MixedAmount with no colour.
instance Default AmountDisplayOpts where def = noColour
-- | Display Amount and MixedAmount with no colour.
noColour :: AmountDisplayOpts
noColour = def{displayColour=False}
noColour = AmountDisplayOpts { displayPrice = True
, displayColour = False
, displayZeroCommodity = False
, displayNormalised = True
, displayOneLine = False
, displayMinWidth = Nothing
, displayMaxWidth = Nothing
}
-- | Display Amount and MixedAmount with no prices.
noPrice :: AmountDisplayOpts
@ -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.

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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 ()

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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)

View File

@ -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

View File

@ -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..

View File

@ -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 " ("

View File

@ -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.

View File

@ -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)

View File

@ -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:

View File

@ -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 расходы:покупки"
]

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -1,4 +1,5 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Hledger.Cli.Commands.Prices (
pricesmode
@ -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

View File

@ -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

View File

@ -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:
-- @

View File

@ -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)
]

View File

@ -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; }"