From 102b76c17f439d804a7b48fcc2b64232bd69c7eb Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 23 May 2016 19:13:43 -0700 Subject: [PATCH] lib: textification: commodity symbols hledger -f data/100x100x10.journal stats <> <> hledger -f data/1000x100x10.journal stats <> <> hledger -f data/10000x100x10.journal stats <> <> hledger -f data/100000x100x10.journal stats <> <> --- hledger-lib/Hledger/Data/Amount.hs | 11 +++++++---- hledger-lib/Hledger/Data/Commodity.hs | 10 ++++++++-- hledger-lib/Hledger/Data/Types.hs | 2 +- hledger-lib/Hledger/Query.hs | 4 ++-- hledger-lib/Hledger/Read/Common.hs | 12 ++++++------ hledger-web/Handler/RegisterR.hs | 2 +- hledger/Hledger/Cli/Print.hs | 6 +++++- hledger/Hledger/Cli/Stats.hs | 9 ++++++--- 8 files changed, 36 insertions(+), 20 deletions(-) diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index a75909dcc..73a812edd 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP, StandaloneDeriving, RecordWildCards #-} {-| A simple 'Amount' is some quantity of money, shares, or anything else. It has a (possibly null) 'CommoditySymbol' and a numeric quantity: @@ -41,6 +40,8 @@ exchange rates. -} +{-# LANGUAGE CPP, StandaloneDeriving, RecordWildCards, OverloadedStrings #-} + module Hledger.Data.Amount ( -- * Amount amount, @@ -106,6 +107,8 @@ import Data.Function (on) import Data.List import Data.Map (findWithDefault) import Data.Maybe +-- import Data.Text (Text) +import qualified Data.Text as T import Test.HUnit import Text.Printf import qualified Data.Map as M @@ -258,14 +261,14 @@ showAmountHelper :: Bool -> Amount -> String showAmountHelper _ Amount{acommodity="AUTO"} = "" showAmountHelper showzerocommodity a@(Amount{acommodity=c, aprice=p, astyle=AmountStyle{..}}) = case ascommodityside of - L -> printf "%s%s%s%s" c' space quantity' price - R -> printf "%s%s%s%s" quantity' space c' price + L -> printf "%s%s%s%s" (T.unpack c') space quantity' price + R -> printf "%s%s%s%s" quantity' space (T.unpack c') price where quantity = showamountquantity a displayingzero = null $ filter (`elem` digits) $ quantity (quantity',c') | displayingzero && not showzerocommodity = ("0","") | otherwise = (quantity, quoteCommoditySymbolIfNeeded c) - space = if (not (null c') && ascommodityspaced) then " " else "" :: String + space = if (not (T.null c') && ascommodityspaced) then " " else "" :: String price = showPrice p -- | Like showAmount, but show a zero amount's commodity if it has one. diff --git a/hledger-lib/Hledger/Data/Commodity.hs b/hledger-lib/Hledger/Data/Commodity.hs index 814b94bf9..1674979b7 100644 --- a/hledger-lib/Hledger/Data/Commodity.hs +++ b/hledger-lib/Hledger/Data/Commodity.hs @@ -6,10 +6,16 @@ display 'Amount's of the commodity - is the symbol on the left or right, are thousands separated by comma, significant decimal places and so on. -} + +{-# LANGUAGE OverloadedStrings #-} + module Hledger.Data.Commodity where import Data.List import Data.Maybe (fromMaybe) +import Data.Monoid +-- import Data.Text (Text) +import qualified Data.Text as T import Test.HUnit -- import qualified Data.Map as M @@ -18,9 +24,9 @@ import Hledger.Utils -- characters that may not be used in a non-quoted commodity symbol -nonsimplecommoditychars = "0123456789-+.@;\n \"{}=" :: String +nonsimplecommoditychars = "0123456789-+.@;\n \"{}=" :: [Char] -quoteCommoditySymbolIfNeeded s | any (`elem` nonsimplecommoditychars) s = "\"" ++ s ++ "\"" +quoteCommoditySymbolIfNeeded s | any (`elem` nonsimplecommoditychars) (T.unpack s) = "\"" <> s <> "\"" | otherwise = s commodity = "" diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 4e607a6f1..6f6a66111 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -101,7 +101,7 @@ data DigitGroupStyle = DigitGroups Char [Int] instance NFData DigitGroupStyle -type CommoditySymbol = String +type CommoditySymbol = Text data Commodity = Commodity { csymbol :: CommoditySymbol, diff --git a/hledger-lib/Hledger/Query.hs b/hledger-lib/Hledger/Query.hs index c67ae2ba9..367c653bd 100644 --- a/hledger-lib/Hledger/Query.hs +++ b/hledger-lib/Hledger/Query.hs @@ -608,7 +608,7 @@ matchesAmount (Or qs) a = any (`matchesAmount` a) qs matchesAmount (And qs) a = all (`matchesAmount` a) qs -- matchesAmount (Amt ord n) a = compareAmount ord n a -matchesAmount (Sym r) a = regexMatchesCI ("^" ++ r ++ "$") $ acommodity a +matchesAmount (Sym r) a = regexMatchesCI ("^" ++ r ++ "$") $ T.unpack $ acommodity a -- matchesAmount _ _ = True @@ -650,7 +650,7 @@ matchesPosting q@(Amt _ _) Posting{pamount=amt} = q `matchesMixedAmount` amt -- matchesPosting (Empty False) Posting{pamount=a} = True -- matchesPosting (Empty True) Posting{pamount=a} = isZeroMixedAmount a matchesPosting (Empty _) _ = True -matchesPosting (Sym r) Posting{pamount=Mixed as} = any (regexMatchesCI $ "^" ++ r ++ "$") $ map acommodity as +matchesPosting (Sym r) Posting{pamount=Mixed as} = any (regexMatchesCI $ "^" ++ r ++ "$") $ map (T.unpack . acommodity) as matchesPosting (Tag n v) p = not $ null $ matchedTags n v $ postingAllTags p -- matchesPosting _ _ = False diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 6a779cadd..0817b19f4 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -13,7 +13,7 @@ Some of these might belong in Hledger.Read.JournalReader or Hledger.Read. -} --- * module -{-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns, NoMonoLocalBinds, ScopedTypeVariables, FlexibleContexts, TupleSections #-} +{-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns, NoMonoLocalBinds, ScopedTypeVariables, FlexibleContexts, TupleSections, OverloadedStrings #-} module Hledger.Read.Common where @@ -386,18 +386,18 @@ nosymbolamountp = do return $ Amount c q p s "no-symbol amount" -commoditysymbolp :: Monad m => JournalParser m String +commoditysymbolp :: Monad m => JournalParser m CommoditySymbol commoditysymbolp = (quotedcommoditysymbolp <|> simplecommoditysymbolp) "commodity symbol" -quotedcommoditysymbolp :: Monad m => JournalParser m String +quotedcommoditysymbolp :: Monad m => JournalParser m CommoditySymbol quotedcommoditysymbolp = do char '"' s <- many1 $ noneOf ";\n\"" char '"' - return s + return $ T.pack s -simplecommoditysymbolp :: Monad m => JournalParser m String -simplecommoditysymbolp = many1 (noneOf nonsimplecommoditychars) +simplecommoditysymbolp :: Monad m => JournalParser m CommoditySymbol +simplecommoditysymbolp = T.pack <$> many1 (noneOf nonsimplecommoditychars) priceamountp :: Monad m => JournalParser m Price priceamountp = diff --git a/hledger-web/Handler/RegisterR.hs b/hledger-web/Handler/RegisterR.hs index c81476ffb..187a0c7b3 100644 --- a/hledger-web/Handler/RegisterR.hs +++ b/hledger-web/Handler/RegisterR.hs @@ -126,7 +126,7 @@ registerChartHtml percommoditytxnreports = ], /* [] */ ], - label: '#{shownull c}', + label: '#{shownull $ T.unpack c}', color: #{colorForCommodity c}, lines: { show: true, diff --git a/hledger/Hledger/Cli/Print.hs b/hledger/Hledger/Cli/Print.hs index 1088f7199..45eb829d3 100644 --- a/hledger/Hledger/Cli/Print.hs +++ b/hledger/Hledger/Cli/Print.hs @@ -4,6 +4,8 @@ A ledger-compatible @print@ command. -} +{-# LANGUAGE OverloadedStrings #-} + module Hledger.Cli.Print ( printmode ,print' @@ -13,6 +15,8 @@ module Hledger.Cli.Print ( where import Data.List +-- import Data.Text (Text) +import qualified Data.Text as T import System.Console.CmdArgs.Explicit import Test.HUnit import Text.CSV @@ -124,7 +128,7 @@ postingToCSV p = map (\(a@(Amount {aquantity=q,acommodity=c})) -> let a_ = a{acommodity=""} in let amount = showAmount a_ in - let commodity = c in + let commodity = T.unpack c in let credit = if q < 0 then showAmount $ negate a_ else "" in let debit = if q > 0 then showAmount a_ else "" in account:amount:commodity:credit:debit:status:comment:[]) diff --git a/hledger/Hledger/Cli/Stats.hs b/hledger/Hledger/Cli/Stats.hs index 83cb43daa..9171e57ab 100644 --- a/hledger/Hledger/Cli/Stats.hs +++ b/hledger/Hledger/Cli/Stats.hs @@ -4,6 +4,8 @@ Print some statistics for the journal. -} +{-# LANGUAGE OverloadedStrings #-} + module Hledger.Cli.Stats ( statsmode ,stats @@ -14,7 +16,8 @@ import Data.List import Data.Maybe import Data.Ord import Data.HashSet (size, fromList) -import Data.Text (pack) +-- import Data.Text (Text) +import qualified Data.Text as T import Data.Time.Calendar import System.Console.CmdArgs.Explicit import Text.Printf @@ -67,9 +70,9 @@ showLedgerStats l today span = ,("Transactions", printf "%d (%0.1f per day)" tnum txnrate) ,("Transactions last 30 days", printf "%d (%0.1f per day)" tnum30 txnrate30) ,("Transactions last 7 days", printf "%d (%0.1f per day)" tnum7 txnrate7) - ,("Payees/descriptions", show $ size $ fromList $ map (pack . tdescription) ts) + ,("Payees/descriptions", show $ size $ fromList $ map (tdescription) ts) ,("Accounts", printf "%d (depth %d)" acctnum acctdepth) - ,("Commodities", printf "%s (%s)" (show $ length cs) (intercalate ", " cs)) + ,("Commodities", printf "%s (%s)" (show $ length cs) (T.intercalate ", " cs)) -- Transactions this month : %(monthtxns)s (last month in the same period: %(lastmonthtxns)s) -- Uncleared transactions : %(uncleared)s -- Days since reconciliation : %(reconcileelapsed)s