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: <<ghc: 39471064 bytes, 77 GCs, 198421/275048 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.001 elapsed), 0.015 MUT (0.020 elapsed), 0.010 GC (0.014 elapsed) :ghc>>
text:   <<ghc: 39268024 bytes, 77 GCs, 197018/270840 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.002 elapsed), 0.016 MUT (0.022 elapsed), 0.009 GC (0.011 elapsed) :ghc>>

hledger -f data/1000x100x10.journal stats
string: <<ghc: 318555920 bytes, 617 GCs, 2178997/7134472 avg/max bytes residency (7 samples), 16M in use, 0.000 INIT (0.001 elapsed), 0.129 MUT (0.136 elapsed), 0.067 GC (0.077 elapsed) :ghc>>
text:   <<ghc: 314248496 bytes, 612 GCs, 2074045/6617960 avg/max bytes residency (7 samples), 16M in use, 0.000 INIT (0.003 elapsed), 0.137 MUT (0.145 elapsed), 0.067 GC (0.079 elapsed) :ghc>>

hledger -f data/10000x100x10.journal stats
string: <<ghc: 3114763608 bytes, 6026 GCs, 18858950/75552024 avg/max bytes residency (11 samples), 201M in use, 0.000 INIT (0.000 elapsed), 1.331 MUT (1.372 elapsed), 0.699 GC (0.812 elapsed) :ghc>>
text:   <<ghc: 3071468920 bytes, 5968 GCs, 14120344/62951360 avg/max bytes residency (9 samples), 124M in use, 0.000 INIT (0.003 elapsed), 1.272 MUT (1.349 elapsed), 0.513 GC (0.578 elapsed) :ghc>>

hledger -f data/100000x100x10.journal stats
string: <<ghc: 31186579432 bytes, 60278 GCs, 135332581/740228992 avg/max bytes residency (13 samples), 1697M in use, 0.000 INIT (0.008 elapsed), 14.677 MUT (15.508 elapsed), 7.081 GC (8.074 elapsed) :ghc>>
text:   <<ghc: 30753427672 bytes, 59763 GCs, 117595958/666457240 avg/max bytes residency (14 samples), 1588M in use, 0.000 INIT (0.008 elapsed), 13.713 MUT (13.966 elapsed), 6.220 GC (7.108 elapsed) :ghc>>

hledger-lib/Hledger/Data/Account.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE RecordWildCards, StandaloneDeriving #-}
+{-# LANGUAGE RecordWildCards, StandaloneDeriving, OverloadedStrings #-}
 {-|
 
 

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
 
 
-
+acctsepchar :: Char
--- change to use a different separator for nested accounts
 acctsepchar = ':'
 
-accountNameComponents :: AccountName -> [String]
+acctsep :: Text
-accountNameComponents = splitAtElement acctsepchar
+acctsep = T.pack [acctsepchar]
 
-accountNameFromComponents :: [String] -> AccountName
+-- accountNameComponents :: AccountName -> [String]
-accountNameFromComponents = concat . intersperse [acctsepchar]
+-- 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 $
+     fitText Nothing (Just width) True False $
-     (++" (split)") $
+     (<>" (split)") $
-     intercalate ", " $
+     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
+          | textWidth (accountNameFromComponents $ done++ss) <= width = done++ss
-          | length ss > 1 = elideparts width (done++[takeWidth 2 $ head ss]) (tail 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 :: Regexp -> AccountName
-accountRegexToAccountName = regexReplace "^\\^(.*?)\\(:\\|\\$\\)$" "\\1"
+accountRegexToAccountName = T.pack . regexReplace "^\\^(.*?)\\(:\\|\\$\\)$" "\\1" -- XXX pack
 
 -- | Does this string look like an exact account-matching regular expression ?
 isAccountRegex  :: String -> Bool

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
                  )
 

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]

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
+    | T.null a = RegularPosting
-    | head a == '[' && last a == ']' = BalancedVirtualPosting
+    | T.head a == '[' && T.last a == ']' = BalancedVirtualPosting
-    | head a == '(' && last a == ')' = VirtualPosting
+    | T.head a == '(' && T.last a == ')' = VirtualPosting
     | otherwise = RegularPosting
 
 accountNameWithoutPostingType :: AccountName -> AccountName
 accountNameWithoutPostingType a = case accountNamePostingType a of
-                                    BalancedVirtualPosting -> init $ tail a
+                                    BalancedVirtualPosting -> T.init $ T.tail a
-                                    VirtualPosting -> init $ tail a
+                                    VirtualPosting -> T.init $ T.tail a
                                     RegularPosting -> a
 
 accountNameWithPostingType :: PostingType -> AccountName -> AccountName
-accountNameWithPostingType BalancedVirtualPosting a = "["++accountNameWithoutPostingType a++"]"
+accountNameWithPostingType BalancedVirtualPosting a = "["<>accountNameWithoutPostingType a<>"]"
-accountNameWithPostingType VirtualPosting 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 [

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

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 RegularPosting = take w' . T.unpack
-      fmt VirtualPosting = parenthesise . reverse . take (w'-2) . reverse
+      fmt VirtualPosting = parenthesise . reverse . take (w'-2) . reverse . T.unpack
-      fmt BalancedVirtualPosting = bracket . reverse . take (w'-2) . reverse
+      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}

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)
 

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':'o':'n':'l':'y':':':s) = Right $ QueryOptInAcctOnly $ T.pack s
-parseQueryTerm _ ('i':'n':'a':'c':'c':'t':':':s) = Right $ QueryOptInAcct 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 (QueryOptInAcctOnly a : _) = Just $ Acct $ accountNameToAccountOnlyRegex a
-inAccountQuery (QueryOptInAcct a:_) = Just $ Acct $ accountNameToAccountRegex 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

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 ' '}})

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
+    account1    = T.pack $ maybe "" render (mfieldtemplate "account1") `or` defaccount1
-    account2    = maybe "" render (mfieldtemplate "account2") `or` defaccount2
+    account2    = T.pack $ maybe "" render (mfieldtemplate "account2") `or` defaccount2
 
     -- build the transaction
     t = nulltransaction{

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

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

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.

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.

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

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

hledger-lib/Hledger/Utils/String.hs

@@ -42,6 +42,7 @@ module Hledger.Utils.String (
  cliptopleft,
  fitto,
  -- * wide-character-aware layout
+ charWidth,
  strWidth,
  takeWidth,
  fitString,

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
+

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

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

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

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 $

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 ?

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

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

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

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

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)])
+       acctquery = (RegisterR, [("q", T.pack $ accountQuery acct)])
-       acctonlyquery = (RegisterR, [("q", pack $ accountOnlyQuery 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 ""

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

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

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

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

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,

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 []

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

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]
+                  acctcolwidth = maximum' [T.length fullname | ((fullname, _, _), _) <- items]
-                  totallines = map rstrip $ renderBalanceReportItem fmt (replicate (acctcolwidth+1) ' ', 0, total)
+                  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'
+      | tree_ opts = replicate ((i-1)*2) ' ' ++ T.unpack a'
-      | otherwise  = maybeAccountNameDrop opts 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'
+      | tree_ opts = replicate ((i-1)*2) ' ' ++ T.unpack a'
-      | otherwise  = maybeAccountNameDrop opts a
+      | otherwise  = T.unpack $ maybeAccountNameDrop opts a
     acctswidth = maximum' $ map strWidth accts
     rowvals (_,as,rowtot,rowavg) = as
                              ++ (if row_total_ opts then [rowtot] else [])

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

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

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