slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lib: textification: comments and tags

Browse Source 
No change.

hledger -f data/100x100x10.journal stats
<<ghc: 42859576 bytes, 84 GCs, 193781/269984 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.001 elapsed), 0.016 MUT (0.020 elapsed), 0.009 GC (0.011 elapsed) :ghc>>
<<ghc: 42859576 bytes, 84 GCs, 193781/269984 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.001 elapsed), 0.015 MUT (0.018 elapsed), 0.009 GC (0.013 elapsed) :ghc>>

hledger -f data/1000x1000x10.journal stats
<<ghc: 349576344 bytes, 681 GCs, 1407388/4091680 avg/max bytes residency (7 samples), 11M in use, 0.000 INIT (0.000 elapsed), 0.124 MUT (0.130 elapsed), 0.047 GC (0.055 elapsed) :ghc>>
<<ghc: 349576280 bytes, 681 GCs, 1407388/4091680 avg/max bytes residency (7 samples), 11M in use, 0.000 INIT (0.000 elapsed), 0.126 MUT (0.132 elapsed), 0.049 GC (0.058 elapsed) :ghc>>

hledger -f data/10000x1000x10.journal stats
<<ghc: 3424030664 bytes, 6658 GCs, 11403359/41071624 avg/max bytes residency (11 samples), 111M in use, 0.000 INIT (0.000 elapsed), 1.207 MUT (1.228 elapsed), 0.473 GC (0.528 elapsed) :ghc>>
<<ghc: 3424030760 bytes, 6658 GCs, 11403874/41077288 avg/max bytes residency (11 samples), 111M in use, 0.000 INIT (0.002 elapsed), 1.234 MUT (1.256 elapsed), 0.470 GC (0.520 elapsed) :ghc>>

hledger -f data/100000x1000x10.journal stats
<<ghc: 34306547448 bytes, 66727 GCs, 76805504/414629288 avg/max bytes residency (14 samples), 1009M in use, 0.000 INIT (0.003 elapsed), 12.615 MUT (12.813 elapsed), 4.656 GC (5.291 elapsed) :ghc>>
<<ghc: 34306547320 bytes, 66727 GCs, 76805504/414629288 avg/max bytes residency (14 samples), 1009M in use, 0.000 INIT (0.009 elapsed), 12.802 MUT (13.065 elapsed), 4.774 GC (5.441 elapsed) :ghc>>
This commit is contained in:
Simon Michael 2016-05-24 17:09:20 -07:00
parent c89c33b36e
commit 770dcee742
14 changed files with 51 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
hledger-lib/Hledger/Data/Journal.hs
View File

@ -174,7 +174,7 @@ nulljournal = Journal {
,jmodifiertxns = []
,jperiodictxns = []
,jtxns = []
,jfinalcommentlines = []
,jfinalcommentlines = ""
,jfiles = []
,jlastreadtime = TOD 0 0
}

6
hledger-lib/Hledger/Data/Posting.hs
View File

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

8
hledger-lib/Hledger/Data/Transaction.hs
View File

@ -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 . ("; "++)

12
hledger-lib/Hledger/Data/Types.hs
View File

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

4
hledger-lib/Hledger/Query.hs
View File

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

32
hledger-lib/Hledger/Read/Common.hs
View File

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

4
hledger-lib/Hledger/Read/CsvReader.hs
View File

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

6
hledger-lib/Hledger/Read/JournalReader.hs
View File

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

2
hledger-lib/Hledger/Read/TimedotReader.hs
View File

@ -21,6 +21,8 @@ inc.client1 .... .... ..
-}
{-# LANGUAGE OverloadedStrings #-}
module Hledger.Read.TimedotReader (
-- * Reader
reader,

2
hledger-lib/Hledger/Utils/Text.hs
View File

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

4
hledger-web/Handler/AddForm.hs
View File

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

6
hledger/Hledger/Cli/Add.hs
View File

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

4
hledger/Hledger/Cli/Print.hs
View File

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

8
hledger/Hledger/Cli/Utils.hs
View File

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