strip trailing whitespace from all Haskell files

This commit is contained in:
gwern 2014-09-10 16:07:53 -04:00 committed by Simon Michael
parent 22279978af
commit d1618aaca8
37 changed files with 170 additions and 170 deletions

View File

@ -9,7 +9,7 @@ import Hledger.Cli
import Text.CSV
argsmode =
argsmode =
(defCommandMode ["balance-csv"]) {
modeHelp = "show matched postings accounts and their balances as CSV"
,modeGroupFlags = Group {

View File

@ -16,7 +16,7 @@ main = do
opts <- getCliOpts (defCommandMode ["hledger-print-unique"])
withJournalDo opts $
\opts j@Journal{jtxns=ts} -> print' opts j{jtxns=uniquify ts}
where
where
uniquify = nubBy (\t1 t2 -> thingToCompare t1 == thingToCompare t2) . sortBy (comparing thingToCompare)
thingToCompare = tdescription
-- thingToCompare = tdate

View File

@ -35,7 +35,7 @@ cmdmode = (defCommandMode ["hledger-rewrite"]) {
,("Reporting", reportflags)
,("Misc", helpflags)
]
,groupUnnamed = [flagReq ["add-posting"] (\s opts -> Right $ setopt "add-posting" s opts) "'ACCT AMTEXPR'"
,groupUnnamed = [flagReq ["add-posting"] (\s opts -> Right $ setopt "add-posting" s opts) "'ACCT AMTEXPR'"
"add a posting to ACCT, which may be parenthesised. AMTEXPR is either a literal amount, or *N which means the transaction's first matched amount multiplied by N (a decimal number). Two spaces separate ACCT and AMTEXPR."]
,groupHidden = []
}
@ -66,7 +66,7 @@ amountexprp =
amountExprRenderer :: Query -> AmountExpr -> (Transaction -> MixedAmount)
amountExprRenderer q aex =
case aex of
case aex of
AmountLiteral s -> either parseerror (const . mixed) $ parseWithCtx nullctx amountp s
AmountMultiplier n -> (`divideMixedAmount` (1 / n)) . (`firstAmountMatching` q)
where
@ -93,4 +93,4 @@ main = do
let j' = j{jtxns=map (\t -> if q `matchesTransaction` t then rewriteTransaction t addps else t) ts}
-- run the print command, showing all transactions
print' opts{reportopts_=ropts{query_=""}} j'

View File

@ -93,7 +93,7 @@ vty opts j = do
,abuf=[]
,alocs=[]
}
go a
go a
-- | Update the screen, wait for the next event, repeat.
go :: AppState -> IO ()
@ -101,7 +101,7 @@ go a@AppState{av=av,aopts=opts} = do
when (not $ debug_vty_ opts) $ update av (renderScreen a)
k <- next_event av
d <- getCurrentDay
case k of
case k of
EvResize x y -> go $ resize x y a
EvKey (KASCII 'l') [MCtrl] -> refresh av >> go a{amsg=helpmsg}
EvKey (KASCII 'b') [] -> go $ resetTrailAndEnter d BalanceScreen a
@ -151,7 +151,7 @@ setScrollY y a@AppState{alocs=(l:locs)} = a{alocs=(l':locs)} where l' = setLocSc
setPosY _ AppState{alocs=[]} = error' "shouldn't happen" -- silence warnings
setPosY y a@AppState{alocs=(l:locs)} = a{alocs=(l':locs)}
where
where
l' = setLocScrollY sy $ setLocCursorY cy l
ph = pageHeight a
cy = y `mod` ph
@ -186,7 +186,7 @@ moveDownAndPushEdge a
| sy+cy >= bh = a
| cy < ph-1 = updateCursorY (+1) a
| otherwise = updateScrollY (+1) a
where
where
Loc{sy=sy,cy=cy} = head $ alocs a
ph = pageHeight a
bh = length $ abuf a
@ -332,7 +332,7 @@ renderScreen (a@AppState{aw=w,ah=h,abuf=buf,amsg=msg}) =
renderStatus w msg
,pic_background = Background ' ' def_attr
}
where
where
(cx, cy) = (0, cursorY a)
sy = scrollY a
-- mainimg = (renderString attr $ unlines $ above)
@ -381,8 +381,8 @@ theme = Restrained
data UITheme = Restrained | Colorful | Blood
(defaultattr,
currentlineattr,
(defaultattr,
currentlineattr,
statusattr
) = case theme of
Restrained -> (def_attr

View File

@ -1,4 +1,4 @@
{-|
{-|
The Hledger.Data library allows parsing and querying of C++ ledger-style
journal files. It generally provides a compatible subset of C++ ledger's

View File

@ -115,7 +115,7 @@ sumAccounts a
-- | Remove all subaccounts below a certain depth.
clipAccounts :: Int -> Account -> Account
clipAccounts 0 a = a{asubs=[]}
clipAccounts 0 a = a{asubs=[]}
clipAccounts d a = a{asubs=subs}
where
subs = map (clipAccounts (d-1)) $ asubs a

View File

@ -63,7 +63,7 @@ isAccountNamePrefixOf :: AccountName -> AccountName -> Bool
isAccountNamePrefixOf = isPrefixOf . (++ [acctsepchar])
isSubAccountNameOf :: AccountName -> AccountName -> Bool
s `isSubAccountNameOf` p =
s `isSubAccountNameOf` p =
(p `isAccountNamePrefixOf` s) && (accountNameLevel s == (accountNameLevel p + 1))
-- | From a list of account names, select those which are direct
@ -73,7 +73,7 @@ subAccountNamesFrom accts a = filter (`isSubAccountNameOf` a) accts
-- | Convert a list of account names to a tree.
accountNameTreeFrom :: [AccountName] -> Tree AccountName
accountNameTreeFrom accts =
accountNameTreeFrom accts =
Node "root" (accounttreesfrom (topAccountNames accts))
where
accounttreesfrom :: [AccountName] -> [Tree AccountName]
@ -85,7 +85,7 @@ nullaccountnametree = Node "root" []
-- | Elide an account name to fit in the specified width.
-- From the ledger 2.6 news:
--
--
-- @
-- What Ledger now does is that if an account name is too long, it will
-- start abbreviating the first parts of the account name down to two
@ -99,7 +99,7 @@ nullaccountnametree = Node "root" []
-- ..:Af:Lu:Sn:Ca:Ch:Cash ; Abbreviated and elided!
-- @
elideAccountName :: Int -> AccountName -> AccountName
elideAccountName width s =
elideAccountName width s =
elideLeft width $ accountNameFromComponents $ elideparts width [] $ accountNameComponents s
where
elideparts :: Int -> [String] -> [String] -> [String]

View File

@ -4,13 +4,13 @@ A simple 'Amount' is some quantity of money, shares, or anything else.
It has a (possibly null) 'Commodity' and a numeric quantity:
@
$1
$1
£-50
EUR 3.44
EUR 3.44
GOOG 500
1.5h
90 apples
0
0
@
It may also have an assigned 'Price', representing this amount's per-unit
@ -166,7 +166,7 @@ similarAmountsOp op Amount{acommodity=_, aquantity=q1, astyle=AmountStyle{aspre
Amount{acommodity=c2, aquantity=q2, astyle=s2@AmountStyle{asprecision=p2}} =
-- trace ("a1:"++showAmountDebug a1) $ trace ("a2:"++showAmountDebug a2) $ traceWith (("= :"++).showAmountDebug)
amount{acommodity=c2, aquantity=q1 `op` q2, astyle=s2{asprecision=max p1 p2}}
-- c1==c2 || q1==0 || q2==0 =
-- c1==c2 || q1==0 || q2==0 =
-- otherwise = error "tried to do simple arithmetic with amounts in different commodities"
-- | Convert an amount to the specified commodity, ignoring and discarding
@ -605,7 +605,7 @@ tests_Hledger_Data_Amount = TestList $
,usd (-0.25)
])
`is` Mixed [usd 0 `withPrecision` 0]
,"adding mixed amounts with total prices" ~: do
(sum $ map (Mixed . (:[]))
[usd 1 @@ eur 1

View File

@ -43,8 +43,8 @@ commoditysymbols =
-- | Look up one of the sample commodities' symbol by name.
comm :: String -> Commodity
comm name = snd $ fromMaybe
(error' "commodity lookup failed")
comm name = snd $ fromMaybe
(error' "commodity lookup failed")
(find (\n -> fst n == name) commoditysymbols)
-- | Find the conversion rate between two commodities. Currently returns 1.

View File

@ -153,7 +153,7 @@ spanStart (DateSpan d _) = d
spanEnd :: DateSpan -> Maybe Day
spanEnd (DateSpan _ d) = d
-- might be useful later: http://en.wikipedia.org/wiki/Allen%27s_interval_algebra
-- might be useful later: http://en.wikipedia.org/wiki/Allen%27s_interval_algebra
-- | Get overall span enclosing multiple sequentially ordered spans.
spansSpan :: [DateSpan] -> DateSpan
@ -204,7 +204,7 @@ spanContainsDate (DateSpan Nothing Nothing) _ = True
spanContainsDate (DateSpan Nothing (Just e)) d = d < e
spanContainsDate (DateSpan (Just b) Nothing) d = d >= b
spanContainsDate (DateSpan (Just b) (Just e)) d = d >= b && d < e
-- | Calculate the intersection of a number of datespans.
spansIntersect [] = nulldatespan
spansIntersect [d] = d
@ -255,7 +255,7 @@ maybePeriod refdate = either (const Nothing) Just . parsePeriodExpr refdate
-- dateSpanAsText (DateSpan Nothing (Just e)) = printf "to %s" (show e)
-- dateSpanAsText (DateSpan (Just b) Nothing) = printf "from %s" (show b)
-- dateSpanAsText (DateSpan (Just b) (Just e)) = printf "%s to %s" (show b) (show e)
-- | Convert a single smart date string to a date span using the provided
-- reference date, or raise an error.
-- spanFromSmartDateString :: Day -> String -> DateSpan
@ -400,9 +400,9 @@ nthdayofweekcontaining n d | d1 >= d = d1
-- | Parse a couple of date string formats to a time type.
parsedateM :: String -> Maybe Day
parsedateM s = firstJust [
parsedateM s = firstJust [
parseTime defaultTimeLocale "%Y/%m/%d" s,
parseTime defaultTimeLocale "%Y-%m-%d" s
parseTime defaultTimeLocale "%Y-%m-%d" s
]
-- -- | Parse a date-time string to a time type, or raise an error.
@ -420,7 +420,7 @@ parsedate s = fromMaybe (error' $ "could not parse date \"" ++ s ++ "\"")
parsetimewith :: ParseTime t => String -> String -> t -> t
parsetimewith pat s def = fromMaybe def $ parseTime defaultTimeLocale pat s
{-|
{-|
Parse a date in any of the formats allowed in ledger's period expressions,
and maybe some others:
@ -557,7 +557,7 @@ lastthisnextthing = do
]
-- XXX support these in fixSmartDate
-- ++ (map string $ months ++ monthabbrevs ++ weekdays ++ weekdayabbrevs)
return ("",r,p)
periodexpr :: Day -> GenParser Char st (Interval, DateSpan)

View File

@ -463,7 +463,7 @@ splitAssertions ps
| otherwise = (ps'++[head rest]):splitAssertions (tail rest)
where
(ps',rest) = break (isJust . pbalanceassertion) ps
-- | Fill in any missing amounts and check that all journal transactions
-- balance, or return an error message. This is done after parsing all
-- amounts and working out the canonical commodities, since balancing
@ -654,7 +654,7 @@ abspat pat = if isnegativepat pat then drop (length negateprefix) pat else pat
-- liabilities:debts $1
-- assets:bank:checking
--
Right samplejournal = journalBalanceTransactions $
Right samplejournal = journalBalanceTransactions $
nulljournal
{jtxns = [
txnTieKnot $ Transaction {

View File

@ -122,7 +122,7 @@ sumPostings = sum . map pamount
-- there is no parent transaction.
postingDate :: Posting -> Day
postingDate p = fromMaybe txndate $ pdate p
where
where
txndate = maybe nulldate tdate $ ptransaction p
-- | Get a posting's secondary (secondary) date, which is the first of:
@ -251,4 +251,4 @@ tests_Hledger_Data_Posting = TestList [
concatAccountNames ["a","(b)","[c:d]"] `is` "(a:b:c:d)"
]

View File

@ -24,17 +24,17 @@ import Hledger.Data.Amount
import Hledger.Data.Posting
import Hledger.Data.Transaction
instance Show TimeLogEntry where
instance Show TimeLogEntry where
show t = printf "%s %s %s" (show $ tlcode t) (show $ tldatetime t) (tlcomment t)
instance Show TimeLogCode where
instance Show TimeLogCode where
show SetBalance = "b"
show SetRequiredHours = "h"
show In = "i"
show Out = "o"
show FinalOut = "O"
instance Read TimeLogCode where
instance Read TimeLogCode where
readsPrec _ ('b' : xs) = [(SetBalance, xs)]
readsPrec _ ('h' : xs) = [(SetRequiredHours, xs)]
readsPrec _ ('i' : xs) = [(In, xs)]
@ -72,7 +72,7 @@ timeLogEntriesToTransactions now (i:o:rest)
entryFromTimeLogInOut :: TimeLogEntry -> TimeLogEntry -> Transaction
entryFromTimeLogInOut i o
| otime >= itime = t
| otherwise =
| otherwise =
error' $ "clock-out time less than clock-in time in:\n" ++ showTransaction t
where
t = Transaction {
@ -119,8 +119,8 @@ tests_Hledger_Data_TimeLog = TestList [
assertEntriesGiveStrings "split multi-day sessions at each midnight"
[clockin (mktime (addDays (-2) today) "23:00:00") ""]
["23:00-23:59","00:00-23:59","00:00-"++nowstr]
assertEntriesGiveStrings "auto-clock-out if needed"
[clockin (mktime today "00:00:00") ""]
assertEntriesGiveStrings "auto-clock-out if needed"
[clockin (mktime today "00:00:00") ""]
["00:00-"++nowstr]
let future = utcToLocalTime tz $ addUTCTime 100 now'
futurestr = showtime future

View File

@ -50,10 +50,10 @@ import Hledger.Data.Amount
instance Show Transaction where show = showTransactionUnelided
instance Show ModifierTransaction where
instance Show ModifierTransaction where
show t = "= " ++ mtvalueexpr t ++ "\n" ++ unlines (map show (mtpostings t))
instance Show PeriodicTransaction where
instance Show PeriodicTransaction where
show t = "~ " ++ ptperiodicexpr t ++ "\n" ++ unlines (map show (ptpostings t))
nullsourcepos :: SourcePos
@ -64,9 +64,9 @@ nulltransaction = Transaction {
tsourcepos=nullsourcepos,
tdate=nulldate,
tdate2=Nothing,
tstatus=False,
tcode="",
tdescription="",
tstatus=False,
tcode="",
tdescription="",
tcomment="",
ttags=[],
tpostings=[],
@ -286,7 +286,7 @@ balanceTransaction styles t@Transaction{tpostings=ps}
ramounts = map pamount rwithamounts
bvamounts = map pamount bvwithamounts
t' = t{tpostings=map inferamount ps}
where
where
inferamount p | not (hasAmount p) && isReal p = p{pamount = costOfMixedAmount (- sum ramounts)}
| not (hasAmount p) && isBalancedVirtual p = p{pamount = costOfMixedAmount (- sum bvamounts)}
| otherwise = p

View File

@ -45,7 +45,7 @@ type AccountName = String
data Side = L | R deriving (Eq,Show,Read,Ord,Typeable,Data)
type Commodity = String
type Quantity = Double
-- | An amount's price (none, per unit, or total) in another commodity.

View File

@ -1,5 +1,5 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-|
{-|
This is the entry point to hledger's reading system, which can read
Journals from various data formats. Use this module if you want to parse
@ -138,7 +138,7 @@ readJournal format rulesfile assrt path s =
readersFor :: (Maybe StorageFormat, Maybe FilePath, String) -> [Reader]
readersFor (format,path,s) =
dbg ("possible readers for "++show (format,path,elideRight 30 s)) $
case format of
case format of
Just f -> case readerForStorageFormat f of Just r -> [r]
Nothing -> []
Nothing -> case path of Nothing -> readers
@ -149,7 +149,7 @@ readersFor (format,path,s) =
readerForStorageFormat :: StorageFormat -> Maybe Reader
readerForStorageFormat s | null rs = Nothing
| otherwise = Just $ head rs
where
where
rs = filter ((s==).rFormat) readers :: [Reader]
-- | Find the readers which think they can handle the given file path and data, if any.

View File

@ -154,7 +154,7 @@ journal = do
eof
finalctx <- getState
return $ (combineJournalUpdates journalupdates, finalctx)
where
where
-- As all journal line types can be distinguished by the first
-- character, excepting transactions versus empty (blank or
-- comment-only) lines, can use choice w/o try
@ -354,7 +354,7 @@ test_transaction = do
assertEqual (ttags t) (ttags t2)
assertEqual (tpreceding_comment_lines t) (tpreceding_comment_lines t2)
assertEqual (show $ tpostings t) (show $ tpostings t2)
-- "0000/01/01\n\n" `gives` nulltransaction
-- "0000/01/01\n\n" `gives` nulltransaction
unlines [
"2012/05/14=2012/05/15 (code) desc ; tcomment1",
" ; tcomment2",
@ -412,7 +412,7 @@ test_transaction = do
," b"
," "
]
let p = parseWithCtx nullctx transaction $ unlines
["2009/1/1 x ; transaction comment"
," a 1 ; posting 1 comment"
@ -422,7 +422,7 @@ test_transaction = do
]
assertRight p
assertEqual 2 (let Right t = p in length $ tpostings t)
#endif
#endif
-- | Parse a date in YYYY/MM/DD format. Fewer digits are allowed. The year
-- may be omitted if a default year has already been set.
@ -501,7 +501,7 @@ codep = try (do { many1 spacenonewline; char '(' <?> "codep"; code <- anyChar `m
-- Parse the following whitespace-beginning lines as postings, posting tags, and/or comments.
postings :: GenParser Char JournalContext [Posting]
postings = many1 (try postingp) <?> "postings"
-- linebeginningwithspaces :: GenParser Char JournalContext String
-- linebeginningwithspaces = do
-- sp <- many1 spacenonewline
@ -532,7 +532,7 @@ postingp = do
test_postingp = do
let s `gives` ep = do
let parse = parseWithCtx nullctx postingp s
assertBool -- "postingp parser"
assertBool -- "postingp parser"
$ isRight parse
let Right ap = parse
same f = assertEqual (f ep) (f ap)
@ -547,21 +547,21 @@ test_postingp = do
" expenses:food:dining $10.00 ; a: a a \n ; b: b b \n" `gives`
posting{paccount="expenses:food:dining", pamount=Mixed [usd 10], pcomment=" a: a a \n b: b b \n", ptags=[("a","a a"), ("b","b b")]}
" a 1 ; [2012/11/28]\n" `gives`
" a 1 ; [2012/11/28]\n" `gives`
("a" `post` num 1){pcomment=" [2012/11/28]\n"
,ptags=[("date","2012/11/28")]
,pdate=parsedateM "2012/11/28"}
" a 1 ; a:a, [=2012/11/28]\n" `gives`
" a 1 ; a:a, [=2012/11/28]\n" `gives`
("a" `post` num 1){pcomment=" a:a, [=2012/11/28]\n"
,ptags=[("a","a"), ("date2","2012/11/28")]
,pdate=Nothing}
" a 1 ; a:a\n ; [2012/11/28=2012/11/29],b:b\n" `gives`
" a 1 ; a:a\n ; [2012/11/28=2012/11/29],b:b\n" `gives`
("a" `post` num 1){pcomment=" a:a\n [2012/11/28=2012/11/29],b:b\n"
,ptags=[("a","a"), ("date","2012/11/28"), ("date2","2012/11/29"), ("b","b")]
,pdate=parsedateM "2012/11/28"}
assertBool -- "postingp parses a quoted commodity with numbers"
(isRight $ parseWithCtx nullctx postingp " a 1 \"DE123\"\n")
@ -573,7 +573,7 @@ test_postingp = do
-- let Right p = parse
-- assertEqual "next-line comment\n" (pcomment p)
-- assertEqual (Just nullmixedamt) (pbalanceassertion p)
#endif
#endif
-- | Parse an account name, then apply any parent account prefix and/or account aliases currently in effect.
modifiedaccountname :: GenParser Char JournalContext AccountName
@ -595,7 +595,7 @@ accountnamep = do
when (accountNameFromComponents (accountNameComponents a') /= a')
(fail $ "account name seems ill-formed: "++a')
return a'
where
where
singlespace = try (do {spacenonewline; do {notFollowedBy spacenonewline; return ' '}})
-- couldn't avoid consuming a final space sometimes, harmless
striptrailingspace s = if last s == ' ' then init s else s
@ -625,7 +625,7 @@ test_spaceandamountormissing = do
assertParseEqual' (parseWithCtx nullctx spaceandamountormissing "$47.18") missingmixedamt
assertParseEqual' (parseWithCtx nullctx spaceandamountormissing " ") missingmixedamt
assertParseEqual' (parseWithCtx nullctx spaceandamountormissing "") missingmixedamt
#endif
#endif
-- | Parse a single-commodity amount, with optional symbol on the left or
-- right, optional unit or total price, and optional (ignored)
@ -645,7 +645,7 @@ test_amountp = do
assertParseEqual'
(parseWithCtx nullctx amountp "$10 @@ €5")
(usd 10 `withPrecision` 0 @@ (eur 5 `withPrecision` 0))
#endif
#endif
-- | Parse an amount from a string, or get an error.
amountp' :: String -> Amount
@ -664,7 +664,7 @@ signp = do
leftsymbolamount :: GenParser Char JournalContext Amount
leftsymbolamount = do
sign <- signp
c <- commoditysymbol
c <- commoditysymbol
sp <- many spacenonewline
(q,prec,mdec,mgrps) <- numberp
let s = amountstyle{ascommodityside=L, ascommodityspaced=not $ null sp, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}
@ -761,16 +761,16 @@ fixedlotprice =
-- | Parse a string representation of a number for its value and display
-- attributes.
--
--
-- Some international number formats are accepted, eg either period or comma
-- may be used for the decimal point, and the other of these may be used for
-- separating digit groups in the integer part. See
-- http://en.wikipedia.org/wiki/Decimal_separator for more examples.
--
--
-- This returns: the parsed numeric value, the precision (number of digits
-- seen following the decimal point), the decimal point character used if any,
-- and the digit group style if any.
--
--
numberp :: GenParser Char JournalContext (Quantity, Int, Maybe Char, Maybe DigitGroupStyle)
numberp = do
-- a number is an optional sign followed by a sequence of digits possibly
@ -820,11 +820,11 @@ numberp = do
<?> "numberp"
where
numeric = isNumber . headDef '_'
#ifdef TESTS
test_numberp = do
let s `is` n = assertParseEqual' (parseWithCtx nullctx numberp s) n
assertFails = assertBool . isLeft . parseWithCtx nullctx numberp
assertFails = assertBool . isLeft . parseWithCtx nullctx numberp
assertFails ""
"0" `is` (0, 0, '.', ',', [])
"1" `is` (1, 0, '.', ',', [])
@ -843,7 +843,7 @@ test_numberp = do
assertFails "1..1"
assertFails ".1,"
assertFails ",1."
#endif
#endif
-- comment parsers
@ -878,7 +878,7 @@ tagsInComment :: String -> [Tag]
tagsInComment c = concatMap tagsInCommentLine $ lines c'
where
c' = ledgerDateSyntaxToTags c
tagsInCommentLine :: String -> [Tag]
tagsInCommentLine = catMaybes . map maybetag . map strip . splitAtElement ','
where
@ -913,7 +913,7 @@ ledgerDateSyntaxToTags = regexReplaceBy "\\[[-.\\/0-9=]+\\]" replace
replace' ('=':s) | isdate s = date2tag s
replace' s | last s =='=' && isdate (init s) = datetag (init s)
replace' s | length ds == 2 && isdate d1 && isdate d1 = datetag d1 ++ date2tag d2
where
where
ds = splitAtElement '=' s
d1 = headDef "" ds
d2 = lastDef "" ds
@ -922,17 +922,17 @@ ledgerDateSyntaxToTags = regexReplaceBy "\\[[-.\\/0-9=]+\\]" replace
isdate = isJust . parsedateM
datetag s = "date:"++s++", "
date2tag s = "date2:"++s++", "
#ifdef TESTS
test_ledgerDateSyntaxToTags = do
assertEqual "date2:2012/11/28, " $ ledgerDateSyntaxToTags "[=2012/11/28]"
#endif
#endif
dateValueFromTags, date2ValueFromTags :: [Tag] -> Maybe String
dateValueFromTags ts = maybe Nothing (Just . snd) $ find ((=="date") . fst) ts
date2ValueFromTags ts = maybe Nothing (Just . snd) $ find ((=="date2") . fst) ts
{- old hunit tests
test_Hledger_Read_JournalReader = TestList $ concat [

View File

@ -86,7 +86,7 @@ timelogFile = do items <- many timelogItem
eof
ctx <- getState
return (liftM (foldr (.) id) $ sequence items, ctx)
where
where
-- As all ledger line types can be distinguished by the first
-- character, excepting transactions versus empty (blank or
-- comment-only) lines, can use choice w/o try

View File

@ -39,9 +39,9 @@ type BalanceReportItem = (RenderableAccountName, MixedAmount)
-- It has:
--
-- * The full account name
--
--
-- * The ledger-style short elided account name (the leaf name, prefixed by any boring parents immediately above)
--
--
-- * The number of indentation steps to use when rendering a ledger-style account tree
-- (normally the 0-based depth of this account excluding boring parents, or 0 with --flat).
type RenderableAccountName = (AccountName, AccountName, Int)
@ -67,14 +67,14 @@ balanceReport opts q j = (items, total)
accts = ledgerRootAccount $ ledgerFromJournal q $ journalSelectingAmountFromOpts opts j
accts' :: [Account]
| flat_ opts = dbg "accts" $
| flat_ opts = dbg "accts" $
filterzeros $
filterempty $
drop 1 $ clipAccountsAndAggregate (queryDepth q) $ flattenAccounts accts
| otherwise = dbg "accts" $
| otherwise = dbg "accts" $
filter (not.aboring) $
drop 1 $ flattenAccounts $
markboring $
markboring $
prunezeros $ clipAccounts (queryDepth q) accts
where
balance = if flat_ opts then aebalance else aibalance
@ -247,7 +247,7 @@ tests_balanceReport =
," 0"
]
,"accounts report with unmatched parent of two matched subaccounts" ~:
,"accounts report with unmatched parent of two matched subaccounts" ~:
defreportopts{patterns_=["cash","saving"]} `gives`
[" $-1 assets"
," $1 bank:saving"
@ -256,7 +256,7 @@ tests_balanceReport =
," $-1"
]
,"accounts report with multi-part account name" ~:
,"accounts report with multi-part account name" ~:
defreportopts{patterns_=["expenses:food"]} `gives`
[" $1 expenses:food"
,"--------------------"
@ -276,13 +276,13 @@ tests_balanceReport =
," $1"
]
,"accounts report negative account pattern always matches full name" ~:
,"accounts report negative account pattern always matches full name" ~:
defreportopts{patterns_=["not:e"]} `gives`
["--------------------"
," 0"
]
,"accounts report negative patterns affect totals" ~:
,"accounts report negative patterns affect totals" ~:
defreportopts{patterns_=["expenses","not:food"]} `gives`
[" $1 expenses:supplies"
,"--------------------"
@ -317,7 +317,7 @@ tests_balanceReport =
-}
]
Right samplejournal2 = journalBalanceTransactions $
Right samplejournal2 = journalBalanceTransactions $
nulljournal
{jtxns = [
txnTieKnot $ Transaction {
@ -337,12 +337,12 @@ Right samplejournal2 = journalBalanceTransactions $
}
]
}
-- tests_isInterestingIndented = [
-- "isInterestingIndented" ~: do
-- "isInterestingIndented" ~: do
-- let (opts, journal, acctname) `gives` r = isInterestingIndented opts l acctname `is` r
-- where l = ledgerFromJournal (queryFromOpts nulldate opts) journal
-- (defreportopts, samplejournal, "expenses") `gives` True
-- ]

View File

@ -107,7 +107,7 @@ multiBalanceReport opts q j = MultiBalanceReport (displayspans, items, totals)
postingAcctBals :: [Posting] -> [(ClippedAccountName, MixedAmount)]
postingAcctBals ps = [(aname a, (if tree_ opts then aibalance else aebalance) a) | a <- as]
where
as = depthLimit $
as = depthLimit $
(if tree_ opts then id else filter ((>0).anumpostings)) $
drop 1 $ accountsFromPostings ps
depthLimit

View File

@ -70,7 +70,7 @@ postingsReport opts q j = (totallabel, items)
beforeendq = dbg "beforeendq" $ dateqcons $ DateSpan Nothing reportend
reportq = dbg "reportq" $ depthless $ And [datelessq, beforeendq] -- user's query with no start date, end date on an interval boundary and no depth limit
pstoend =
pstoend =
dbg "ps4" $ sortBy (comparing pdate) $ -- sort postings by date (or date2)
dbg "ps3" $ map (filterPostingAmount symq) $ -- remove amount parts which the query's cur: terms would exclude
dbg "ps2" $ (if related_ opts then concatMap relatedPostings else id) $ -- with -r, replace each with its sibling postings
@ -172,7 +172,7 @@ summarisePostingsInDateSpan (DateSpan b e) wd depth showempty ps
anames = sort $ nub $ map paccount ps
-- aggregate balances by account, like ledgerFromJournal, then do depth-clipping
accts = accountsFromPostings ps
balance a = maybe nullmixedamt bal $ lookupAccount a accts
balance a = maybe nullmixedamt bal $ lookupAccount a accts
where
bal = if isclipped a then aibalance else aebalance
isclipped a = accountNameLevel a >= depth
@ -262,7 +262,7 @@ tests_postingsReport = [
]
,"postings report with cleared option" ~:
do
do
let opts = defreportopts{cleared_=True}
j <- readJournal' sample_journal_str
(postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines
@ -274,7 +274,7 @@ tests_postingsReport = [
]
,"postings report with uncleared option" ~:
do
do
let opts = defreportopts{uncleared_=True}
j <- readJournal' sample_journal_str
(postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines
@ -287,7 +287,7 @@ tests_postingsReport = [
]
,"postings report sorts by date" ~:
do
do
j <- readJournal' $ unlines
["2008/02/02 a"
," b 1"
@ -309,7 +309,7 @@ tests_postingsReport = [
]
,"postings report with account pattern, case insensitive" ~:
do
do
j <- samplejournal
let opts = defreportopts{patterns_=["cAsH"]}
(postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines
@ -317,9 +317,9 @@ tests_postingsReport = [
]
,"postings report with display expression" ~:
do
do
j <- samplejournal
let gives displayexpr =
let gives displayexpr =
(registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is`)
where opts = defreportopts{display_=Just displayexpr}
"d<[2008/6/2]" `gives` ["2008/01/01","2008/06/01"]
@ -329,7 +329,7 @@ tests_postingsReport = [
"d>[2008/6/2]" `gives` ["2008/06/03","2008/12/31"]
,"postings report with period expression" ~:
do
do
j <- samplejournal
let periodexpr `gives` dates = do
j' <- samplejournal
@ -359,7 +359,7 @@ tests_postingsReport = [
]
, "postings report with depth arg" ~:
do
do
j <- samplejournal
let opts = defreportopts{depth_=Just 2}
(postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines

View File

@ -120,7 +120,7 @@ accountTransactionsReport opts j q thisacctquery = (label, items)
ts3 = map (setTransactionDateToPostingDate q thisacctquery) ts2
-- and sorted
ts = sortBy (comparing tdate) ts3
-- starting balance: if we are filtering by a start date and nothing else,
-- the sum of postings to this account before that date; otherwise zero.
(startbal,label) | queryIsNull q = (nullmixedamt, balancelabel)

View File

@ -251,7 +251,7 @@ difforzero a b = maximum [(a - b), 0]
-- lists
splitAtElement :: Eq a => a -> [a] -> [[a]]
splitAtElement e l =
splitAtElement e l =
case dropWhile (e==) l of
[] -> []
l' -> first : splitAtElement e rest
@ -285,7 +285,7 @@ subtreeinforest _ [] = Nothing
subtreeinforest v (t:ts) = case (subtreeat v t) of
Just t' -> Just t'
Nothing -> subtreeinforest v ts
-- | remove all nodes past a certain depth
treeprune :: Int -> Tree a -> Tree a
treeprune 0 t = Node (root t) []
@ -297,15 +297,15 @@ treemap f t = Node (f $ root t) (map (treemap f) $ branches t)
-- | remove all subtrees whose nodes do not fulfill predicate
treefilter :: (a -> Bool) -> Tree a -> Tree a
treefilter f t = Node
(root t)
treefilter f t = Node
(root t)
(map (treefilter f) $ filter (treeany f) $ branches t)
-- | is predicate true in any node of tree ?
treeany :: (a -> Bool) -> Tree a -> Bool
treeany f t = f (root t) || any (treeany f) (branches t)
-- treedrop -- remove the leaves which do fulfill predicate.
-- treedrop -- remove the leaves which do fulfill predicate.
-- treedropall -- do this repeatedly.
-- | show a compact ascii representation of a tree
@ -605,7 +605,7 @@ applyN :: Int -> (a -> a) -> a -> a
applyN n f = (!! n) . iterate f
-- | Convert a possibly relative, possibly tilde-containing file path to an absolute one,
-- given the current directory. ~username is not supported. Leave "-" unchanged.
-- given the current directory. ~username is not supported. Leave "-" unchanged.
expandPath :: MonadIO m => FilePath -> FilePath -> m FilePath -- general type sig for use in reader parsers
expandPath _ "-" = return "-"
expandPath curdir p = (if isRelative p then (curdir </>) else id) `liftM` expandPath' p

View File

@ -116,7 +116,7 @@ replaceAll re f s = start end
where
(_, end, start) = foldl' go (0, s, id) $ getAllMatches $ match re s
go (ind,read,write) (off,len) =
let (skip, start) = splitAt (off - ind) read
(matched, remaining) = splitAt len start
let (skip, start) = splitAt (off - ind) read
(matched, remaining) = splitAt len start
in (off + len, remaining, write . (skip++) . (f matched ++))

View File

@ -111,7 +111,7 @@ registerChartHtml percommoditytxnreports =
\$('#register-chart-label').text('#{charttitle}');
var seriesData = [
$forall (c,(_,items)) <- percommoditytxnreports
/* we render each commodity using two series:
/* we render each commodity using two series:
* one with extra data points added to show a stepped balance line */
{
data: [
@ -128,7 +128,7 @@ registerChartHtml percommoditytxnreports =
show: true,
steps: true,
},
points: {
points: {
show: false,
},
clickable: false,
@ -152,7 +152,7 @@ registerChartHtml percommoditytxnreports =
lines: {
show: false,
},
points: {
points: {
show: true,
},
},

View File

@ -29,7 +29,7 @@ webflags = [
,flagReq ["base-url"] (\s opts -> Right $ setopt "base-url" s opts) "BASEURL" ("set the base url (default: "++defbaseurlexample++")")
,flagReq ["file-url"] (\s opts -> Right $ setopt "file-url" s opts) "FILEURL" ("set the static files url (default: BASEURL/static)")
]
webmode :: Mode [([Char], [Char])]
webmode = (mode "hledger-web" [("command","web")]
"start serving the hledger web interface"

View File

@ -1,4 +1,4 @@
{-|
{-|
Hledger.Cli re-exports the options, utilities and commands provided by
the hledger command-line program. This module also aggregates the
@ -69,19 +69,19 @@ tests_Hledger_Cli = TestList
j1 `is` j2{filereadtime=filereadtime j1, files=files j1, jContext=jContext j1}
in TestList
[
"account directive 1" ~: sameParse
"account directive 1" ~: sameParse
"2008/12/07 One\n test:from $-1\n test:to $1\n"
"!account test\n2008/12/07 One\n from $-1\n to $1\n"
,"account directive 2" ~: sameParse
,"account directive 2" ~: sameParse
"2008/12/07 One\n test:foo:from $-1\n test:foo:to $1\n"
"!account test\n!account foo\n2008/12/07 One\n from $-1\n to $1\n"
,"account directive 3" ~: sameParse
,"account directive 3" ~: sameParse
"2008/12/07 One\n test:from $-1\n test:to $1\n"
"!account test\n!account foo\n!end\n2008/12/07 One\n from $-1\n to $1\n"
,"account directive 4" ~: sameParse
,"account directive 4" ~: sameParse
("2008/12/07 One\n alpha $-1\n beta $1\n" ++
"!account outer\n2008/12/07 Two\n aigh $-2\n bee $2\n" ++
"!account inner\n2008/12/07 Three\n gamma $-3\n delta $3\n" ++
@ -136,7 +136,7 @@ tests_Hledger_Cli = TestList
]
-- fixtures/test data
-- date1 = parsedate "2008/11/26"
@ -340,7 +340,7 @@ defaultyear_journal_str = unlines
-- ]
journal7 :: Journal
journal7 = nulljournal {jtxns =
journal7 = nulljournal {jtxns =
[
txnTieKnot Transaction {
tsourcepos=nullsourcepos,

View File

@ -20,7 +20,7 @@ import Safe (headDef, headMay)
import System.Console.CmdArgs.Explicit
import System.Console.Haskeline (runInputT, defaultSettings, setComplete)
import System.Console.Haskeline.Completion
import System.Console.Wizard
import System.Console.Wizard
import System.Console.Wizard.Haskeline
import System.IO ( stderr, hPutStr, hPutStrLn )
import Text.ParserCombinators.Parsec hiding (Line)
@ -128,9 +128,9 @@ confirmedTransactionWizard es@EntryState{..} = do
-- liftIO $ hPrintf stderr {- "Transaction entered:\n%s" -} (show t)
output $ show t
y <- let def = "y" in
retryMsg "Please enter y or n." $
parser ((fmap ('y' ==)) . headMay . map toLower . strip) $
defaultTo' def $ nonEmpty $
retryMsg "Please enter y or n." $
parser ((fmap ('y' ==)) . headMay . map toLower . strip) $
defaultTo' def $ nonEmpty $
maybeRestartTransaction $
line $ green $ printf "Save this transaction to the journal ?%s: " (showDefault def)
if y then return t else throw RestartTransactionException
@ -167,10 +167,10 @@ similarTransaction EntryState{..} desc =
dateAndCodeWizard EntryState{..} = do
let def = headDef (showDate esDefDate) esArgs
retryMsg "A valid hledger smart date is required. Eg: 2014/2/14, 14, yesterday." $
parser (parseSmartDateAndCode esToday) $
retryMsg "A valid hledger smart date is required. Eg: 2014/2/14, 14, yesterday." $
parser (parseSmartDateAndCode esToday) $
withCompletion (dateCompleter def) $
defaultTo' def $ nonEmpty $
defaultTo' def $ nonEmpty $
maybeExit $
maybeRestartTransaction $
-- maybeShowHelp $
@ -191,7 +191,7 @@ dateAndCodeWizard EntryState{..} = do
descriptionAndCommentWizard EntryState{..} = do
let def = headDef "" esArgs
s <- withCompletion (descriptionCompleter esJournal def) $
defaultTo' def $ nonEmpty $
defaultTo' def $ nonEmpty $
maybeRestartTransaction $
line $ green $ printf "Description%s: " (showDefault def)
let (desc,comment) = (strip a, strip $ dropWhile (==';') b) where (a,b) = break (==';') s
@ -233,7 +233,7 @@ accountWizard EntryState{..} = do
retryMsg "A valid hledger account name is required. Eg: assets:cash, expenses:food:eating out." $
parser (parseAccountOrDotOrNull def canfinish) $
withCompletion (accountCompleter esJournal def) $
defaultTo' def $ -- nonEmpty $
defaultTo' def $ -- nonEmpty $
maybeRestartTransaction $
line $ green $ printf "Account %d%s%s: " pnum (endmsg::String) (showDefault def)
where
@ -259,12 +259,12 @@ amountAndCommentWizard EntryState{..} = do
_ | pnum > 1 && not (isZeroMixedAmount balancingamt) -> showamt balancingamt
_ -> ""
retryMsg "A valid hledger amount is required. Eg: 1, $2, 3 EUR, \"4 red apples\"." $
parser parseAmountAndComment $
parser parseAmountAndComment $
withCompletion (amountCompleter def) $
defaultTo' def $ nonEmpty $
defaultTo' def $ nonEmpty $
maybeRestartTransaction $
line $ green $ printf "Amount %d%s: " pnum (showDefault def)
where
where
parseAmountAndComment = either (const Nothing) Just . parseWithCtx nodefcommodityctx amountandcommentp
nodefcommodityctx = (jContext esJournal){ctxDefaultCommodityAndStyle=Nothing}
amountandcommentp = do
@ -298,7 +298,7 @@ maybeExit = parser (\s -> if s=="." then throw UnexpectedEOF else Just s)
maybeRestartTransaction = parser (\s -> if s=="<" then throw RestartTransactionException else Just s)
-- maybeShowHelp :: Wizard Haskeline String -> Wizard Haskeline String
-- maybeShowHelp wizard = maybe (liftIO showHelp >> wizard) return $
-- maybeShowHelp wizard = maybe (liftIO showHelp >> wizard) return $
-- parser (\s -> if s=="?" then Nothing else Just s) wizard
-- Completion helpers

View File

@ -129,7 +129,7 @@ There are three kinds of multi-column balance report, indicated by the heading:
period. Here, checking's balance increased by 10 in Feb:
> Change of balance (flow):
>
>
> Jan Feb Mar
> assets:checking 20 10 -5
@ -138,7 +138,7 @@ There are three kinds of multi-column balance report, indicated by the heading:
Here, 30 is the sum of checking postings during Jan and Feb:
> Ending balance (cumulative):
>
>
> Jan Feb Mar
> assets:checking 20 30 25
@ -148,7 +148,7 @@ There are three kinds of multi-column balance report, indicated by the heading:
pre-Jan postings which created a starting balance of 100:
> Ending balance (historical):
>
>
> Jan Feb Mar
> assets:checking 120 130 125
@ -161,7 +161,7 @@ Here's a (imperfect?) specification for the eliding/omitting behaviour:
* An account less deep than the report's max depth, with just one
interesting subaccount, and the same balance as the subaccount, is
non-interesting, and prefixed to the subaccount's line, unless
@--no-elide@ is in effect.
@--no-elide@ is in effect.
* An account with a zero inclusive balance and less than two interesting
subaccounts is not displayed at all, unless @--empty@ is in effect.
@ -405,7 +405,7 @@ cumulativeBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, colto
([printf "Ending balances (cumulative) in %s:" (showDateSpan $ multiBalanceReportSpan r)] ++) $
trimborder $ lines $
render id ((" "++) . maybe "" (showDate . prevday) . spanEnd) showMixedAmountOneLineWithoutPrice $
addtotalrow $
addtotalrow $
Table
(T.Group NoLine $ map (Header . padright acctswidth) accts)
(T.Group NoLine $ map Header colspans)
@ -426,7 +426,7 @@ historicalBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, colto
([printf "Ending balances (historical) in %s:" (showDateSpan $ multiBalanceReportSpan r)] ++) $
trimborder $ lines $
render id ((" "++) . maybe "" (showDate . prevday) . spanEnd) showMixedAmountOneLineWithoutPrice $
addtotalrow $
addtotalrow $
Table
(T.Group NoLine $ map (Header . padright acctswidth) accts)
(T.Group NoLine $ map Header colspans)

View File

@ -1,4 +1,4 @@
{-|
{-|
Print a histogram report. (The "activity" command).

View File

@ -21,7 +21,7 @@ module Hledger.Cli.Options (
argsFlag,
showModeHelp,
withAliases,
-- * CLI options
CliOpts(..),
defcliopts,
@ -51,9 +51,9 @@ module Hledger.Cli.Options (
-- * Tests
tests_Hledger_Cli_Options
)
)
where
import qualified Control.Exception as C
import Control.Monad (when)
import Data.List
@ -199,7 +199,7 @@ standardAddonsHelp = [
-- | Get a mode's help message as a nicely wrapped string.
showModeHelp :: Mode a -> String
showModeHelp = (showText defaultWrap :: [Text] -> String) .
showModeHelp = (showText defaultWrap :: [Text] -> String) .
(helpText [] HelpFormatDefault :: Mode a -> [Text])
-- | Add command aliases to the command's help string.
@ -275,7 +275,7 @@ rawOptsToCliOpts rawopts = do
,width_ = maybestringopt "width" rawopts -- register
,reportopts_ = ropts
}
-- | Do final validation of processed opts, raising an error if there is trouble.
checkCliOpts :: CliOpts -> IO CliOpts -- or pure..
checkCliOpts opts@CliOpts{reportopts_=ropts} = do
@ -362,7 +362,7 @@ defaultBalanceFormat = [
-- | Output width configuration (for register).
data OutputWidth =
TotalWidth Width -- ^ specify the overall width
TotalWidth Width -- ^ specify the overall width
| FieldWidths [Width] -- ^ specify each field's width
deriving Show

View File

@ -1,4 +1,4 @@
{-|
{-|
A ledger-compatible @print@ command.
@ -46,7 +46,7 @@ entriesReportAsText _ _ items = concatMap showTransactionUnelided items
-- "showTransactions" ~: do
-- -- "print expenses" ~:
-- do
-- do
-- let opts = defreportopts{query_="expenses"}
-- d <- getCurrentDay
-- showTransactions opts (queryFromOpts d opts) samplejournal `is` unlines
@ -58,7 +58,7 @@ entriesReportAsText _ _ items = concatMap showTransactionUnelided items
-- ]
-- -- , "print report with depth arg" ~:
-- do
-- do
-- let opts = defreportopts{depth_=Just 2}
-- d <- getCurrentDay
-- showTransactions opts (queryFromOpts d opts) samplejournal `is` unlines

View File

@ -1,4 +1,4 @@
{-|
{-|
A ledger-compatible @register@ command.
@ -75,7 +75,7 @@ postingsReportItemAsText opts (mdate, menddate, mdesc, p, b) =
date desc acct amtfirstline balfirstline]
++
[printf (spacer ++ "%"++amtw++"s %"++balw++"s") a b | (a,b) <- zip amtrest balrest ]
where
totalwidth = case widthFromOpts opts of
Left _ -> defaultWidth -- shouldn't happen

View File

@ -1,5 +1,5 @@
#!/usr/bin/env runhaskell
{-
{-
generateledger.hs NUMTXNS NUMACCTS ACCTDEPTH
Outputs a dummy ledger file with the specified number of transactions,

View File

@ -43,7 +43,7 @@ allDeps base mod = allDeps' [mod] [mod] where
allDeps' [] _ = return []
{-
Usage: OrderByComplexity
Usage: OrderByComplexity
= directory where source code is found. This MUST
end in '/'

View File

@ -1,5 +1,5 @@
#!/usr/bin/env runhaskell
{-
{-
bench.hs - simple benchmarking of command-line programs.
Requires html and tabular.
Simon Michael 2008-2013
@ -63,14 +63,14 @@ usagehdr = "bench [-f testsfile] [-n iterations] [-p precision] executable1 [exe
"Run some functional tests with each of the specified executables,\n" ++
"where a test is \"zero or more arguments supported by all executables\",\n" ++
"and report the best execution times.\n"
options = [
Option "f" ["testsfile"] (ReqArg File "testsfile") "file containing tests, one per line, default: bench.tests"
,Option "n" ["iterations"] (ReqArg Num "iterations") "number of test iterations to run, default: 2"
,Option "p" ["precision"] (ReqArg Prec "precision") "show times with this precision, default: 2"
,Option "v" ["verbose"] (NoArg Verbose) "show intermediate results"
,Option "h" ["help"] (NoArg Help) "show this help"
]
]
usageftr = "\n" ++
"Tips:\n" ++
@ -81,10 +81,10 @@ usageftr = "\n" ++
usage = usageInfo usagehdr options ++ usageftr
-- an option value
data Opt = File {value::String}
| Num {value::String}
| Prec {value::String}
-- I don't know how optValuesForConstructor etc. can have that
data Opt = File {value::String}
| Num {value::String}
| Prec {value::String}
-- I don't know how optValuesForConstructor etc. can have that
-- type signature with these, but it works..
-- | Some Int
| Verbose
@ -112,7 +112,7 @@ parseargs as =
(_,_,errs) -> error (concat errs ++ usage)
optValueWithDefault :: (String -> Opt) -> String -> [Opt] -> String
optValueWithDefault optcons def opts =
optValueWithDefault optcons def opts =
last $ def : optValuesForConstructor optcons opts
optValuesForConstructor :: (String -> Opt) -> [Opt] -> [String]
@ -127,13 +127,13 @@ main = do
tests <- liftM (filter istest . lines) (readFile file)
now <- getCurrentTime
putStrLn $ printf "Using %s" file
putStrLn $ printf "Running %d tests %d times with %d executables at %s:"
putStrLn $ printf "Running %d tests %d times with %d executables at %s:"
(length tests) num (length exes) (show now)
let doexe t e = mapM (doiteration opts t e) [1..num]
let dotest t = mapM (doexe t) exes
hSetBuffering stdout NoBuffering
results <- mapM dotest tests
summarise opts tests exes results
summarise opts tests exes results
istest s = not (null s' || ("#" `isPrefixOf` s')) where s' = clean s
clean = unwords . words

View File

@ -9,7 +9,7 @@ import System.Environment
import Text.Printf
main = do
args <- getArgs
args <- getArgs
let f = head args
s <- readFile f
let ls = lines s