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

tools: generatejournal: start from a fixed year, not last year

Browse Source 
So regenerating sample journals doesn't require updating tests.

[ci skip]
This commit is contained in:
Simon Michael 2019-04-20 08:30:56 -07:00
parent 9dd0b510dd
commit 2ca2466297
1 changed files with 13 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
tools/generatejournal.hs
View File

@ -2,12 +2,12 @@
{- {-
generatejournal.hs NUMTXNS NUMACCTS ACCTDEPTH [--chinese|--mixed] generatejournal.hs NUMTXNS NUMACCTS ACCTDEPTH [--chinese|--mixed]
This generates synthetic journal data for benchmarking & profiling. This generates synthetic journal data for benchmarking & profiling. It
It prints a dummy journal on stdout, with NUMTXNS transactions, one prints a dummy journal on stdout, with NUMTXNS transactions, one per
per day, using NUMACCTS account names with depths up to ACCTDEPTH. day, using NUMACCTS account names with depths up to ACCTDEPTH. It will
It will also contain NUMACCTS P records, one per day. also contain NUMACCTS P records, one per day. By default it uses only
By default it uses only ascii characters, with --chinese it uses wide ascii characters, with --chinese it uses wide chinese characters, or
chinese characters, or with --mixed it uses both. with --mixed it uses both.
-} -}
module Main module Main
@ -25,9 +25,9 @@ main = do
rawargs <- getArgs rawargs <- getArgs
let (opts,args) = partition (isPrefixOf "-") rawargs let (opts,args) = partition (isPrefixOf "-") rawargs
let [numtxns, numaccts, acctdepth] = map read args :: [Int] let [numtxns, numaccts, acctdepth] = map read args :: [Int]
today <- getCurrentDay -- today <- getCurrentDay
let (year,_,_) = toGregorian today -- let (year,_,_) = toGregorian today
let d = fromGregorian (year-1) 1 1 let d = fromGregorian 2000 1 1
let dates = iterate (addDays 1) d let dates = iterate (addDays 1) d
let accts = pair $ cycle $ take numaccts $ uniqueAccountNames opts acctdepth let accts = pair $ cycle $ take numaccts $ uniqueAccountNames opts acctdepth
mapM_ (\(n,d,(a,b)) -> putStr $ showtxn n d a b) $ take numtxns $ zip3 [1..] dates accts mapM_ (\(n,d,(a,b)) -> putStr $ showtxn n d a b) $ take numtxns $ zip3 [1..] dates accts
@ -86,8 +86,8 @@ pair [] = []
pair [a] = [(a,a)] pair [a] = [(a,a)]
pair (a:b:rest) = (a,b):pair rest pair (a:b:rest) = (a,b):pair rest
getCurrentDay :: IO Day -- getCurrentDay :: IO Day
getCurrentDay = do -- getCurrentDay = do
t <- getZonedTime -- t <- getZonedTime
return $ localDay (zonedTimeToLocalTime t) -- return $ localDay (zonedTimeToLocalTime t)