generateledger tool, creates test ledgers of specified size

tools/generateledger.hs

@@ -0,0 +1,59 @@
+#!/usr/bin/env runhaskell
+{- 
+generateledger.hs NUMTXNS NUMACCTS ACCTDEPTH
+
+Outputs a dummy ledger file with the specified number of transactions,
+number of accounts, and account tree depth. Useful for
+testing/profiling/benchmarking.
+
+-}
+
+module Main
+where
+import System.Environment
+import Control.Monad
+import Data.Time.LocalTime
+import Data.Time.Calendar
+import Text.Printf
+import Numeric
+
+main = do
+  args <- getArgs
+  let [numtxns, numaccts, acctdepth] = map read args :: [Int]
+  today <- getCurrentDay
+  let (year,_,_) = toGregorian today
+  let d = fromGregorian (year-1) 1 1
+  let dates = iterate (addDays 1) d
+  let accts = pair $ cycle $ take numaccts $ uniqueacctnames acctdepth
+  mapM_ (\(n,d,(a,b)) -> putStr $ showtxn n d a b) $ take numtxns $ zip3 [1..] dates accts
+  return ()
+
+showtxn :: Int -> Day -> String -> String -> String
+showtxn txnno date acct1 acct2 =
+    printf "%s transaction %d\n  %-40s  %2d\n  %-40s  %2d\n\n" d txnno acct1 amt acct2 (-amt)
+    where
+      d = show date
+      amt = 1::Int
+
+uniqueacctnames :: Int -> [String]
+uniqueacctnames depth = uniqueacctnames' depth uniquenames
+    where uniquenames = map hex [1..] where hex = flip showHex ""
+
+uniqueacctnames' depth uniquenames = group some ++ uniqueacctnames' depth rest
+    where (some, rest) = splitAt depth uniquenames
+
+-- group ["a", "b", "c"] = ["a","a:b","a:b:c"]
+group :: [String] -> [String]
+group [] = []
+group (a:as) = [a] ++ (map ((a++":")++) $ group as)
+
+pair :: [a] -> [(a,a)]
+pair [] = []
+pair [a] = [(a,a)]
+pair (a:b:rest) = ((a,b):(pair rest))
+
+getCurrentDay :: IO Day
+getCurrentDay = do
+    t <- getZonedTime
+    return $ localDay (zonedTimeToLocalTime t)
+