From 770dcee742ee27abe282d631af7a0fb89ba5a3fe Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Tue, 24 May 2016 17:09:20 -0700 Subject: [PATCH] lib: textification: comments and tags No change. hledger -f data/100x100x10.journal stats <> <> hledger -f data/1000x1000x10.journal stats <> <> hledger -f data/10000x1000x10.journal stats <> <> hledger -f data/100000x1000x10.journal stats <> <> --- hledger-lib/Hledger/Data/Journal.hs | 2 +- hledger-lib/Hledger/Data/Posting.hs | 6 ++--- hledger-lib/Hledger/Data/Transaction.hs | 8 +++--- hledger-lib/Hledger/Data/Types.hs | 12 ++++----- hledger-lib/Hledger/Query.hs | 4 +-- hledger-lib/Hledger/Read/Common.hs | 32 +++++++++++------------ hledger-lib/Hledger/Read/CsvReader.hs | 4 +-- hledger-lib/Hledger/Read/JournalReader.hs | 6 ++--- hledger-lib/Hledger/Read/TimedotReader.hs | 2 ++ hledger-lib/Hledger/Utils/Text.hs | 2 +- hledger-web/Handler/AddForm.hs | 4 +-- hledger/Hledger/Cli/Add.hs | 6 ++--- hledger/Hledger/Cli/Print.hs | 4 +-- hledger/Hledger/Cli/Utils.hs | 8 +++--- 14 files changed, 51 insertions(+), 49 deletions(-) diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index ed36259dc..98382a5fa 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -174,7 +174,7 @@ nulljournal = Journal { ,jmodifiertxns = [] ,jperiodictxns = [] ,jtxns = [] - ,jfinalcommentlines = [] + ,jfinalcommentlines = "" ,jfiles = [] ,jlastreadtime = TOD 0 0 } diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 21c9543d4..86eef78ef 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -54,7 +54,7 @@ import Data.Maybe import Data.MemoUgly (memo) import Data.Monoid import Data.Ord --- import Data.Text (Text) +import Data.Text (Text) import qualified Data.Text as T import Data.Time.Calendar import Safe @@ -102,8 +102,8 @@ showPosting p@Posting{paccount=a,pamount=amt,ptype=t} = showamount = padLeftWide 12 . showMixedAmount -showComment :: String -> String -showComment s = if null s then "" else " ;" ++ s +showComment :: Text -> String +showComment t = if T.null t then "" else " ;" ++ T.unpack t isReal :: Posting -> Bool isReal p = ptype p == RegularPosting diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 8f3b2f050..f28a2638e 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -42,7 +42,7 @@ module Hledger.Data.Transaction ( where import Data.List import Data.Maybe --- import Data.Text (Text) +import Data.Text (Text) import qualified Data.Text as T import Data.Time.Calendar import Test.HUnit @@ -159,9 +159,9 @@ showTransactionHelper elide onelineamounts t = c:cs -> (c,cs) -- Render a transaction or posting's comment as indented, semicolon-prefixed comment lines. -renderCommentLines :: String -> [String] -renderCommentLines s = case lines s of ("":ls) -> "":map commentprefix ls - ls -> map commentprefix ls +renderCommentLines :: Text -> [String] +renderCommentLines t = case lines $ T.unpack t of ("":ls) -> "":map commentprefix ls + ls -> map commentprefix ls where commentprefix = indent . ("; "++) diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 1a19e5cf9..075656fcf 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -128,8 +128,8 @@ data PostingType = RegularPosting | VirtualPosting | BalancedVirtualPosting instance NFData PostingType -type TagName = String -type TagValue = String +type TagName = Text +type TagValue = Text type Tag = (TagName, TagValue) -- ^ A tag name and (possibly empty) value. data ClearedStatus = Uncleared | Pending | Cleared @@ -148,7 +148,7 @@ data Posting = Posting { pstatus :: ClearedStatus, paccount :: AccountName, pamount :: MixedAmount, - pcomment :: String, -- ^ this posting's comment lines, as a single non-indented multi-line string + pcomment :: Text, -- ^ this posting's comment lines, as a single non-indented multi-line string ptype :: PostingType, ptags :: [Tag], -- ^ tag names and values, extracted from the comment pbalanceassertion :: Maybe MixedAmount, -- ^ optional: the expected balance in the account after this posting @@ -178,10 +178,10 @@ data Transaction = Transaction { tstatus :: ClearedStatus, tcode :: String, tdescription :: String, - tcomment :: String, -- ^ this transaction's comment lines, as a single non-indented multi-line string + tcomment :: Text, -- ^ this transaction's comment lines, as a single non-indented multi-line string ttags :: [Tag], -- ^ tag names and values, extracted from the comment tpostings :: [Posting], -- ^ this transaction's postings - tpreceding_comment_lines :: String -- ^ any comment lines immediately preceding this transaction + tpreceding_comment_lines :: Text -- ^ any comment lines immediately preceding this transaction } deriving (Eq,Typeable,Data,Generic) instance NFData Transaction @@ -250,7 +250,7 @@ data Journal = Journal { ,jmodifiertxns :: [ModifierTransaction] ,jperiodictxns :: [PeriodicTransaction] ,jtxns :: [Transaction] - ,jfinalcommentlines :: String -- ^ any final trailing comments in the (main) journal file + ,jfinalcommentlines :: Text -- ^ any final trailing comments in the (main) journal file ,jfiles :: [(FilePath, Text)] -- ^ the file path and raw text of the main and -- any included journal files. The main file is first, -- followed by any included files in the order encountered. diff --git a/hledger-lib/Hledger/Query.hs b/hledger-lib/Hledger/Query.hs index 367c653bd..791b7c79e 100644 --- a/hledger-lib/Hledger/Query.hs +++ b/hledger-lib/Hledger/Query.hs @@ -726,8 +726,8 @@ tests_matchesTransaction = [ matchedTags :: Regexp -> Maybe Regexp -> [Tag] -> [Tag] matchedTags namepat valuepat tags = filter (match namepat valuepat) tags where - match npat Nothing (n,_) = regexMatchesCI npat n - match npat (Just vpat) (n,v) = regexMatchesCI npat n && regexMatchesCI vpat v + match npat Nothing (n,_) = regexMatchesCI npat (T.unpack n) -- XXX + match npat (Just vpat) (n,v) = regexMatchesCI npat (T.unpack n) && regexMatchesCI vpat (T.unpack v) -- tests diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 73177e4cc..ec5915bec 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -27,7 +27,7 @@ import Data.Functor.Identity import Data.List.Compat import Data.List.Split (wordsBy) import Data.Maybe --- import Data.Monoid +import Data.Monoid import Data.Text (Text) import qualified Data.Text as T import Data.Time.Calendar @@ -560,12 +560,12 @@ emptyorcommentlinep = do return () -- | Parse a possibly multi-line comment following a semicolon. -followingcommentp :: Monad m => JournalParser m String +followingcommentp :: Monad m => JournalParser m Text followingcommentp = -- ptrace "followingcommentp" do samelinecomment <- many spacenonewline >> (try semicoloncommentp <|> (newline >> return "")) newlinecomments <- many (try (many1 spacenonewline >> semicoloncommentp)) - return $ unlines $ samelinecomment:newlinecomments + return $ T.unlines $ samelinecomment:newlinecomments -- | Parse a possibly multi-line comment following a semicolon, and -- any tags and/or posting dates within it. Posting dates can be @@ -586,7 +586,7 @@ followingcommentp = -- >>> rejp (followingcommentandtagsp (Just $ fromGregorian 2000 1 2)) "; date:3/4=5/6" -- Right ("date:3/4=5/6\n",[("date","3/4=5/6")],Just 2000-03-04,Nothing) -- -followingcommentandtagsp :: Maybe Day -> ErroringJournalParser (String, [Tag], Maybe Day, Maybe Day) +followingcommentandtagsp :: Maybe Day -> ErroringJournalParser (Text, [Tag], Maybe Day, Maybe Day) followingcommentandtagsp mdefdate = do -- pdbg 0 "followingcommentandtagsp" @@ -600,7 +600,7 @@ followingcommentandtagsp mdefdate = do l1 <- try semicoloncommentp' <|> (newline >> return "") ls <- many $ try ((++) <$> many1 spacenonewline <*> semicoloncommentp') return $ unlines $ (sp1 ++ l1) : ls - let comment = unlines $ map (lstrip . dropWhile (==';') . strip) $ lines commentandwhitespace + let comment = T.pack $ unlines $ map (lstrip . dropWhile (==';') . strip) $ lines commentandwhitespace -- pdbg 0 $ "commentws:"++show commentandwhitespace -- pdbg 0 $ "comment:"++show comment @@ -621,23 +621,23 @@ followingcommentandtagsp mdefdate = do return (comment, tags, mdate, mdate2) -commentp :: Monad m => JournalParser m String +commentp :: Monad m => JournalParser m Text commentp = commentStartingWithp commentchars commentchars :: [Char] commentchars = "#;*" -semicoloncommentp :: Monad m => JournalParser m String +semicoloncommentp :: Monad m => JournalParser m Text semicoloncommentp = commentStartingWithp ";" -commentStartingWithp :: Monad m => String -> JournalParser m String +commentStartingWithp :: Monad m => [Char] -> JournalParser m Text commentStartingWithp cs = do -- ptrace "commentStartingWith" oneOf cs many spacenonewline l <- anyChar `manyTill` eolof optional newline - return l + return $ T.pack l --- ** tags @@ -694,16 +694,16 @@ tagp = do -- | -- >>> rsp tagnamep "a:" -- Right "a" -tagnamep :: Monad m => TextParser u m String +tagnamep :: Monad m => TextParser u m Text tagnamep = -- do -- pdbg 0 "tagnamep" - many1 (noneOf ": \t\n") <* char ':' + T.pack <$> many1 (noneOf ": \t\n") <* char ':' -tagvaluep :: Monad m => TextParser u m String +tagvaluep :: Monad m => TextParser u m Text tagvaluep = do -- ptrace "tagvalue" v <- anyChar `manyTill` (void (try (char ',')) <|> eolof) - return $ strip $ reverse $ dropWhile (==',') $ reverse $ strip v + return $ T.pack $ strip $ reverse $ dropWhile (==',') $ reverse $ strip v --- ** posting dates @@ -741,7 +741,7 @@ datetagp :: Maybe Day -> ErroringJournalParser (TagName,Day) datetagp mdefdate = do -- pdbg 0 "datetagp" string "date" - n <- fromMaybe "" <$> optionMaybe (string "2") + n <- T.pack . fromMaybe "" <$> optionMaybe (string "2") char ':' startpos <- getPosition v <- tagvaluep @@ -755,10 +755,10 @@ datetagp mdefdate = do (do setPosition startpos datep) -- <* eof) - (T.pack v) + v case ep of Left e -> throwError $ show e - Right d -> return ("date"++n, d) + Right d -> return ("date"<>n, d) --- ** bracketed dates diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index 5f4acfc8e..b844d2e42 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -651,8 +651,8 @@ transactionFromCsvRecord sourcepos rules record = t tstatus = status, tcode = code, tdescription = description, - tcomment = comment, - tpreceding_comment_lines = precomment, + tcomment = T.pack comment, + tpreceding_comment_lines = T.pack precomment, tpostings = [posting {paccount=account2, pamount=amount2, ptransaction=Just t} ,posting {paccount=account1, pamount=amount1, ptransaction=Just t} diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index b3bcba35c..cc443beca 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -29,7 +29,7 @@ import cycles. --- * module -{-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns, NoMonoLocalBinds, ScopedTypeVariables, FlexibleContexts, TupleSections #-} +{-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns, NoMonoLocalBinds, ScopedTypeVariables, FlexibleContexts, TupleSections, OverloadedStrings #-} module Hledger.Read.JournalReader ( @@ -140,7 +140,7 @@ journalp = do -- | A side-effecting parser; parses any kind of journal item -- and updates the parse state accordingly. addJournalItemP :: ErroringJournalParser () -addJournalItemP = do +addJournalItemP = -- all journal line types can be distinguished by the first -- character, can use choice without backtracking choice [ @@ -433,7 +433,7 @@ transactionp = do code <- codep "transaction code" description <- strip <$> descriptionp comment <- try followingcommentp <|> (newline >> return "") - let tags = commentTags $ T.pack comment + let tags = commentTags comment postings <- postingsp (Just date) n <- incrementTransactionCount return $ txnTieKnot $ Transaction n sourcepos date edate status code description comment tags postings "" diff --git a/hledger-lib/Hledger/Read/TimedotReader.hs b/hledger-lib/Hledger/Read/TimedotReader.hs index d1a89ba0b..a151a9e9a 100644 --- a/hledger-lib/Hledger/Read/TimedotReader.hs +++ b/hledger-lib/Hledger/Read/TimedotReader.hs @@ -21,6 +21,8 @@ inc.client1 .... .... .. -} +{-# LANGUAGE OverloadedStrings #-} + module Hledger.Read.TimedotReader ( -- * Reader reader, diff --git a/hledger-lib/Hledger/Utils/Text.hs b/hledger-lib/Hledger/Utils/Text.hs index 5db8363c3..3e7896134 100644 --- a/hledger-lib/Hledger/Utils/Text.hs +++ b/hledger-lib/Hledger/Utils/Text.hs @@ -77,7 +77,7 @@ textstrip = textlstrip . textrstrip -- | Remove leading whitespace. textlstrip :: Text -> Text -textlstrip = T.dropWhile (`elem` " \t") :: Text -> Text -- XXX isSpace ? +textlstrip = T.dropWhile (`elem` (" \t" :: String)) :: Text -> Text -- XXX isSpace ? -- | Remove trailing whitespace. textrstrip = T.reverse . textlstrip . T.reverse diff --git a/hledger-web/Handler/AddForm.hs b/hledger-web/Handler/AddForm.hs index 499441e36..58a4adcd9 100644 --- a/hledger-web/Handler/AddForm.hs +++ b/hledger-web/Handler/AddForm.hs @@ -95,8 +95,8 @@ postAddForm = do | map fst acctparams == [1..num] && map fst amtparams `elem` [[1..num], [1..num-1]] = [] | otherwise = ["the posting parameters are malformed"] - eaccts = map (runParser (accountnamep <* eof) () "" . T.pack . strip . T.unpack . snd) acctparams - eamts = map (runParser (amountp <* eof) mempty "" . T.pack . strip . T.unpack . snd) amtparams + eaccts = map (runParser (accountnamep <* eof) () "" . textstrip . snd) acctparams + eamts = map (runParser (amountp <* eof) mempty "" . textstrip . snd) amtparams (accts, acctErrs) = (rights eaccts, map show $ lefts eaccts) (amts', amtErrs) = (rights eamts, map show $ lefts eamts) amts | length amts' == num = amts' diff --git a/hledger/Hledger/Cli/Add.hs b/hledger/Hledger/Cli/Add.hs index d27dafa51..a966cd1f6 100644 --- a/hledger/Hledger/Cli/Add.hs +++ b/hledger/Hledger/Cli/Add.hs @@ -201,7 +201,7 @@ descriptionAndCommentWizard EntryState{..} = do maybeRestartTransaction $ line $ green $ printf "Description%s: " (showDefault def) let (desc,comment) = (strip a, strip $ dropWhile (==';') b) where (a,b) = break (==';') s - return (desc,comment) + return (desc, T.pack comment) postingsWizard es@EntryState{..} = do mp <- postingWizard es @@ -278,11 +278,11 @@ amountAndCommentWizard EntryState{..} = do where parseAmountAndComment = either (const Nothing) Just . runParser (amountandcommentp <* eof) nodefcommodityj "" . T.pack nodefcommodityj = esJournal{jparsedefaultcommodity=Nothing} - amountandcommentp :: Monad m => JournalParser m (Amount, String) + amountandcommentp :: Monad m => JournalParser m (Amount, Text) amountandcommentp = do a <- amountp many spacenonewline - c <- fromMaybe "" `fmap` optionMaybe (char ';' >> many anyChar) + c <- T.pack <$> fromMaybe "" `fmap` optionMaybe (char ';' >> many anyChar) -- eof return (a,c) balancingamt = negate $ sum $ map pamount realps where realps = filter isReal esPostings diff --git a/hledger/Hledger/Cli/Print.hs b/hledger/Hledger/Cli/Print.hs index 45eb829d3..dc821d7dc 100644 --- a/hledger/Hledger/Cli/Print.hs +++ b/hledger/Hledger/Cli/Print.hs @@ -121,7 +121,7 @@ transactionToCSV n t = date2 = maybe "" showDate (tdate2 t) status = show $ tstatus t code = tcode t - comment = chomp $ strip $ tcomment t + comment = chomp $ strip $ T.unpack $ tcomment t postingToCSV :: Posting -> CSV postingToCSV p = @@ -137,7 +137,7 @@ postingToCSV p = Mixed amounts = pamount p status = show $ pstatus p account = showAccountName Nothing (ptype p) (paccount p) - comment = chomp $ strip $ pcomment p + comment = chomp $ strip $ T.unpack $ pcomment p -- --match diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index e396dc2b4..19977a424 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -25,7 +25,7 @@ where import Control.Exception as C import Data.List import Data.Maybe --- import Data.Text (Text) +import Data.Text (Text) import qualified Data.Text as T import Data.Time (Day) import Safe (readMay) @@ -78,16 +78,16 @@ withJournalDo opts cmd = do pivotByOpts :: CliOpts -> Journal -> Journal pivotByOpts opts = case maybestringopt "pivot" . rawopts_ $ opts of - Just tag -> pivot tag + Just tag -> pivot $ T.pack tag Nothing -> id -- | Apply the pivot transformation by given tag on a journal. -pivot :: String -> Journal -> Journal +pivot :: Text -> Journal -> Journal 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 (T.pack tag) (T.pack value)} + | Just (_ , value) <- tagTuple = p{paccount = joinAccountNames tag value} | _ <- tagTuple = p where tagTuple = find ((tag ==) . fst) . ptags $ p