From 2538d14ea709e6a8de62c5bfdc2ccd41e18aa1ab Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 23 May 2016 18:16:21 -0700 Subject: [PATCH] lib: textification begins! account names The first of several conversions from String to (strict) Text, hopefully reducing space and time usage. This one shows a small improvement, with GHC 7.10.3 and text-1.2.2.1: hledger -f data/100x100x10.journal stats string: <> text: <> hledger -f data/1000x100x10.journal stats string: <> text: <> hledger -f data/10000x100x10.journal stats string: <> text: <> hledger -f data/100000x100x10.journal stats string: <> text: <> --- hledger-lib/Hledger/Data/Account.hs | 2 +- hledger-lib/Hledger/Data/AccountName.hs | 63 +-- hledger-lib/Hledger/Data/Journal.hs | 8 +- hledger-lib/Hledger/Data/Ledger.hs | 4 +- hledger-lib/Hledger/Data/Posting.hs | 29 +- hledger-lib/Hledger/Data/Timeclock.hs | 5 +- hledger-lib/Hledger/Data/Transaction.hs | 32 +- hledger-lib/Hledger/Data/Types.hs | 6 +- hledger-lib/Hledger/Query.hs | 17 +- hledger-lib/Hledger/Read/Common.hs | 9 +- hledger-lib/Hledger/Read/CsvReader.hs | 6 +- hledger-lib/Hledger/Read/JournalReader.hs | 6 +- hledger-lib/Hledger/Read/TimeclockReader.hs | 4 + hledger-lib/Hledger/Reports/BalanceReport.hs | 2 +- hledger-lib/Hledger/Reports/PostingsReport.hs | 2 +- .../Hledger/Reports/TransactionsReports.hs | 4 +- hledger-lib/Hledger/Utils.hs | 6 + hledger-lib/Hledger/Utils/String.hs | 1 + hledger-lib/Hledger/Utils/Text.hs | 404 ++++++++++++++++++ hledger-lib/future-package.yaml | 1 + hledger-lib/hledger-lib.cabal | 3 + hledger-ui/Hledger/UI/AccountsScreen.hs | 10 +- hledger-ui/Hledger/UI/Main.hs | 4 +- hledger-ui/Hledger/UI/RegisterScreen.hs | 4 +- hledger-ui/Hledger/UI/TransactionScreen.hs | 4 +- hledger-ui/Hledger/UI/UITypes.hs | 2 +- hledger-ui/future-package.yaml | 1 + hledger-ui/hledger-ui.cabal | 1 + hledger-web/Handler/Common.hs | 13 +- hledger-web/Handler/JournalR.hs | 9 +- hledger-web/Handler/RegisterR.hs | 4 +- hledger-web/future-package.yaml | 1 + hledger-web/hledger-web.cabal | 6 +- hledger/Hledger/Cli.hs | 2 + hledger/Hledger/Cli/Accounts.hs | 11 +- hledger/Hledger/Cli/Add.hs | 14 +- hledger/Hledger/Cli/Balance.hs | 31 +- hledger/Hledger/Cli/Register.hs | 6 +- hledger/Hledger/Cli/Tests.hs | 4 +- hledger/Hledger/Cli/Utils.hs | 4 +- 40 files changed, 626 insertions(+), 119 deletions(-) create mode 100644 hledger-lib/Hledger/Utils/Text.hs diff --git a/hledger-lib/Hledger/Data/Account.hs b/hledger-lib/Hledger/Data/Account.hs index 1dafc7e14..1f4813b21 100644 --- a/hledger-lib/Hledger/Data/Account.hs +++ b/hledger-lib/Hledger/Data/Account.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RecordWildCards, StandaloneDeriving #-} +{-# LANGUAGE RecordWildCards, StandaloneDeriving, OverloadedStrings #-} {-| diff --git a/hledger-lib/Hledger/Data/AccountName.hs b/hledger-lib/Hledger/Data/AccountName.hs index 01178edac..d70fb50f5 100644 --- a/hledger-lib/Hledger/Data/AccountName.hs +++ b/hledger-lib/Hledger/Data/AccountName.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoMonomorphismRestriction#-} +{-# LANGUAGE NoMonomorphismRestriction, OverloadedStrings #-} {-| 'AccountName's are strings like @assets:cash:petty@, with multiple @@ -10,7 +10,9 @@ hierarchy. module Hledger.Data.AccountName where import Data.List -import Data.List.Split (splitOn) +import Data.Monoid +import Data.Text (Text) +import qualified Data.Text as T import Data.Tree import Test.HUnit import Text.Printf @@ -19,24 +21,29 @@ import Hledger.Data.Types import Hledger.Utils - --- change to use a different separator for nested accounts +acctsepchar :: Char acctsepchar = ':' -accountNameComponents :: AccountName -> [String] -accountNameComponents = splitAtElement acctsepchar +acctsep :: Text +acctsep = T.pack [acctsepchar] -accountNameFromComponents :: [String] -> AccountName -accountNameFromComponents = concat . intersperse [acctsepchar] +-- accountNameComponents :: AccountName -> [String] +-- accountNameComponents = splitAtElement acctsepchar -accountLeafName :: AccountName -> String +accountNameComponents :: AccountName -> [Text] +accountNameComponents = T.splitOn acctsep + +accountNameFromComponents :: [Text] -> AccountName +accountNameFromComponents = T.intercalate acctsep + +accountLeafName :: AccountName -> Text accountLeafName = last . accountNameComponents -- | Truncate all account name components but the last to two characters. -accountSummarisedName :: AccountName -> String +accountSummarisedName :: AccountName -> Text accountSummarisedName a -- length cs > 1 = take 2 (head cs) ++ ":" ++ a' - | length cs > 1 = intercalate ":" (map (take 2) $ init cs) ++ ":" ++ a' + | length cs > 1 = (T.intercalate ":" (map (T.take 2) $ init cs)) <> ":" <> a' | otherwise = a' where cs = accountNameComponents a @@ -44,7 +51,7 @@ accountSummarisedName a accountNameLevel :: AccountName -> Int accountNameLevel "" = 0 -accountNameLevel a = length (filter (==acctsepchar) a) + 1 +accountNameLevel a = T.length (T.filter (==acctsepchar) a) + 1 accountNameDrop :: Int -> AccountName -> AccountName accountNameDrop n = accountNameFromComponents . drop n . accountNameComponents @@ -72,7 +79,7 @@ parentAccountNames a = parentAccountNames' $ parentAccountName a -- | Is the first account a parent or other ancestor of (and not the same as) the second ? isAccountNamePrefixOf :: AccountName -> AccountName -> Bool -isAccountNamePrefixOf = isPrefixOf . (++ [acctsepchar]) +isAccountNamePrefixOf = T.isPrefixOf . (<> acctsep) isSubAccountNameOf :: AccountName -> AccountName -> Bool s `isSubAccountNameOf` p = @@ -113,22 +120,22 @@ nullaccountnametree = Node "root" [] elideAccountName :: Int -> AccountName -> AccountName elideAccountName width s -- XXX special case for transactions register's multi-account pseudo-names - | " (split)" `isSuffixOf` s = + | " (split)" `T.isSuffixOf` s = let - names = splitOn ", " $ take (length s - 8) s + names = T.splitOn ", " $ T.take (T.length s - 8) s widthpername = (max 0 (width - 8 - 2 * (max 1 (length names) - 1))) `div` length names in - fitString Nothing (Just width) True False $ - (++" (split)") $ - intercalate ", " $ + fitText Nothing (Just width) True False $ + (<>" (split)") $ + T.intercalate ", " $ [accountNameFromComponents $ elideparts widthpername [] $ accountNameComponents s' | s' <- names] | otherwise = - fitString Nothing (Just width) True False $ accountNameFromComponents $ elideparts width [] $ accountNameComponents s + fitText Nothing (Just width) True False $ accountNameFromComponents $ elideparts width [] $ accountNameComponents s where - elideparts :: Int -> [String] -> [String] -> [String] + elideparts :: Int -> [Text] -> [Text] -> [Text] elideparts width done ss - | strWidth (accountNameFromComponents $ done++ss) <= width = done++ss - | length ss > 1 = elideparts width (done++[takeWidth 2 $ head ss]) (tail ss) + | textWidth (accountNameFromComponents $ done++ss) <= width = done++ss + | length ss > 1 = elideparts width (done++[textTakeWidth 2 $ head ss]) (tail ss) | otherwise = done++ss -- | Keep only the first n components of an account name, where n @@ -143,18 +150,18 @@ clipOrEllipsifyAccountName 0 = const "..." clipOrEllipsifyAccountName n = accountNameFromComponents . take n . accountNameComponents -- | Convert an account name to a regular expression matching it and its subaccounts. -accountNameToAccountRegex :: String -> String +accountNameToAccountRegex :: AccountName -> Regexp accountNameToAccountRegex "" = "" -accountNameToAccountRegex a = printf "^%s(:|$)" a +accountNameToAccountRegex a = printf "^%s(:|$)" (T.unpack a) -- | Convert an account name to a regular expression matching it but not its subaccounts. -accountNameToAccountOnlyRegex :: String -> String +accountNameToAccountOnlyRegex :: AccountName -> Regexp accountNameToAccountOnlyRegex "" = "" -accountNameToAccountOnlyRegex a = printf "^%s$" a +accountNameToAccountOnlyRegex a = printf "^%s$" $ T.unpack a -- XXX pack -- | Convert an exact account-matching regular expression to a plain account name. -accountRegexToAccountName :: String -> String -accountRegexToAccountName = regexReplace "^\\^(.*?)\\(:\\|\\$\\)$" "\\1" +accountRegexToAccountName :: Regexp -> AccountName +accountRegexToAccountName = T.pack . regexReplace "^\\^(.*?)\\(:\\|\\$\\)$" "\\1" -- XXX pack -- | Does this string look like an exact account-matching regular expression ? isAccountRegex :: String -> Bool diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index f6234d2d7..895106a12 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE StandaloneDeriving, OverloadedStrings #-} {-| A 'Journal' is a set of transactions, plus optional related data. This is @@ -63,6 +63,8 @@ import Data.List import Data.Maybe import Data.Monoid import Data.Ord +-- import Data.Text (Text) +import qualified Data.Text as T import Safe (headMay, headDef) import Data.Time.Calendar import Data.Tree @@ -520,7 +522,7 @@ checkBalanceAssertion (errs,startbal) ps "%s" ]) (showDate $ postingDate p) - (paccount p) + (T.unpack $ paccount p) -- XXX pack assertedcomm (showMixedAmount assertedbal) (showMixedAmount finalsinglebal) @@ -528,7 +530,7 @@ checkBalanceAssertion (errs,startbal) ps (showPostingLine p) (case ptransaction p of Nothing -> "" - Just t -> printf "in transaction at %s line %d:\n%s" f l (show t) + Just t -> printf "in transaction at %s line %d:\n%s" f l (show t) :: String where GenericSourcePos f l _ = tsourcepos t ) diff --git a/hledger-lib/Hledger/Data/Ledger.hs b/hledger-lib/Hledger/Data/Ledger.hs index 6eb106b3e..7b275232b 100644 --- a/hledger-lib/Hledger/Data/Ledger.hs +++ b/hledger-lib/Hledger/Data/Ledger.hs @@ -10,6 +10,8 @@ balances, and postings in each account. module Hledger.Data.Ledger where import qualified Data.Map as M +-- import Data.Text (Text) +import qualified Data.Text as T import Safe (headDef) import Test.HUnit import Text.Printf @@ -72,7 +74,7 @@ ledgerLeafAccounts = filter (null.asubs) . laccounts -- | Accounts in ledger whose name matches the pattern, in tree order. ledgerAccountsMatching :: [String] -> Ledger -> [Account] -ledgerAccountsMatching pats = filter (matchpats pats . aname) . laccounts +ledgerAccountsMatching pats = filter (matchpats pats . T.unpack . aname) . laccounts -- XXX pack -- | List a ledger's postings, in the order parsed. ledgerPostings :: Ledger -> [Posting] diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 7543cc854..21c9543d4 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -7,6 +7,8 @@ look up the date or description there. -} +{-# LANGUAGE OverloadedStrings #-} + module Hledger.Data.Posting ( -- * Posting nullposting, @@ -50,7 +52,10 @@ where import Data.List import Data.Maybe import Data.MemoUgly (memo) +import Data.Monoid import Data.Ord +-- import Data.Text (Text) +import qualified Data.Text as T import Data.Time.Calendar import Safe import Test.HUnit @@ -89,7 +94,7 @@ showPosting p@Posting{paccount=a,pamount=amt,ptype=t} = where ledger3ishlayout = False acctnamewidth = if ledger3ishlayout then 25 else 22 - showaccountname = fitString (Just acctnamewidth) Nothing False False . bracket . elideAccountName width + showaccountname = fitString (Just acctnamewidth) Nothing False False . bracket . T.unpack . elideAccountName width (bracket,width) = case t of BalancedVirtualPosting -> (\s -> "["++s++"]", acctnamewidth-2) VirtualPosting -> (\s -> "("++s++")", acctnamewidth-2) @@ -192,32 +197,32 @@ postingsDateSpan' wd ps = DateSpan (Just $ postingdate $ head ps') (Just $ addDa accountNamePostingType :: AccountName -> PostingType accountNamePostingType a - | null a = RegularPosting - | head a == '[' && last a == ']' = BalancedVirtualPosting - | head a == '(' && last a == ')' = VirtualPosting + | T.null a = RegularPosting + | T.head a == '[' && T.last a == ']' = BalancedVirtualPosting + | T.head a == '(' && T.last a == ')' = VirtualPosting | otherwise = RegularPosting accountNameWithoutPostingType :: AccountName -> AccountName accountNameWithoutPostingType a = case accountNamePostingType a of - BalancedVirtualPosting -> init $ tail a - VirtualPosting -> init $ tail a + BalancedVirtualPosting -> T.init $ T.tail a + VirtualPosting -> T.init $ T.tail a RegularPosting -> a accountNameWithPostingType :: PostingType -> AccountName -> AccountName -accountNameWithPostingType BalancedVirtualPosting a = "["++accountNameWithoutPostingType a++"]" -accountNameWithPostingType VirtualPosting a = "("++accountNameWithoutPostingType a++")" +accountNameWithPostingType BalancedVirtualPosting a = "["<>accountNameWithoutPostingType a<>"]" +accountNameWithPostingType VirtualPosting a = "("<>accountNameWithoutPostingType a<>")" accountNameWithPostingType RegularPosting a = accountNameWithoutPostingType a -- | Prefix one account name to another, preserving posting type -- indicators like concatAccountNames. joinAccountNames :: AccountName -> AccountName -> AccountName -joinAccountNames a b = concatAccountNames $ filter (not . null) [a,b] +joinAccountNames a b = concatAccountNames $ filter (not . T.null) [a,b] -- | Join account names into one. If any of them has () or [] posting type -- indicators, these (the first type encountered) will also be applied to -- the resulting account name. concatAccountNames :: [AccountName] -> AccountName -concatAccountNames as = accountNameWithPostingType t $ intercalate ":" $ map accountNameWithoutPostingType as +concatAccountNames as = accountNameWithPostingType t $ T.intercalate ":" $ map accountNameWithoutPostingType as where t = headDef RegularPosting $ filter (/= RegularPosting) $ map accountNamePostingType as -- | Rewrite an account name using all matching aliases from the given list, in sequence. @@ -241,9 +246,9 @@ accountNameApplyAliasesMemo aliases = memo (accountNameApplyAliases aliases) aliasReplace :: AccountAlias -> AccountName -> AccountName aliasReplace (BasicAlias old new) a - | old `isAccountNamePrefixOf` a || old == a = new ++ drop (length old) a + | old `isAccountNamePrefixOf` a || old == a = new <> T.drop (T.length old) a | otherwise = a -aliasReplace (RegexAlias re repl) a = regexReplaceCIMemo re repl a +aliasReplace (RegexAlias re repl) a = T.pack $ regexReplaceCIMemo re repl $ T.unpack a -- XXX tests_Hledger_Data_Posting = TestList [ diff --git a/hledger-lib/Hledger/Data/Timeclock.hs b/hledger-lib/Hledger/Data/Timeclock.hs index 2ab28929c..ae4e6818c 100644 --- a/hledger-lib/Hledger/Data/Timeclock.hs +++ b/hledger-lib/Hledger/Data/Timeclock.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-| A 'TimeclockEntry' is a clock-in, clock-out, or other directive in a timeclock @@ -7,9 +6,13 @@ converted to 'Transactions' and queried like a ledger. -} +{-# LANGUAGE CPP, OverloadedStrings #-} + module Hledger.Data.Timeclock where import Data.Maybe +-- import Data.Text (Text) +-- import qualified Data.Text as T import Data.Time.Calendar import Data.Time.Clock import Data.Time.Format diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index bb906ef30..8f3b2f050 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -7,11 +7,15 @@ tags. -} +{-# LANGUAGE OverloadedStrings #-} + module Hledger.Data.Transaction ( -- * Transaction nullsourcepos, nulltransaction, txnTieKnot, + txnUntieKnot, + journalUntieKnots, -- settxn, -- * operations showAccountName, @@ -38,6 +42,8 @@ module Hledger.Data.Transaction ( where import Data.List import Data.Maybe +-- import Data.Text (Text) +import qualified Data.Text as T import Data.Time.Calendar import Test.HUnit import Text.Printf @@ -188,7 +194,7 @@ postingAsLines elideamount onelineamounts ps p = showstatus p ++ fitString (Just acctwidth) Nothing False True (showAccountName Nothing (ptype p) (paccount p)) where showstatus p = if pstatus p == Cleared then "* " else "" - acctwidth = maximum $ map (strWidth . paccount) ps + acctwidth = maximum $ map (textWidth . paccount) ps -- currently prices are considered part of the amount string when right-aligning amounts amount @@ -239,12 +245,16 @@ indent = (" "++) showAccountName :: Maybe Int -> PostingType -> AccountName -> String showAccountName w = fmt where - fmt RegularPosting = take w' - fmt VirtualPosting = parenthesise . reverse . take (w'-2) . reverse - fmt BalancedVirtualPosting = bracket . reverse . take (w'-2) . reverse + fmt RegularPosting = take w' . T.unpack + fmt VirtualPosting = parenthesise . reverse . take (w'-2) . reverse . T.unpack + fmt BalancedVirtualPosting = bracket . reverse . take (w'-2) . reverse . T.unpack w' = fromMaybe 999999 w - parenthesise s = "("++s++")" - bracket s = "["++s++"]" + +parenthesise :: String -> String +parenthesise s = "("++s++")" + +bracket :: String -> String +bracket s = "["++s++"]" hasRealPostings :: Transaction -> Bool hasRealPostings = not . null . realPostings @@ -414,6 +424,16 @@ transactionDate2 t = fromMaybe (tdate t) $ tdate2 t txnTieKnot :: Transaction -> Transaction txnTieKnot t@Transaction{tpostings=ps} = t{tpostings=map (settxn t) ps} +-- | Ensure a transaction's postings do not refer back to it, so that eg +-- recursiveSize and GHCI's :sprint work right. +txnUntieKnot :: Transaction -> Transaction +txnUntieKnot t@Transaction{tpostings=ps} = t{tpostings=map (\p -> p{ptransaction=Nothing}) ps} + +-- | Untie all transaction-posting knots in this journal, so that eg +-- recursiveSize and GHCI's :sprint can work on it. +journalUntieKnots :: Transaction -> Transaction +journalUntieKnots t@Transaction{tpostings=ps} = t{tpostings=map (\p -> p{ptransaction=Nothing}) ps} + -- | Set a posting's parent transaction. settxn :: Transaction -> Posting -> Posting settxn t p = p{ptransaction=Just t} diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index e3f329f29..4e607a6f1 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -27,6 +27,8 @@ import Data.Data import Data.Decimal import Text.Blaze (ToMarkup(..)) import qualified Data.Map as M +import Data.Text (Text) +-- import qualified Data.Text as T import Data.Time.Calendar import Data.Time.LocalTime import System.Time (ClockTime(..)) @@ -50,7 +52,7 @@ data Interval = NoInterval instance NFData Interval -type AccountName = String +type AccountName = Text data AccountAlias = BasicAlias AccountName AccountName | RegexAlias Regexp Replacement @@ -206,7 +208,7 @@ data TimeclockEntry = TimeclockEntry { tlsourcepos :: GenericSourcePos, tlcode :: TimeclockCode, tldatetime :: LocalTime, - tlaccount :: String, + tlaccount :: AccountName, tldescription :: String } deriving (Eq,Ord,Typeable,Data,Generic) diff --git a/hledger-lib/Hledger/Query.hs b/hledger-lib/Hledger/Query.hs index 08e98e79a..c67ae2ba9 100644 --- a/hledger-lib/Hledger/Query.hs +++ b/hledger-lib/Hledger/Query.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} {-| A general query system for matching things (accounts, postings, @@ -6,6 +5,8 @@ transactions..) by various criteria, and a parser for query expressions. -} +{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-} + module Hledger.Query ( -- * Query and QueryOpt Query(..), @@ -45,6 +46,8 @@ import Data.Data import Data.Either import Data.List import Data.Maybe +-- import Data.Text (Text) +import qualified Data.Text as T import Data.Time.Calendar import Safe (readDef, headDef) import Test.HUnit @@ -236,8 +239,8 @@ defaultprefix = "acct" -- | Parse a single query term as either a query or a query option, -- or raise an error if it has invalid syntax. parseQueryTerm :: Day -> String -> Either Query QueryOpt -parseQueryTerm _ ('i':'n':'a':'c':'c':'t':'o':'n':'l':'y':':':s) = Right $ QueryOptInAcctOnly s -parseQueryTerm _ ('i':'n':'a':'c':'c':'t':':':s) = Right $ QueryOptInAcct s +parseQueryTerm _ ('i':'n':'a':'c':'c':'t':'o':'n':'l':'y':':':s) = Right $ QueryOptInAcctOnly $ T.pack s +parseQueryTerm _ ('i':'n':'a':'c':'c':'t':':':s) = Right $ QueryOptInAcct $ T.pack s parseQueryTerm d ('n':'o':'t':':':s) = case parseQueryTerm d s of Left m -> Left $ Not m Right _ -> Left Any -- not:somequeryoption will be ignored @@ -557,8 +560,8 @@ inAccount (QueryOptInAcct a:_) = Just (a,True) -- Just looks at the first query option. inAccountQuery :: [QueryOpt] -> Maybe Query inAccountQuery [] = Nothing -inAccountQuery (QueryOptInAcctOnly a:_) = Just $ Acct $ accountNameToAccountOnlyRegex a -inAccountQuery (QueryOptInAcct a:_) = Just $ Acct $ accountNameToAccountRegex a +inAccountQuery (QueryOptInAcctOnly a : _) = Just $ Acct $ accountNameToAccountOnlyRegex a +inAccountQuery (QueryOptInAcct a : _) = Just $ Acct $ accountNameToAccountRegex a -- -- | Convert a query to its inverse. -- negateQuery :: Query -> Query @@ -573,7 +576,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 = regexMatchesCI r a +matchesAccount (Acct r) a = regexMatchesCI r (T.unpack a) -- XXX pack matchesAccount (Depth d) a = accountNameLevel a <= d matchesAccount (Tag _ _) _ = False matchesAccount _ _ = True @@ -634,7 +637,7 @@ matchesPosting (Or qs) p = any (`matchesPosting` p) qs matchesPosting (And qs) p = all (`matchesPosting` p) qs matchesPosting (Code r) p = regexMatchesCI r $ maybe "" tcode $ ptransaction p matchesPosting (Desc r) p = regexMatchesCI r $ maybe "" tdescription $ ptransaction p -matchesPosting (Acct r) p = regexMatchesCI r $ paccount p +matchesPosting (Acct r) p = regexMatchesCI r $ T.unpack $ paccount p -- XXX pack matchesPosting (Date span) p = span `spanContainsDate` postingDate p matchesPosting (Date2 span) p = span `spanContainsDate` postingDate2 p matchesPosting (Status Uncleared) p = postingStatus p /= Cleared diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index b584ca7be..6a779cadd 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -27,6 +27,8 @@ import Data.Functor.Identity import Data.List.Compat import Data.List.Split (wordsBy) import Data.Maybe +-- import Data.Text (Text) +import qualified Data.Text as T import Data.Time.Calendar import Data.Time.LocalTime import Safe @@ -104,7 +106,7 @@ popParentAccount = do [] -> unexpected "End of apply account block with no beginning" (_:rest) -> setState j{jparseparentaccounts=rest} -getParentAccount :: Monad m => JournalParser m String +getParentAccount :: Monad m => JournalParser m AccountName getParentAccount = fmap (concatAccountNames . reverse . jparseparentaccounts) getState addAccountAlias :: Monad m => AccountAlias -> JournalParser m () @@ -271,12 +273,13 @@ modifiedaccountnamep = do -- (This parser will also consume one following space, if present.) accountnamep :: Monad m => StringParser u m AccountName accountnamep = do - a <- do + astr <- do c <- nonspace cs <- striptrailingspace <$> many (nonspace <|> singlespace) return $ c:cs + let a = T.pack astr when (accountNameFromComponents (accountNameComponents a) /= a) - (fail $ "account name seems ill-formed: "++a) + (fail $ "account name seems ill-formed: "++astr) return a where singlespace = try (do {spacenonewline; do {notFollowedBy spacenonewline; return ' '}}) diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index b0c4b631e..7f843d313 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -30,6 +30,8 @@ import Data.Char (toLower, isDigit, isSpace) import Data.List.Compat import Data.Maybe import Data.Ord +-- import Data.Text (Text) +import qualified Data.Text as T import Data.Time.Calendar (Day) #if MIN_VERSION_time(1,5,0) import Data.Time.Format (parseTimeM, defaultTimeLocale) @@ -638,8 +640,8 @@ transactionFromCsvRecord sourcepos rules record = t defaccount2 = case isNegativeMixedAmount amount2 of Just True -> "income:unknown" _ -> "expenses:unknown" - account1 = maybe "" render (mfieldtemplate "account1") `or` defaccount1 - account2 = maybe "" render (mfieldtemplate "account2") `or` defaccount2 + account1 = T.pack $ maybe "" render (mfieldtemplate "account1") `or` defaccount1 + account2 = T.pack $ maybe "" render (mfieldtemplate "account2") `or` defaccount2 -- build the transaction t = nulltransaction{ diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 4d6de1631..e8040e7da 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -82,6 +82,8 @@ import Control.Monad import Control.Monad.Except (ExceptT(..), liftIO, runExceptT, throwError) import qualified Data.Map.Strict as M import Data.Monoid +-- import Data.Text (Text) +import qualified Data.Text as T import Data.Time.Calendar import Data.Time.LocalTime import Safe @@ -319,7 +321,7 @@ basicaliasp = do char '=' many spacenonewline new <- rstrip <$> anyChar `manyTill` eolof -- don't require a final newline, good for cli options - return $ BasicAlias old new + return $ BasicAlias (T.pack old) (T.pack new) regexaliasp :: Monad m => StringParser u m AccountAlias regexaliasp = do @@ -550,7 +552,7 @@ postingp mtdate = do status <- statusp many spacenonewline account <- modifiedaccountnamep - let (ptype, account') = (accountNamePostingType account, unbracket account) + let (ptype, account') = (accountNamePostingType account, textUnbracket account) amount <- spaceandamountormissingp massertion <- partialbalanceassertionp _ <- fixedlotpricep diff --git a/hledger-lib/Hledger/Read/TimeclockReader.hs b/hledger-lib/Hledger/Read/TimeclockReader.hs index 2fc9e80a3..d1c041db3 100644 --- a/hledger-lib/Hledger/Read/TimeclockReader.hs +++ b/hledger-lib/Hledger/Read/TimeclockReader.hs @@ -40,6 +40,8 @@ i, o or O. The meanings of the codes are: -} +{-# LANGUAGE OverloadedStrings #-} + module Hledger.Read.TimeclockReader ( -- * Reader reader, @@ -55,6 +57,8 @@ import Control.Monad import Control.Monad.IO.Class (liftIO) import Control.Monad.Except (ExceptT) import Data.Maybe (fromMaybe) +-- import Data.Text (Text) +-- import qualified Data.Text as T import Test.HUnit import Text.Parsec hiding (parse) import System.FilePath diff --git a/hledger-lib/Hledger/Reports/BalanceReport.hs b/hledger-lib/Hledger/Reports/BalanceReport.hs index a63d52843..05cec8cd7 100644 --- a/hledger-lib/Hledger/Reports/BalanceReport.hs +++ b/hledger-lib/Hledger/Reports/BalanceReport.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RecordWildCards, DeriveDataTypeable, FlexibleInstances, ScopedTypeVariables #-} +{-# LANGUAGE RecordWildCards, DeriveDataTypeable, FlexibleInstances, ScopedTypeVariables, OverloadedStrings #-} {-| Balance report, used by the balance command. diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs index 9bec4cfa5..faa48316c 100644 --- a/hledger-lib/Hledger/Reports/PostingsReport.hs +++ b/hledger-lib/Hledger/Reports/PostingsReport.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RecordWildCards, DeriveDataTypeable, FlexibleInstances, TupleSections #-} +{-# LANGUAGE RecordWildCards, DeriveDataTypeable, FlexibleInstances, TupleSections, OverloadedStrings #-} {-| Postings report, used by the register command. diff --git a/hledger-lib/Hledger/Reports/TransactionsReports.hs b/hledger-lib/Hledger/Reports/TransactionsReports.hs index bdd72c092..d4336d7d6 100644 --- a/hledger-lib/Hledger/Reports/TransactionsReports.hs +++ b/hledger-lib/Hledger/Reports/TransactionsReports.hs @@ -30,6 +30,8 @@ where import Data.List import Data.Ord +-- import Data.Text (Text) +import qualified Data.Text as T -- import Test.HUnit import Hledger.Data @@ -204,7 +206,7 @@ accountTransactionsReportItems query thisacctquery bal signfn (torig:ts) = -- To reduce noise, if there are both real and virtual postings, show only the real ones. summarisePostingAccounts :: [Posting] -> String summarisePostingAccounts ps = - (intercalate ", " . map accountSummarisedName . nub . map paccount) displayps + (intercalate ", " . map (T.unpack . accountSummarisedName) . nub . map paccount) displayps -- XXX pack where realps = filter isReal ps displayps | null realps = ps diff --git a/hledger-lib/Hledger/Utils.hs b/hledger-lib/Hledger/Utils.hs index 2f7ca29fd..11814a339 100644 --- a/hledger-lib/Hledger/Utils.hs +++ b/hledger-lib/Hledger/Utils.hs @@ -22,6 +22,7 @@ module Hledger.Utils (---- provide these frequently used modules - or not, for c module Hledger.Utils.Parse, module Hledger.Utils.Regex, module Hledger.Utils.String, + module Hledger.Utils.Text, module Hledger.Utils.Test, module Hledger.Utils.Tree, -- Debug.Trace.trace, @@ -38,6 +39,8 @@ import Control.Monad (liftM) -- import Data.PPrint import Data.Time.Clock import Data.Time.LocalTime +-- import Data.Text (Text) +-- import qualified Data.Text as T import System.Directory (getHomeDirectory) import System.FilePath((), isRelative) import System.IO @@ -48,6 +51,7 @@ import Hledger.Utils.Debug import Hledger.Utils.Parse import Hledger.Utils.Regex import Hledger.Utils.String +import Hledger.Utils.Text import Hledger.Utils.Test import Hledger.Utils.Tree -- import Prelude hiding (readFile,writeFile,appendFile,getContents,putStr,putStrLn) @@ -91,6 +95,8 @@ splitAtElement x l = split es = let (first,rest) = break (x==) es in first : splitAtElement x rest +-- text + -- time getCurrentLocalTime :: IO LocalTime diff --git a/hledger-lib/Hledger/Utils/String.hs b/hledger-lib/Hledger/Utils/String.hs index dcfba2309..249563e5e 100644 --- a/hledger-lib/Hledger/Utils/String.hs +++ b/hledger-lib/Hledger/Utils/String.hs @@ -42,6 +42,7 @@ module Hledger.Utils.String ( cliptopleft, fitto, -- * wide-character-aware layout + charWidth, strWidth, takeWidth, fitString, diff --git a/hledger-lib/Hledger/Utils/Text.hs b/hledger-lib/Hledger/Utils/Text.hs new file mode 100644 index 000000000..9f6016790 --- /dev/null +++ b/hledger-lib/Hledger/Utils/Text.hs @@ -0,0 +1,404 @@ +-- | Text formatting helpers, ported from String as needed. +-- There may be better alternatives out there. + +{-# LANGUAGE OverloadedStrings #-} + +module Hledger.Utils.Text + -- ( + -- -- * misc + -- lowercase, + -- uppercase, + -- underline, + -- stripbrackets, + -- unbracket, + -- -- quoting + -- quoteIfSpaced, + -- quoteIfNeeded, + -- singleQuoteIfNeeded, + -- -- quotechars, + -- -- whitespacechars, + -- escapeDoubleQuotes, + -- escapeSingleQuotes, + -- escapeQuotes, + -- words', + -- unwords', + -- stripquotes, + -- isSingleQuoted, + -- isDoubleQuoted, + -- -- * single-line layout + -- strip, + -- lstrip, + -- rstrip, + -- chomp, + -- elideLeft, + -- elideRight, + -- formatString, + -- -- * multi-line layout + -- concatTopPadded, + -- concatBottomPadded, + -- concatOneLine, + -- vConcatLeftAligned, + -- vConcatRightAligned, + -- padtop, + -- padbottom, + -- padleft, + -- padright, + -- cliptopleft, + -- fitto, + -- -- * wide-character-aware layout + -- strWidth, + -- textTakeWidth, + -- fitString, + -- fitStringMulti, + -- padLeftWide, + -- padRightWide + -- ) +where + +-- import Data.Char +import Data.List +import Data.Monoid +import Data.Text (Text) +import qualified Data.Text as T +-- import Text.Parsec +-- import Text.Printf (printf) + +-- import Hledger.Utils.Parse +-- import Hledger.Utils.Regex +import Hledger.Utils.String (charWidth) + +-- lowercase, uppercase :: String -> String +-- lowercase = map toLower +-- uppercase = map toUpper + +-- -- | Remove leading and trailing whitespace. +-- strip :: String -> String +-- strip = lstrip . rstrip + +-- -- | Remove leading whitespace. +-- lstrip :: String -> String +-- lstrip = dropWhile (`elem` " \t") :: String -> String -- XXX isSpace ? + +-- -- | Remove trailing whitespace. +-- rstrip :: String -> String +-- rstrip = reverse . lstrip . reverse + +-- -- | Remove trailing newlines/carriage returns. +-- chomp :: String -> String +-- chomp = reverse . dropWhile (`elem` "\r\n") . reverse + +-- stripbrackets :: String -> String +-- stripbrackets = dropWhile (`elem` "([") . reverse . dropWhile (`elem` "])") . reverse :: String -> String + +-- elideLeft :: Int -> String -> String +-- elideLeft width s = +-- if length s > width then ".." ++ reverse (take (width - 2) $ reverse s) else s + +-- elideRight :: Int -> String -> String +-- elideRight width s = +-- if length s > width then take (width - 2) s ++ ".." else s + +-- -- | Clip and pad a string to a minimum & maximum width, and/or left/right justify it. +-- -- Works on multi-line strings too (but will rewrite non-unix line endings). +-- formatString :: Bool -> Maybe Int -> Maybe Int -> String -> String +-- formatString leftJustified minwidth maxwidth s = intercalate "\n" $ map (printf fmt) $ lines s +-- where +-- justify = if leftJustified then "-" else "" +-- minwidth' = maybe "" show minwidth +-- maxwidth' = maybe "" (("."++).show) maxwidth +-- fmt = "%" ++ justify ++ minwidth' ++ maxwidth' ++ "s" + +-- underline :: String -> String +-- underline s = s' ++ replicate (length s) '-' ++ "\n" +-- where s' +-- | last s == '\n' = s +-- | otherwise = s ++ "\n" + +-- -- | Wrap a string in double quotes, and \-prefix any embedded single +-- -- quotes, if it contains whitespace and is not already single- or +-- -- double-quoted. +-- quoteIfSpaced :: String -> String +-- quoteIfSpaced s | isSingleQuoted s || isDoubleQuoted s = s +-- | not $ any (`elem` s) whitespacechars = s +-- | otherwise = "'"++escapeSingleQuotes s++"'" + +-- -- | Double-quote this string if it contains whitespace, single quotes +-- -- or double-quotes, escaping the quotes as needed. +-- quoteIfNeeded :: String -> String +-- quoteIfNeeded s | any (`elem` s) (quotechars++whitespacechars) = "\"" ++ escapeDoubleQuotes s ++ "\"" +-- | otherwise = s + +-- -- | Single-quote this string if it contains whitespace or double-quotes. +-- -- No good for strings containing single quotes. +-- singleQuoteIfNeeded :: String -> String +-- singleQuoteIfNeeded s | any (`elem` s) whitespacechars = "'"++s++"'" +-- | otherwise = s + +-- quotechars, whitespacechars :: [Char] +-- quotechars = "'\"" +-- whitespacechars = " \t\n\r" + +-- escapeDoubleQuotes :: String -> String +-- escapeDoubleQuotes = regexReplace "\"" "\"" + +-- escapeSingleQuotes :: String -> String +-- escapeSingleQuotes = regexReplace "'" "\'" + +-- escapeQuotes :: String -> String +-- escapeQuotes = regexReplace "([\"'])" "\\1" + +-- -- | Quote-aware version of words - don't split on spaces which are inside quotes. +-- -- NB correctly handles "a'b" but not "''a''". Can raise an error if parsing fails. +-- words' :: String -> [String] +-- words' "" = [] +-- words' s = map stripquotes $ fromparse $ parsewith p s +-- where +-- p = do ss <- (singleQuotedPattern <|> doubleQuotedPattern <|> pattern) `sepBy` many1 spacenonewline +-- -- eof +-- return ss +-- pattern = many (noneOf whitespacechars) +-- singleQuotedPattern = between (char '\'') (char '\'') (many $ noneOf "'") +-- doubleQuotedPattern = between (char '"') (char '"') (many $ noneOf "\"") + +-- -- | Quote-aware version of unwords - single-quote strings which contain whitespace +-- unwords' :: [String] -> String +-- unwords' = unwords . map quoteIfNeeded + +-- -- | Strip one matching pair of single or double quotes on the ends of a string. +-- stripquotes :: String -> String +-- stripquotes s = if isSingleQuoted s || isDoubleQuoted s then init $ tail s else s + +-- isSingleQuoted s@(_:_:_) = head s == '\'' && last s == '\'' +-- isSingleQuoted _ = False + +-- isDoubleQuoted s@(_:_:_) = head s == '"' && last s == '"' +-- isDoubleQuoted _ = False + +textUnbracket :: Text -> Text +textUnbracket s + | (T.head s == '[' && T.last s == ']') || (T.head s == '(' && T.last s == ')') = T.init $ T.tail s + | otherwise = s + +-- | Join several multi-line strings as side-by-side rectangular strings of the same height, top-padded. +-- Treats wide characters as double width. +textConcatTopPadded :: [Text] -> Text +textConcatTopPadded ts = T.intercalate "\n" $ map T.concat $ transpose padded + where + lss = map T.lines ts :: [[Text]] + h = maximum $ map length lss + ypad ls = replicate (difforzero h (length ls)) "" ++ ls + xpad ls = map (textPadLeftWide w) ls + where w | null ls = 0 + | otherwise = maximum $ map textWidth ls + padded = map (xpad . ypad) lss :: [[Text]] + +-- -- | Join several multi-line strings as side-by-side rectangular strings of the same height, bottom-padded. +-- -- Treats wide characters as double width. +-- concatBottomPadded :: [String] -> String +-- concatBottomPadded strs = intercalate "\n" $ map concat $ transpose padded +-- where +-- lss = map lines strs +-- h = maximum $ map length lss +-- ypad ls = ls ++ replicate (difforzero h (length ls)) "" +-- xpad ls = map (padRightWide w) ls where w | null ls = 0 +-- | otherwise = maximum $ map strWidth ls +-- padded = map (xpad . ypad) lss + + +-- -- | Join multi-line strings horizontally, after compressing each of +-- -- them to a single line with a comma and space between each original line. +-- concatOneLine :: [String] -> String +-- concatOneLine strs = concat $ map ((intercalate ", ").lines) strs + +-- -- | Join strings vertically, left-aligned and right-padded. +-- vConcatLeftAligned :: [String] -> String +-- vConcatLeftAligned ss = intercalate "\n" $ map showfixedwidth ss +-- where +-- showfixedwidth = printf (printf "%%-%ds" width) +-- width = maximum $ map length ss + +-- -- | Join strings vertically, right-aligned and left-padded. +-- vConcatRightAligned :: [String] -> String +-- vConcatRightAligned ss = intercalate "\n" $ map showfixedwidth ss +-- where +-- showfixedwidth = printf (printf "%%%ds" width) +-- width = maximum $ map length ss + +-- -- | Convert a multi-line string to a rectangular string top-padded to the specified height. +-- padtop :: Int -> String -> String +-- padtop h s = intercalate "\n" xpadded +-- where +-- ls = lines s +-- sh = length ls +-- sw | null ls = 0 +-- | otherwise = maximum $ map length ls +-- ypadded = replicate (difforzero h sh) "" ++ ls +-- xpadded = map (padleft sw) ypadded + +-- -- | Convert a multi-line string to a rectangular string bottom-padded to the specified height. +-- padbottom :: Int -> String -> String +-- padbottom h s = intercalate "\n" xpadded +-- where +-- ls = lines s +-- sh = length ls +-- sw | null ls = 0 +-- | otherwise = maximum $ map length ls +-- ypadded = ls ++ replicate (difforzero h sh) "" +-- xpadded = map (padleft sw) ypadded + +difforzero :: (Num a, Ord a) => a -> a -> a +difforzero a b = maximum [(a - b), 0] + +-- -- | Convert a multi-line string to a rectangular string left-padded to the specified width. +-- -- Treats wide characters as double width. +-- padleft :: Int -> String -> String +-- padleft w "" = concat $ replicate w " " +-- padleft w s = intercalate "\n" $ map (printf (printf "%%%ds" w)) $ lines s + +-- -- | Convert a multi-line string to a rectangular string right-padded to the specified width. +-- -- Treats wide characters as double width. +-- padright :: Int -> String -> String +-- padright w "" = concat $ replicate w " " +-- padright w s = intercalate "\n" $ map (printf (printf "%%-%ds" w)) $ lines s + +-- -- | Clip a multi-line string to the specified width and height from the top left. +-- cliptopleft :: Int -> Int -> String -> String +-- cliptopleft w h = intercalate "\n" . take h . map (take w) . lines + +-- -- | Clip and pad a multi-line string to fill the specified width and height. +-- fitto :: Int -> Int -> String -> String +-- fitto w h s = intercalate "\n" $ take h $ rows ++ repeat blankline +-- where +-- rows = map (fit w) $ lines s +-- fit w = take w . (++ repeat ' ') +-- blankline = replicate w ' ' + +-- -- Functions below treat wide (eg CJK) characters as double-width. + +-- | General-purpose wide-char-aware single-line text layout function. +-- It can left- or right-pad a short string to a minimum width. +-- It can left- or right-clip a long string to a maximum width, optionally inserting an ellipsis (the third argument). +-- It clips and pads on the right when the fourth argument is true, otherwise on the left. +-- It treats wide characters as double width. +fitText :: Maybe Int -> Maybe Int -> Bool -> Bool -> Text -> Text +fitText mminwidth mmaxwidth ellipsify rightside s = (clip . pad) s + where + clip :: Text -> Text + clip s = + case mmaxwidth of + Just w + | textWidth s > w -> + case rightside of + True -> textTakeWidth (w - T.length ellipsis) s <> ellipsis + False -> ellipsis <> T.reverse (textTakeWidth (w - T.length ellipsis) $ T.reverse s) + | otherwise -> s + where + ellipsis = if ellipsify then ".." else "" + Nothing -> s + pad :: Text -> Text + pad s = + case mminwidth of + Just w + | sw < w -> + case rightside of + True -> s <> T.replicate (w - sw) " " + False -> T.replicate (w - sw) " " <> s + | otherwise -> s + Nothing -> s + where sw = textWidth s + +-- -- | A version of fitString that works on multi-line strings, +-- -- separate for now to avoid breakage. +-- -- This will rewrite any line endings to unix newlines. +-- fitStringMulti :: Maybe Int -> Maybe Int -> Bool -> Bool -> String -> String +-- fitStringMulti mminwidth mmaxwidth ellipsify rightside s = +-- (intercalate "\n" . map (fitString mminwidth mmaxwidth ellipsify rightside) . lines) s + +-- | Left-pad a text to the specified width. +-- Treats wide characters as double width. +-- Works on multi-line texts too (but will rewrite non-unix line endings). +textPadLeftWide :: Int -> Text -> Text +textPadLeftWide w "" = T.replicate w " " +textPadLeftWide w s = T.intercalate "\n" $ map (fitText (Just w) Nothing False False) $ T.lines s +-- XXX not yet replaceable by +-- padLeftWide w = fitStringMulti (Just w) Nothing False False + +-- | Right-pad a string to the specified width. +-- Treats wide characters as double width. +-- Works on multi-line strings too (but will rewrite non-unix line endings). +textPadRightWide :: Int -> Text -> Text +textPadRightWide w "" = T.replicate w " " +textPadRightWide w s = T.intercalate "\n" $ map (fitText (Just w) Nothing False True) $ T.lines s +-- XXX not yet replaceable by +-- padRightWide w = fitStringMulti (Just w) Nothing False True + +-- | Double-width-character-aware string truncation. Take as many +-- characters as possible from a string without exceeding the +-- specified width. Eg textTakeWidth 3 "りんご" = "り". +textTakeWidth :: Int -> Text -> Text +textTakeWidth _ "" = "" +textTakeWidth 0 _ = "" +textTakeWidth w t | not (T.null t), + let c = T.head t, + let cw = charWidth c, + cw <= w + = T.cons c $ textTakeWidth (w-cw) (T.tail t) + | otherwise = "" + +-- -- from Pandoc (copyright John MacFarlane, GPL) +-- -- see also http://unicode.org/reports/tr11/#Description + +-- | Calculate the designated render width of a string, taking into +-- account wide characters and line breaks (the longest line within a +-- multi-line string determines the width ). +textWidth :: Text -> Int +textWidth "" = 0 +textWidth s = maximum $ map (T.foldr (\a b -> charWidth a + b) 0) $ T.lines s + +-- -- | Get the designated render width of a character: 0 for a combining +-- -- character, 1 for a regular character, 2 for a wide character. +-- -- (Wide characters are rendered as exactly double width in apps and +-- -- fonts that support it.) (From Pandoc.) +-- charWidth :: Char -> Int +-- charWidth c = +-- case c of +-- _ | c < '\x0300' -> 1 +-- | c >= '\x0300' && c <= '\x036F' -> 0 -- combining +-- | c >= '\x0370' && c <= '\x10FC' -> 1 +-- | c >= '\x1100' && c <= '\x115F' -> 2 +-- | c >= '\x1160' && c <= '\x11A2' -> 1 +-- | c >= '\x11A3' && c <= '\x11A7' -> 2 +-- | c >= '\x11A8' && c <= '\x11F9' -> 1 +-- | c >= '\x11FA' && c <= '\x11FF' -> 2 +-- | c >= '\x1200' && c <= '\x2328' -> 1 +-- | c >= '\x2329' && c <= '\x232A' -> 2 +-- | c >= '\x232B' && c <= '\x2E31' -> 1 +-- | c >= '\x2E80' && c <= '\x303E' -> 2 +-- | c == '\x303F' -> 1 +-- | c >= '\x3041' && c <= '\x3247' -> 2 +-- | c >= '\x3248' && c <= '\x324F' -> 1 -- ambiguous +-- | c >= '\x3250' && c <= '\x4DBF' -> 2 +-- | c >= '\x4DC0' && c <= '\x4DFF' -> 1 +-- | c >= '\x4E00' && c <= '\xA4C6' -> 2 +-- | c >= '\xA4D0' && c <= '\xA95F' -> 1 +-- | c >= '\xA960' && c <= '\xA97C' -> 2 +-- | c >= '\xA980' && c <= '\xABF9' -> 1 +-- | c >= '\xAC00' && c <= '\xD7FB' -> 2 +-- | c >= '\xD800' && c <= '\xDFFF' -> 1 +-- | c >= '\xE000' && c <= '\xF8FF' -> 1 -- ambiguous +-- | c >= '\xF900' && c <= '\xFAFF' -> 2 +-- | c >= '\xFB00' && c <= '\xFDFD' -> 1 +-- | c >= '\xFE00' && c <= '\xFE0F' -> 1 -- ambiguous +-- | c >= '\xFE10' && c <= '\xFE19' -> 2 +-- | c >= '\xFE20' && c <= '\xFE26' -> 1 +-- | c >= '\xFE30' && c <= '\xFE6B' -> 2 +-- | c >= '\xFE70' && c <= '\xFEFF' -> 1 +-- | c >= '\xFF01' && c <= '\xFF60' -> 2 +-- | c >= '\xFF61' && c <= '\x16A38' -> 1 +-- | c >= '\x1B000' && c <= '\x1B001' -> 2 +-- | c >= '\x1D000' && c <= '\x1F1FF' -> 1 +-- | c >= '\x1F200' && c <= '\x1F251' -> 2 +-- | c >= '\x1F300' && c <= '\x1F773' -> 1 +-- | c >= '\x20000' && c <= '\x3FFFD' -> 2 +-- | otherwise -> 1 + diff --git a/hledger-lib/future-package.yaml b/hledger-lib/future-package.yaml index 17e12144c..4fe973e88 100644 --- a/hledger-lib/future-package.yaml +++ b/hledger-lib/future-package.yaml @@ -81,6 +81,7 @@ dependencies: - regex-tdfa - safe >= 0.2 - split >= 0.1 && < 0.3 + - text >= 1.2 && < 1.3 - transformers >= 0.2 && < 0.6 - uglymemo - utf8-string >= 0.3.5 && < 1.1 diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index 6f5f692e9..a99601121 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -82,6 +82,7 @@ library , regex-tdfa , safe >= 0.2 , split >= 0.1 && < 0.3 + , text >= 1.2 && < 1.3 , transformers >= 0.2 && < 0.6 , uglymemo , utf8-string >= 0.3.5 && < 1.1 @@ -132,6 +133,7 @@ library Hledger.Utils.Regex Hledger.Utils.String Hledger.Utils.Test + Hledger.Utils.Text Hledger.Utils.Tree Hledger.Utils.UTF8IOCompat default-language: Haskell2010 @@ -161,6 +163,7 @@ test-suite hunittests , regex-tdfa , safe >= 0.2 , split >= 0.1 && < 0.3 + , text >= 1.2 && < 1.3 , transformers >= 0.2 && < 0.6 , uglymemo , utf8-string >= 0.3.5 && < 1.1 diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index c72cf1c8f..35d2a0c13 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -17,6 +17,8 @@ import Control.Monad.IO.Class (liftIO) import Data.List import Data.Maybe import Data.Monoid +-- import Data.Text (Text) +import qualified Data.Text as T import Data.Time.Calendar (Day) import System.FilePath (takeFileName) import qualified Data.Vector as V @@ -57,7 +59,7 @@ initAccountsScreen d st@AppState{ l = list (Name "accounts") (V.fromList displayitems) 1 -- keep the selection near the last known selected account if possible - l' | null selacct = l + l' | T.null selacct = l | otherwise = maybe l (flip listMoveTo l) midx where midx = findIndex (\((a,_,_),_) -> a==selacctclipped) items @@ -147,7 +149,7 @@ drawAccountsScreen _st@AppState{aopts=uopts, ajournal=j, aScreen=AccountsScreen{ maxacctwidthseen = -- ltrace "maxacctwidthseen" $ V.maximum $ - V.map (\(indent,_,displayacct,_) -> indent*2 + strWidth displayacct) $ + V.map (\(indent,_,displayacct,_) -> indent*2 + textWidth displayacct) $ -- V.filter (\(indent,_,_,_) -> (indent-1) <= fromMaybe 99999 mdepth) $ displayitems maxbalwidthseen = @@ -175,14 +177,14 @@ drawAccountsScreen _st@AppState{aopts=uopts, ajournal=j, aScreen=AccountsScreen{ drawAccountsScreen _ = error "draw function called with wrong screen type, should not happen" -drawAccountsItem :: (Int,Int) -> Bool -> (Int, String, String, [String]) -> Widget +drawAccountsItem :: (Int,Int) -> Bool -> (Int, AccountName, AccountName, [String]) -> Widget drawAccountsItem (acctwidth, balwidth) selected (indent, _fullacct, displayacct, balamts) = Widget Greedy Fixed $ do -- c <- getContext -- let showitem = intercalate "\n" . balanceReportItemAsText defreportopts fmt render $ addamts balamts $ - str (fitString (Just acctwidth) (Just acctwidth) True True $ replicate (2*indent) ' ' ++ displayacct) <+> + str (T.unpack $ fitText (Just acctwidth) (Just acctwidth) True True $ T.replicate (2*indent) " " <> displayacct) <+> str " " <+> str (balspace balamts) where diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index 78068f420..aaa73de3e 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/hledger-ui/Hledger/UI/Main.hs @@ -17,6 +17,8 @@ import Control.Monad -- import Data.Monoid -- import Data.List import Data.Maybe +-- import Data.Text (Text) +import qualified Data.Text as T -- import Data.Time.Calendar import Safe import System.Exit @@ -100,7 +102,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do where acct = headDef (error' $ "--register "++apat++" did not match any account") - $ filter (regexMatches apat) $ journalAccountNames j + $ filter (regexMatches apat . T.unpack) $ journalAccountNames j -- Initialising the accounts screen is awkward, requiring -- another temporary AppState value.. ascr' = aScreen $ diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index c1b0aed73..f789e15e5 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -14,6 +14,8 @@ import Data.List import Data.List.Split (splitOn) import Data.Monoid -- import Data.Maybe +-- import Data.Text (Text) +import qualified Data.Text as T import Data.Time.Calendar (Day) import qualified Data.Vector as V import Graphics.Vty as Vty @@ -86,7 +88,7 @@ drawRegisterScreen :: AppState -> [Widget] drawRegisterScreen AppState{aopts=uopts -- @UIOpts{cliopts_=_copts@CliOpts{reportopts_=_ropts@ReportOpts{query_=querystr}} ,aScreen=RegisterScreen{rsState=(l,acct)}} = [ui] where - toplabel = withAttr ("border" <> "bold") (str acct) + toplabel = withAttr ("border" <> "bold") (str $ T.unpack acct) <+> cleared <+> str " transactions" -- <+> borderQueryStr querystr -- no, account transactions report shows all transactions in the acct ? diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index 48979c83c..b0249f4ee 100644 --- a/hledger-ui/Hledger/UI/TransactionScreen.hs +++ b/hledger-ui/Hledger/UI/TransactionScreen.hs @@ -14,6 +14,8 @@ import Control.Monad.IO.Class (liftIO) -- import Data.Ord import Data.Monoid -- import Data.Maybe +-- import Data.Text (Text) +import qualified Data.Text as T import Data.Time.Calendar (Day) -- import qualified Data.Vector as V import Graphics.Vty as Vty @@ -56,7 +58,7 @@ drawTransactionScreen AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{r <+> (str $ "#" ++ show (tindex t)) <+> str " (" <+> withAttr ("border" <> "bold") (str $ show i) - <+> str (" of "++show (length nts)++" in "++acct++")") + <+> str (" of "++show (length nts)++" in "++T.unpack acct++")") bottomlabel = borderKeysStr [ ("left", "back") ,("up/down", "prev/next") diff --git a/hledger-ui/Hledger/UI/UITypes.hs b/hledger-ui/Hledger/UI/UITypes.hs index f7868aec0..eabaabe20 100644 --- a/hledger-ui/Hledger/UI/UITypes.hs +++ b/hledger-ui/Hledger/UI/UITypes.hs @@ -28,7 +28,7 @@ data AppState = AppState { -- This type causes partial functions, so take care. data Screen = AccountsScreen { - asState :: (List (Int,String,String,[String]), AccountName) -- ^ list widget holding (indent level, full account name, full or short account name to display, rendered amounts); + asState :: (List (Int,AccountName,AccountName,[String]), AccountName) -- ^ list widget holding (indent level, full account name, full or short account name to display, rendered amounts); -- the full name of the currently selected account (or "") ,sInitFn :: Day -> AppState -> AppState -- ^ function to initialise the screen's state on entry ,sHandleFn :: AppState -> V.Event -> EventM (Next AppState) -- ^ brick event handler to use for this screen diff --git a/hledger-ui/future-package.yaml b/hledger-ui/future-package.yaml index a3e4d862e..a9e219b09 100644 --- a/hledger-ui/future-package.yaml +++ b/hledger-ui/future-package.yaml @@ -83,6 +83,7 @@ executables: - microlens >= 0.3.5.1 && < 0.5 - safe >= 0.2 - split >= 0.1 && < 0.3 + - text >= 1.2 && < 1.3 - transformers - vector - vty >= 5.2 && < 5.5 diff --git a/hledger-ui/hledger-ui.cabal b/hledger-ui/hledger-ui.cabal index 307169a30..903402d79 100644 --- a/hledger-ui/hledger-ui.cabal +++ b/hledger-ui/hledger-ui.cabal @@ -74,6 +74,7 @@ executable hledger-ui , microlens >= 0.3.5.1 && < 0.5 , safe >= 0.2 , split >= 0.1 && < 0.3 + , text >= 1.2 && < 1.3 , transformers , vector , vty >= 5.2 && < 5.6 diff --git a/hledger-web/Handler/Common.hs b/hledger-web/Handler/Common.hs index b73f50b5b..ab69ea01c 100644 --- a/hledger-web/Handler/Common.hs +++ b/hledger-web/Handler/Common.hs @@ -7,7 +7,8 @@ module Handler.Common where import Import import Data.List -import Data.Text(pack) +-- import Data.Text (Text) +import qualified Data.Text as T import Data.Time.Calendar import System.FilePath (takeFileName) #if BLAZE_HTML_0_4 @@ -221,17 +222,17 @@ balanceReportAsHtml _ vd@VD{..} (items',total) = Just m' -> if m' `matchesAccount` acct then "inacct" else "notinacct" Nothing -> "" :: String indent = preEscapedString $ concat $ replicate (2 * (1+aindent)) " " - acctquery = (RegisterR, [("q", pack $ accountQuery acct)]) - acctonlyquery = (RegisterR, [("q", pack $ accountOnlyQuery acct)]) + acctquery = (RegisterR, [("q", T.pack $ accountQuery acct)]) + acctonlyquery = (RegisterR, [("q", T.pack $ accountOnlyQuery acct)]) accountQuery :: AccountName -> String -accountQuery a = "inacct:" ++ quoteIfSpaced a -- (accountNameToAccountRegex a) +accountQuery a = "inacct:" ++ quoteIfSpaced (T.unpack a) -- (accountNameToAccountRegex a) accountOnlyQuery :: AccountName -> String -accountOnlyQuery a = "inacctonly:" ++ quoteIfSpaced a -- (accountNameToAccountRegex a) +accountOnlyQuery a = "inacctonly:" ++ quoteIfSpaced (T.unpack a) -- (accountNameToAccountRegex a) accountUrl :: AppRoute -> AccountName -> (AppRoute, [(Text, Text)]) -accountUrl r a = (r, [("q", pack $ accountQuery a)]) +accountUrl r a = (r, [("q", T.pack $ accountQuery a)]) -- stringIfLongerThan :: Int -> String -> String -- stringIfLongerThan n s = if length s > n then s else "" diff --git a/hledger-web/Handler/JournalR.hs b/hledger-web/Handler/JournalR.hs index 89203f5b7..69a5b94bd 100644 --- a/hledger-web/Handler/JournalR.hs +++ b/hledger-web/Handler/JournalR.hs @@ -3,7 +3,8 @@ module Handler.JournalR where -import Data.Text (pack) +-- import Data.Text (Text) +import qualified Data.Text as T import Import import Handler.AddForm @@ -27,7 +28,7 @@ getJournalR = do -- showlastcolumn = if injournal && not filtering then False else True title = case inacct of Nothing -> "General Journal"++s2 - Just (a,inclsubs) -> "Transactions in "++a++s1++s2 + Just (a,inclsubs) -> "Transactions in "++T.unpack a++s1++s2 where s1 = if inclsubs then "" else " (excluding subaccounts)" where s2 = if filtering then ", filtered" else "" @@ -82,12 +83,12 @@ journalTransactionsReportAsHtml _ vd (_,items) = [hamlet| |] where - acctlink a = (RegisterR, [("q", pack $ accountQuery a)]) + acctlink a = (RegisterR, [("q", T.pack $ accountQuery a)]) evenodd = if even n then "even" else "odd" :: String -- datetransition | newm = "newmonth" -- | newd = "newday" -- | otherwise = "" :: String (firstposting, date, desc) = (False, show $ tdate torig, tdescription torig) - -- acctquery = (here, [("q", pack $ accountQuery acct)]) + -- acctquery = (here, [("q", T.pack $ accountQuery acct)]) showamt = not split || not (isZeroMixedAmount amt) diff --git a/hledger-web/Handler/RegisterR.hs b/hledger-web/Handler/RegisterR.hs index d9bb8b95e..c81476ffb 100644 --- a/hledger-web/Handler/RegisterR.hs +++ b/hledger-web/Handler/RegisterR.hs @@ -7,6 +7,8 @@ import Import import Data.List import Data.Maybe +-- import Data.Text (Text) +import qualified Data.Text as T import Safe import Handler.AddForm @@ -28,7 +30,7 @@ getRegisterR = do let -- injournal = isNothing inacct filtering = m /= Any -- title = "Transactions in "++a++s1++s2 - title = a++s1++s2 + title = T.unpack a++s1++s2 where (a,inclsubs) = fromMaybe ("all accounts",True) $ inAccount qopts s1 = if inclsubs then "" else " (excluding subaccounts)" diff --git a/hledger-web/future-package.yaml b/hledger-web/future-package.yaml index b3949bc49..b2959dcd2 100644 --- a/hledger-web/future-package.yaml +++ b/hledger-web/future-package.yaml @@ -100,6 +100,7 @@ dependencies: - shakespeare >= 2.0 - template-haskell - text + - text >= 1.2 && < 1.3 - transformers - wai - wai-extra diff --git a/hledger-web/hledger-web.cabal b/hledger-web/hledger-web.cabal index 30b9e339d..ea0b5522d 100644 --- a/hledger-web/hledger-web.cabal +++ b/hledger-web/hledger-web.cabal @@ -105,7 +105,7 @@ library , safe >= 0.2 , shakespeare >= 2.0 , template-haskell - , text + , text >= 1.2 && < 1.3 , transformers , wai , wai-extra @@ -178,7 +178,7 @@ executable hledger-web , safe >= 0.2 , shakespeare >= 2.0 , template-haskell - , text + , text >= 1.2 && < 1.3 , transformers , wai , wai-extra @@ -231,7 +231,7 @@ test-suite test , safe >= 0.2 , shakespeare >= 2.0 , template-haskell - , text + , text >= 1.2 && < 1.3 , transformers , wai , wai-extra diff --git a/hledger/Hledger/Cli.hs b/hledger/Hledger/Cli.hs index 125fd0d80..9c3800a76 100644 --- a/hledger/Hledger/Cli.hs +++ b/hledger/Hledger/Cli.hs @@ -7,6 +7,8 @@ adds some more which are easier to define here. -} +{-# LANGUAGE OverloadedStrings #-} + module Hledger.Cli ( module Hledger.Cli.Accounts, module Hledger.Cli.Add, diff --git a/hledger/Hledger/Cli/Accounts.hs b/hledger/Hledger/Cli/Accounts.hs index cdef488b6..cfe85196e 100644 --- a/hledger/Hledger/Cli/Accounts.hs +++ b/hledger/Hledger/Cli/Accounts.hs @@ -10,6 +10,8 @@ The @accounts@ command lists account names: -} +{-# LANGUAGE OverloadedStrings #-} + module Hledger.Cli.Accounts ( accountsmode ,accounts @@ -17,6 +19,9 @@ module Hledger.Cli.Accounts ( ) where import Data.List +import Data.Monoid +-- import Data.Text (Text) +import qualified Data.Text as T import System.Console.CmdArgs.Explicit as C import Test.HUnit @@ -52,11 +57,11 @@ accounts CliOpts{reportopts_=ropts} j = do nodepthq = dbg1 "nodepthq" $ filterQuery (not . queryIsDepth) q depth = dbg1 "depth" $ queryDepth $ filterQuery queryIsDepth q ps = dbg1 "ps" $ journalPostings $ filterJournalPostings nodepthq j - as = dbg1 "as" $ nub $ filter (not . null) $ map (clipAccountName depth) $ sort $ map paccount ps + as = dbg1 "as" $ nub $ filter (not . T.null) $ map (clipAccountName depth) $ sort $ map paccount ps as' | tree_ ropts = expandAccountNames as | otherwise = as - render a | tree_ ropts = replicate (2 * (accountNameLevel a - 1)) ' ' ++ accountLeafName a + render a | tree_ ropts = T.replicate (2 * (accountNameLevel a - 1)) " " <> accountLeafName a | otherwise = maybeAccountNameDrop ropts a - mapM_ (putStrLn . render) as' + mapM_ (putStrLn . T.unpack . render) as' tests_Hledger_Cli_Accounts = TestList [] diff --git a/hledger/Hledger/Cli/Add.hs b/hledger/Hledger/Cli/Add.hs index 63f6f05a2..335337c2c 100644 --- a/hledger/Hledger/Cli/Add.hs +++ b/hledger/Hledger/Cli/Add.hs @@ -3,7 +3,7 @@ A history-aware add command to help with data entry. |-} {-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-unused-do-bind #-} -{-# LANGUAGE CPP, ScopedTypeVariables, DeriveDataTypeable, RecordWildCards, TypeOperators, FlexibleContexts #-} +{-# LANGUAGE CPP, ScopedTypeVariables, DeriveDataTypeable, RecordWildCards, TypeOperators, FlexibleContexts, OverloadedStrings #-} module Hledger.Cli.Add where @@ -17,6 +17,8 @@ import Data.Char (toUpper, toLower) import Data.List.Compat import qualified Data.Set as S import Data.Maybe +-- import Data.Text (Text) +import qualified Data.Text as T import Data.Time.Calendar (Day) import Data.Typeable (Typeable) import Safe (headDef, headMay) @@ -216,10 +218,10 @@ postingWizard es@EntryState{..} = do else do let es1 = es{esArgs=drop 1 esArgs} (amt,comment) <- amountAndCommentWizard es1 - return $ Just nullposting{paccount=stripbrackets acct + return $ Just nullposting{paccount=T.pack $ stripbrackets acct ,pamount=Mixed [amt] ,pcomment=comment - ,ptype=accountNamePostingType acct + ,ptype=accountNamePostingType $ T.pack acct } postingsBalanced :: [Posting] -> Bool @@ -245,7 +247,7 @@ accountWizard EntryState{..} = do parseAccountOrDotOrNull _ _ "." = dbg1 $ Just "." -- . always signals end of txn parseAccountOrDotOrNull "" True "" = dbg1 $ Just "" -- when there's no default and txn is balanced, "" also signals end of txn parseAccountOrDotOrNull def@(_:_) _ "" = dbg1 $ Just def -- when there's a default, "" means use that - parseAccountOrDotOrNull _ _ s = dbg1 $ either (const Nothing) validateAccount $ runParser (accountnamep <* eof) esJournal "" s -- otherwise, try to parse the input as an accountname + parseAccountOrDotOrNull _ _ s = dbg1 $ either (const Nothing) ((T.unpack <$>) . validateAccount) $ runParser (accountnamep <* eof) esJournal "" s -- otherwise, try to parse the input as an accountname dbg1 = id -- strace validateAccount s | no_new_accounts_ esOpts && not (s `elem` journalAccountNames esJournal) = Nothing | otherwise = Just s @@ -315,7 +317,7 @@ descriptionCompleter :: Journal -> String -> CompletionFunc IO descriptionCompleter j = completer (journalDescriptions j) accountCompleter :: Journal -> String -> CompletionFunc IO -accountCompleter j = completer (journalAccountNamesUsed j) +accountCompleter j = completer (map T.unpack $ journalAccountNamesUsed j) amountCompleter :: String -> CompletionFunc IO amountCompleter = completer [] @@ -407,7 +409,7 @@ compareDescriptions :: String -> String -> Double compareDescriptions s t = compareStrings s' t' where s' = simplify s t' = simplify t - simplify = filter (not . (`elem` "0123456789")) + simplify = filter (not . (`elem` ("0123456789" :: String))) -- | Return a similarity measure, from 0 to 1, for two strings. This -- was based on Simon White's string similarity algorithm diff --git a/hledger/Hledger/Cli/Balance.hs b/hledger/Hledger/Cli/Balance.hs index 28fb930f9..68bdcbe1d 100644 --- a/hledger/Hledger/Cli/Balance.hs +++ b/hledger/Hledger/Cli/Balance.hs @@ -232,6 +232,8 @@ Currently, empty cells show 0. -} +{-# LANGUAGE OverloadedStrings #-} + module Hledger.Cli.Balance ( balancemode ,balance @@ -245,6 +247,9 @@ module Hledger.Cli.Balance ( import Data.List (intercalate) import Data.Maybe (fromMaybe, isJust) +import Data.Monoid +-- import Data.Text (Text) +import qualified Data.Text as T import System.Console.CmdArgs.Explicit as C import Text.CSV import Test.HUnit @@ -327,7 +332,7 @@ balance opts@CliOpts{reportopts_=ropts} j = do balanceReportAsCsv :: ReportOpts -> BalanceReport -> CSV balanceReportAsCsv opts (items, total) = ["account","balance"] : - [[a, showMixedAmountOneLineWithoutPrice b] | ((a, _, _), b) <- items] + [[T.unpack a, showMixedAmountOneLineWithoutPrice b] | ((a, _, _), b) <- items] ++ if no_total_ opts then [] @@ -348,8 +353,8 @@ balanceReportAsText opts ((items, total)) = unlines $ concat lines ++ t Right fmt -> let -- abuse renderBalanceReportItem to render the total with similar format - acctcolwidth = maximum' [length fullname | ((fullname, _, _), _) <- items] - totallines = map rstrip $ renderBalanceReportItem fmt (replicate (acctcolwidth+1) ' ', 0, total) + acctcolwidth = maximum' [T.length fullname | ((fullname, _, _), _) <- items] + totallines = map rstrip $ renderBalanceReportItem fmt (T.replicate (acctcolwidth+1) " ", 0, total) -- with a custom format, extend the line to the full report width; -- otherwise show the usual 20-char line for compatibility overlinewidth | isJust (format_ opts) = maximum' $ map length $ concat lines @@ -417,7 +422,7 @@ renderComponent (acctname, depth, total) (FormatField ljust min max field) = cas where d = case min of Just m -> depth * m Nothing -> depth - AccountField -> formatString ljust min max acctname + AccountField -> formatString ljust min max (T.unpack acctname) TotalField -> fitStringMulti min max True False $ showMixedAmountWithoutPrice total _ -> "" @@ -428,7 +433,7 @@ renderComponent (acctname, depth, total) (FormatField ljust min max field) = cas renderComponent1 :: (AccountName, Int, MixedAmount) -> StringFormatComponent -> String renderComponent1 _ (FormatLiteral s) = s renderComponent1 (acctname, depth, total) (FormatField ljust min max field) = case field of - AccountField -> formatString ljust min max ((intercalate ", " . lines) (indented acctname)) + AccountField -> formatString ljust min max ((intercalate ", " . lines) (indented (T.unpack acctname))) where -- better to indent the account name here rather than use a DepthField component -- so that it complies with width spec. Uses a fixed indent step size. @@ -445,7 +450,7 @@ multiBalanceReportAsCsv opts (MultiBalanceReport (colspans, items, (coltotals,to ++ (if row_total_ opts then ["total"] else []) ++ (if average_ opts then ["average"] else []) ) : - [a : a' : show i : + [T.unpack a : T.unpack a' : show i : map showMixedAmountOneLineWithoutPrice (amts ++ (if row_total_ opts then [rowtot] else []) @@ -470,7 +475,7 @@ periodBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (coltotal render id (" "++) showMixedAmountOneLineWithoutPrice $ addtotalrow $ Table - (T.Group NoLine $ map (Header . padRightWide acctswidth) accts) + (T.Group NoLine $ map (Header . padRightWide acctswidth . T.unpack) accts) (T.Group NoLine $ map Header colheadings) (map rowvals items') where @@ -482,9 +487,9 @@ periodBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (coltotal | otherwise = items -- dbg1 "2" $ filter (any (not . isZeroMixedAmount) . snd) $ dbg1 "1" items accts = map renderacct items' renderacct ((a,a',i),_,_,_) - | tree_ opts = replicate ((i-1)*2) ' ' ++ a' + | tree_ opts = T.replicate ((i-1)*2) " " <> a' | otherwise = maybeAccountNameDrop opts a - acctswidth = maximum' $ map strWidth accts + acctswidth = maximum' $ map textWidth accts rowvals (_,as,rowtot,rowavg) = as ++ (if row_total_ opts then [rowtot] else []) ++ (if average_ opts then [rowavg] else []) @@ -514,8 +519,8 @@ cumulativeBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (colt ++ (if average_ opts then ["Average"] else []) accts = map renderacct items renderacct ((a,a',i),_,_,_) - | tree_ opts = replicate ((i-1)*2) ' ' ++ a' - | otherwise = maybeAccountNameDrop opts a + | tree_ opts = replicate ((i-1)*2) ' ' ++ T.unpack a' + | otherwise = T.unpack $ maybeAccountNameDrop opts a acctswidth = maximum' $ map strWidth accts rowvals (_,as,rowtot,rowavg) = as ++ (if row_total_ opts then [rowtot] else []) @@ -546,8 +551,8 @@ historicalBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (colt ++ (if average_ opts then ["Average"] else []) accts = map renderacct items renderacct ((a,a',i),_,_,_) - | tree_ opts = replicate ((i-1)*2) ' ' ++ a' - | otherwise = maybeAccountNameDrop opts a + | tree_ opts = replicate ((i-1)*2) ' ' ++ T.unpack a' + | otherwise = T.unpack $ maybeAccountNameDrop opts a acctswidth = maximum' $ map strWidth accts rowvals (_,as,rowtot,rowavg) = as ++ (if row_total_ opts then [rowtot] else []) diff --git a/hledger/Hledger/Cli/Register.hs b/hledger/Hledger/Cli/Register.hs index da5bdb5cc..18fb396bd 100644 --- a/hledger/Hledger/Cli/Register.hs +++ b/hledger/Hledger/Cli/Register.hs @@ -16,6 +16,8 @@ module Hledger.Cli.Register ( import Data.List import Data.Maybe +-- import Data.Text (Text) +import qualified Data.Text as T import System.Console.CmdArgs.Explicit import Text.CSV import Test.HUnit @@ -70,7 +72,7 @@ postingsReportItemAsCsvRecord (_, _, _, p, b) = [date,desc,acct,amt,bal] where date = showDate $ postingDate p -- XXX csv should show date2 with --date2 desc = maybe "" tdescription $ ptransaction p - acct = bracket $ paccount p + acct = bracket $ T.unpack $ paccount p where bracket = case ptype p of BalancedVirtualPosting -> (\s -> "["++s++"]") @@ -173,7 +175,7 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda -- gather content desc = fromMaybe "" mdesc - acct = parenthesise $ elideAccountName awidth $ paccount p + acct = parenthesise $ T.unpack $ elideAccountName awidth $ paccount p where (parenthesise, awidth) = case ptype p of diff --git a/hledger/Hledger/Cli/Tests.hs b/hledger/Hledger/Cli/Tests.hs index 15c8764e2..cd6522085 100644 --- a/hledger/Hledger/Cli/Tests.hs +++ b/hledger/Hledger/Cli/Tests.hs @@ -13,6 +13,8 @@ module Hledger.Cli.Tests ( where import Control.Monad +-- import Data.Text (Text) +import qualified Data.Text as T import System.Exit import Test.HUnit @@ -61,7 +63,7 @@ runTests = liftM (fst . flip (,) 0) . runTestTT . flatTests -- -- firstproblem = find (\counts -> ) -- | All or pattern-matched tests, as a flat list to show simple names. -flatTests opts = TestList $ filter (matchesAccount (queryFromOpts nulldate $ reportopts_ opts) . testName) $ flattenTests tests_Hledger_Cli +flatTests opts = TestList $ filter (matchesAccount (queryFromOpts nulldate $ reportopts_ opts) . T.pack . testName) $ flattenTests tests_Hledger_Cli -- -- | All or pattern-matched tests, in the original suites to show hierarchical names. -- hierarchicalTests opts = filterTests (matchesAccount (queryFromOpts nulldate $ reportopts_ opts) . testName) tests_Hledger_Cli diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index 8aec3cf4f..e396dc2b4 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -25,6 +25,8 @@ where import Control.Exception as C import Data.List import Data.Maybe +-- import Data.Text (Text) +import qualified Data.Text as T import Data.Time (Day) import Safe (readMay) import System.Console.CmdArgs @@ -85,7 +87,7 @@ pivot tag j = j{jtxns = map pivotTrans . jtxns $ j} where pivotTrans t = t{tpostings = map pivotPosting . tpostings $ t} pivotPosting p - | Just (_ , value) <- tagTuple = p{paccount = joinAccountNames tag value} + | Just (_ , value) <- tagTuple = p{paccount = joinAccountNames (T.pack tag) (T.pack value)} | _ <- tagTuple = p where tagTuple = find ((tag ==) . fst) . ptags $ p