Hlint: Error: Redundant $

This commit is contained in:
marko.kocic 2009-09-22 11:55:11 +00:00
parent 550357934f
commit 8fdd28d446
20 changed files with 61 additions and 61 deletions

View File

@ -45,7 +45,7 @@ getTransaction l args = do
datestr <- askFor "date"
(Just $ showDate today)
(Just $ \s -> null s ||
(isRight $ parse (smartdate >> many spacenonewline >> eof) "" $ lowercase s))
isRight (parse (smartdate >> many spacenonewline >> eof) "" $ lowercase s))
description <- if null args
then askFor "description" Nothing (Just $ not . null)
else do
@ -54,7 +54,7 @@ getTransaction l args = do
return description
let historymatches = transactionsSimilarTo l description
bestmatch | null historymatches = Nothing
| otherwise = Just $ snd $ head $ historymatches
| otherwise = Just $ snd $ head historymatches
bestmatchpostings = maybe Nothing (Just . ltpostings) bestmatch
date = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) datestr
getpostingsandvalidate = do
@ -103,8 +103,8 @@ getPostings historicalps enteredps = do
postingtype ('(':_) = VirtualPosting
postingtype _ = RegularPosting
stripbrackets = dropWhile (`elem` "([") . reverse . dropWhile (`elem` "])") . reverse
validateamount = Just $ \s -> (null s && (not $ null enteredrealps))
|| (isRight $ parse (someamount>>many spacenonewline>>eof) "" s)
validateamount = Just $ \s -> (null s && not (null enteredrealps))
|| isRight (parse (someamount>>many spacenonewline>>eof) "" s)
-- | Prompt for and read a string value, optionally with a default value
-- and a validator. A validator causes the prompt to repeat until the
@ -185,7 +185,7 @@ transactionsSimilarTo :: Ledger -> String -> [(Double,LedgerTransaction)]
transactionsSimilarTo l s =
sortBy compareRelevanceAndRecency
$ filter ((> threshold).fst)
$ [(compareLedgerDescriptions s $ ltdescription t, t) | t <- ts]
[(compareLedgerDescriptions s $ ltdescription t, t) | t <- ts]
where
compareRelevanceAndRecency (n1,t1) (n2,t2) = compare (n2,ltdate t2) (n1,ltdate t1)
ts = ledger_txns $ rawledger l

View File

@ -138,7 +138,7 @@ showInterestingAccount l interestingaccts a = concatTopPadded [amt, " ", depths
depthspacer = replicate (2 * length interestingparents) ' '
-- the partial name is the account's leaf name, prefixed by the
-- names of any boring parents immediately above
partialname = accountNameFromComponents $ (reverse $ map accountLeafName ps) ++ [accountLeafName a]
partialname = accountNameFromComponents $ reverse (map accountLeafName ps) ++ [accountLeafName a]
where ps = takeWhile boring parents where boring = not . (`elem` interestingparents)
-- | Is the named account considered interesting for this ledger's balance report ?

View File

@ -35,7 +35,7 @@ showHistogram opts args l = concatMap (printDayWith countBar) daytxns
| otherwise = filter (not . isZeroMixedAmount . tamount)
matchapats = matchpats apats . taccount
(apats,_) = parsePatternArgs args
filterdepth | interval == NoInterval = filter (\t -> (accountNameLevel $ taccount t) <= depth)
filterdepth | interval == NoInterval = filter (\t -> accountNameLevel (taccount t) <= depth)
| otherwise = id
depth = depthFromOpts opts

View File

@ -34,7 +34,7 @@ showRegisterReport opts args l
where
interval = intervalFromOpts opts
ts = sortBy (comparing tdate) $ filterempties $ filter matchapats $ filterdepth $ ledgerTransactions l
filterdepth | interval == NoInterval = filter (\t -> (accountNameLevel $ taccount t) <= depth)
filterdepth | interval == NoInterval = filter (\t -> accountNameLevel (taccount t) <= depth)
| otherwise = id
filterempties
| Empty `elem` opts = id
@ -75,7 +75,7 @@ summariseTransactionsInDateSpan (DateSpan b e) tnum depth showempty ts
| null ts = []
| otherwise = summaryts'
where
txn = nulltxn{tnum=tnum, tdate=b', tdescription="- "++(showDate $ addDays (-1) e')}
txn = nulltxn{tnum=tnum, tdate=b', tdescription="- "++ showDate (addDays (-1) e')}
b' = fromMaybe (tdate $ head ts) b
e' = fromMaybe (tdate $ last ts) e
summaryts'
@ -108,7 +108,7 @@ showtxn :: Bool -> Transaction -> MixedAmount -> String
showtxn omitdesc t b = concatBottomPadded [entrydesc ++ p ++ " ", bal] ++ "\n"
where
entrydesc = if omitdesc then replicate 32 ' ' else printf "%s %s " date desc
date = showDate $ da
date = showDate da
desc = printf "%-20s" $ elideRight 20 de :: String
p = showPosting $ Posting s a amt "" tt
bal = padleft 12 (showMixedAmountOrZero b)

View File

@ -20,7 +20,7 @@ stats opts args l = do
showStats :: [Opt] -> [String] -> Ledger -> Day -> String
showStats _ _ l today =
heading ++ (unlines $ map (\(a,b) -> printf fmt a b) stats)
heading ++ unlines (map (\(a,b) -> printf fmt a b) stats)
where
heading = underline $ printf "Ledger statistics as of %s" (show today)
fmt = "%-" ++ (show w1) ++ "s: %-" ++ (show w2) ++ "s"

View File

@ -52,7 +52,7 @@ ui opts args l = do
v <- mkVty
DisplayBounds w h <- display_bounds $ terminal v
let opts' = SubTotal:opts
let a = enter BalanceScreen $
let a = enter BalanceScreen
AppState {
av=v
,aw=fromIntegral w
@ -269,7 +269,7 @@ accountNameAt buf lineno = accountNameFromComponents anamecomponents
scrollToLedgerTransaction :: LedgerTransaction -> AppState -> AppState
scrollToLedgerTransaction e a@AppState{abuf=buf} = setCursorY cy $ setScrollY sy a
where
entryfirstline = head $ lines $ showLedgerTransaction $ e
entryfirstline = head $ lines $ showLedgerTransaction e
halfph = pageHeight a `div` 2
y = fromMaybe 0 $ findIndex (== entryfirstline) buf
sy = max 0 $ y - halfph
@ -282,8 +282,8 @@ currentLedgerTransaction :: AppState -> LedgerTransaction
currentLedgerTransaction a@AppState{aledger=l,abuf=buf} = entryContainingTransaction a t
where
t = safehead nulltxn $ filter ismatch $ ledgerTransactions l
ismatch t = tdate t == (parsedate $ take 10 datedesc)
&& (take 70 $ showtxn False t nullmixedamt) == (datedesc ++ acctamt)
ismatch t = tdate t == parsedate (take 10 datedesc)
&& take 70 (showtxn False t nullmixedamt) == (datedesc ++ acctamt)
datedesc = take 32 $ fromMaybe "" $ find (not . (" " `isPrefixOf`)) $ [safehead "" rest] ++ reverse above
acctamt = drop 32 $ safehead "" rest
safehead d ls = if null ls then d else head ls
@ -293,7 +293,7 @@ currentLedgerTransaction a@AppState{aledger=l,abuf=buf} = entryContainingTransac
-- | Get the entry which contains the given transaction.
-- Will raise an error if there are problems.
entryContainingTransaction :: AppState -> Transaction -> LedgerTransaction
entryContainingTransaction AppState{aledger=l} t = (ledger_txns $ rawledger l) !! tnum t
entryContainingTransaction AppState{aledger=l} t = ledger_txns (rawledger l) !! tnum t
-- renderers
@ -309,11 +309,11 @@ renderScreen (a@AppState{aw=w,ah=h,abuf=buf,amsg=msg}) =
(cx, cy) = (0, cursorY a)
sy = scrollY a
-- trying for more speed
mainimg = (vert_cat $ map (string defaultattr) above)
mainimg = vert_cat (map (string defaultattr) above)
<->
(string currentlineattr thisline)
<->
(vert_cat $ map (string defaultattr) below)
vert_cat (map (string defaultattr) below)
(thisline,below) | null rest = (blankline,[])
| otherwise = (head rest, tail rest)
(above,rest) = splitAt cy linestorender
@ -341,7 +341,7 @@ renderString :: Attr -> String -> Image
renderString attr s = vert_cat $ map (string attr) rows
where
rows = lines $ fitto w h s
w = maximum $ map length $ ls
w = maximum $ map length ls
h = length ls
ls = lines s

View File

@ -29,7 +29,7 @@ accountLeafName = last . accountNameComponents
accountNameLevel :: AccountName -> Int
accountNameLevel "" = 0
accountNameLevel a = (length $ filter (==acctsepchar) a) + 1
accountNameLevel a = length (filter (==acctsepchar) a) + 1
-- | ["a:b:c","d:e"] -> ["a","a:b","a:b:c","d","d:e"]
expandAccountNames :: [AccountName] -> [AccountName]
@ -47,7 +47,7 @@ parentAccountNames :: AccountName -> [AccountName]
parentAccountNames a = parentAccountNames' $ parentAccountName a
where
parentAccountNames' "" = []
parentAccountNames' a = [a] ++ (parentAccountNames' $ parentAccountName a)
parentAccountNames' a = [a] ++ parentAccountNames' (parentAccountName a)
isAccountNamePrefixOf :: AccountName -> AccountName -> Bool
isAccountNamePrefixOf = isPrefixOf . (++ [acctsepchar])
@ -160,7 +160,7 @@ elideAccountName width s =
where
elideparts :: Int -> [String] -> [String] -> [String]
elideparts width done ss
| (length $ accountNameFromComponents $ done++ss) <= width = done++ss
| length (accountNameFromComponents $ done++ss) <= width = done++ss
| length ss > 1 = elideparts width (done++[take 2 $ head ss]) (tail ss)
| otherwise = done++ss

View File

@ -77,7 +77,7 @@ negateAmountPreservingPrice a = (-a){price=price a}
-- and other folds start with a no-commodity amount.)
amountop :: (Double -> Double -> Double) -> Amount -> Amount -> Amount
amountop op a@(Amount _ _ _) (Amount bc bq _) =
Amount bc ((quantity $ convertAmountTo bc a) `op` bq) Nothing
Amount bc (quantity (convertAmountTo bc a) `op` bq) Nothing
-- | Convert an amount to the commodity of its saved price, if any.
costOfAmount :: Amount -> Amount
@ -122,7 +122,7 @@ punctuatethousands s =
(int,frac) = break (=='.') num
addcommas = reverse . concat . intersperse "," . triples . reverse
triples [] = []
triples l = [take 3 l] ++ (triples $ drop 3 l)
triples l = [take 3 l] ++ triples (drop 3 l)
-- | Does this amount appear to be zero when displayed with its given precision ?
isZeroAmount :: Amount -> Bool
@ -162,7 +162,7 @@ showMixedAmount :: MixedAmount -> String
showMixedAmount m = concat $ intersperse "\n" $ map showfixedwidth as
where
(Mixed as) = normaliseMixedAmount m
width = maximum $ map (length . show) $ as
width = maximum $ map (length . show) as
showfixedwidth = printf (printf "%%%ds" width) . show
-- | Get the string representation of a mixed amount, and if it

View File

@ -242,7 +242,7 @@ smartdate = do
lastthisnextthing
]
(y,m,d) <- choice $ map try dateparsers
return $ (y,m,d)
return (y,m,d)
datesepchar = oneOf "/-."
@ -310,7 +310,7 @@ month :: GenParser Char st SmartDate
month = do
m <- choice $ map (try . string) months
let i = monthIndex m
return $ ("",show i,"")
return ("",show i,"")
mon :: GenParser Char st SmartDate
mon = do
@ -331,7 +331,7 @@ lastthisnextthing = do
,string "next"
]
many spacenonewline -- make the space optional for easier scripting
p <- choice $ [
p <- choice [
string "day"
,string "week"
,string "month"
@ -348,7 +348,7 @@ periodexpr rdate = choice $ map try [
intervalanddateperiodexpr rdate,
intervalperiodexpr,
dateperiodexpr rdate,
(return $ (NoInterval,DateSpan Nothing Nothing))
(return (NoInterval,DateSpan Nothing Nothing))
]
intervalanddateperiodexpr :: Day -> GenParser Char st (Interval, DateSpan)

View File

@ -65,9 +65,9 @@ import Ledger.RawLedger
instance Show Ledger where
show l = printf "Ledger with %d transactions, %d accounts\n%s"
((length $ ledger_txns $ rawledger l) +
(length $ modifier_txns $ rawledger l) +
(length $ periodic_txns $ rawledger l))
(length (ledger_txns $ rawledger l) +
length (modifier_txns $ rawledger l) +
length (periodic_txns $ rawledger l))
(length $ accountnames l)
(showtree $ accountnametree l)
@ -91,7 +91,7 @@ groupTransactions :: [Transaction] -> (Tree AccountName,
groupTransactions ts = (ant,txnsof,exclbalof,inclbalof)
where
txnanames = sort $ nub $ map taccount ts
ant = accountNameTreeFrom $ expandAccountNames $ txnanames
ant = accountNameTreeFrom $ expandAccountNames txnanames
allanames = flatten ant
txnmap = Map.union (transactionsByAccount ts) (Map.fromList [(a,[]) | a <- allanames])
balmap = Map.fromList $ flatten $ calculateBalances ant txnsof

View File

@ -61,13 +61,13 @@ showLedgerTransactionForPrint effective = showLedgerTransaction' False effective
showLedgerTransaction' :: Bool -> Bool -> LedgerTransaction -> String
showLedgerTransaction' elide effective t =
unlines $ [description] ++ (showpostings $ ltpostings t) ++ [""]
unlines $ [description] ++ showpostings (ltpostings t) ++ [""]
where
description = concat [date, status, code, desc] -- , comment]
date | effective = showdate $ fromMaybe (ltdate t) $ lteffectivedate t
| otherwise = showdate (ltdate t) ++ maybe "" showedate (lteffectivedate t)
status = if ltstatus t then " *" else ""
code = if (length $ ltcode t) > 0 then (printf " (%s)" $ ltcode t) else ""
code = if length (ltcode t) > 0 then (printf " (%s)" $ ltcode t) else ""
desc = " " ++ ltdescription t
showdate = printf "%-10s" . showDate
showedate = printf "=%s" . showdate
@ -76,9 +76,9 @@ showLedgerTransaction' elide effective t =
= map showposting (init ps) ++ [showpostingnoamt (last ps)]
| otherwise = map showposting ps
where
showposting p = showacct p ++ " " ++ (showamount $ pamount p) ++ (showcomment $ pcomment p)
showpostingnoamt p = rstrip $ showacct p ++ " " ++ (showcomment $ pcomment p)
showacct p = " " ++ showstatus p ++ (printf (printf "%%-%ds" w) $ showAccountName Nothing (ptype p) (paccount p))
showposting p = showacct p ++ " " ++ showamount (pamount p) ++ showcomment (pcomment p)
showpostingnoamt p = rstrip $ showacct p ++ " " ++ showcomment (pcomment p)
showacct p = " " ++ showstatus p ++ printf (printf "%%-%ds" w) (showAccountName Nothing (ptype p) (paccount p))
w = maximum $ map (length . paccount) ps
showamount = printf "%12s" . showMixedAmount
showcomment s = if (length s) > 0 then " ; "++s else ""

View File

@ -115,7 +115,7 @@ ledgerInclude = do many1 spacenonewline
case runParser ledgerFile outerState filename contents of
Right l -> l `catchError` (throwError . (inIncluded ++))
Left perr -> throwError $ inIncluded ++ show perr
where readFileE outerPos filename = ErrorT $ do (liftM Right $ readFile filename) `catch` leftError
where readFileE outerPos filename = ErrorT $ do liftM Right (readFile filename) `catch` leftError
where leftError err = return $ Left $ currentPos ++ whileReading ++ show err
currentPos = show outerPos
whileReading = " reading " ++ show filename ++ ":\n"

View File

@ -21,9 +21,9 @@ import Ledger.TimeLog
instance Show RawLedger where
show l = printf "RawLedger with %d transactions, %d accounts: %s"
((length $ ledger_txns l) +
(length $ modifier_txns l) +
(length $ periodic_txns l))
(length (ledger_txns l) +
length (modifier_txns l) +
length (periodic_txns l))
(length accounts)
(show accounts)
-- ++ (show $ rawLedgerTransactions l)
@ -139,7 +139,7 @@ canonicaliseAmounts costbasis l@(RawLedger ms ps ts tls hs f fp) = RawLedger ms
fixrawposting (Posting s ac a c t) = Posting s ac (fixmixedamount a) c t
fixmixedamount (Mixed as) = Mixed $ map fixamount as
fixamount = fixcommodity . (if costbasis then costOfAmount else id)
fixcommodity a = a{commodity=c} where c = canonicalcommoditymap ! (symbol $ commodity a)
fixcommodity a = a{commodity=c} where c = canonicalcommoditymap ! symbol (commodity a)
canonicalcommoditymap =
Map.fromList [(s,firstc{precision=maxp}) | s <- commoditysymbols,
let cs = commoditymap ! s,

View File

@ -55,7 +55,7 @@ dropws = dropWhile (`elem` " \t")
elideLeft width s =
case length s > width of
True -> ".." ++ (reverse $ take (width - 2) $ reverse s)
True -> ".." ++ reverse (take (width - 2) $ reverse s)
False -> s
elideRight width s =
@ -206,7 +206,7 @@ treefilter f t = Node
-- | 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)
treeany f t = f (root t) || any (treeany f) (branches t)
-- treedrop -- remove the leaves which do fulfill predicate.
-- treedropall -- do this repeatedly.

View File

@ -150,7 +150,7 @@ fixOptDates opts = do
fixopt d (End s) = End $ fixSmartDateStr d s
fixopt d (Display s) = -- hacky
Display $ gsubRegexPRBy "\\[.+?\\]" fixbracketeddatestr s
where fixbracketeddatestr s = "[" ++ (fixSmartDateStr d $ init $ tail s) ++ "]"
where fixbracketeddatestr s = "[" ++ fixSmartDateStr d (init $ tail s) ++ "]"
fixopt _ o = o
-- | Figure out the overall date span we should report on, based on any

View File

@ -488,11 +488,11 @@ tests = [
Left _ -> error "should not happen")
,"cacheLedger" ~: do
(length $ Map.keys $ accountmap $ cacheLedger [] rawledger7) `is` 15
length (Map.keys $ accountmap $ cacheLedger [] rawledger7) `is` 15
,"canonicaliseAmounts" ~:
"use the greatest precision" ~: do
(rawLedgerPrecisions $ canonicaliseAmounts False $ rawLedgerWithAmounts ["1","2.00"]) `is` [2,2]
rawLedgerPrecisions (canonicaliseAmounts False $ rawLedgerWithAmounts ["1","2.00"]) `is` [2,2]
,"commodities" ~: do
commodities ledger7 `is` [Commodity {symbol="$", side=L, spaced=False, comma=False, precision=2}]
@ -615,11 +615,11 @@ tests = [
,"default year" ~: do
rl <- rawLedgerFromString defaultyear_ledger_str
(ltdate $ head $ ledger_txns rl) `is` fromGregorian 2009 1 1
ltdate (head $ ledger_txns rl) `is` fromGregorian 2009 1 1
return ()
,"ledgerFile" ~: do
assertBool "ledgerFile should parse an empty file" $ (isRight $ parseWithCtx emptyCtx ledgerFile "")
assertBool "ledgerFile should parse an empty file" (isRight $ parseWithCtx emptyCtx ledgerFile "")
r <- rawLedgerFromString "" -- don't know how to get it from ledgerFile
assertBool "ledgerFile parsing an empty file should give an empty ledger" $ null $ ledger_txns r
@ -637,10 +637,10 @@ tests = [
$ either (const False) ((== "a") . ltdescription) t
,"ledgeraccountname" ~: do
assertBool "ledgeraccountname parses a normal accountname" $ (isRight $ parsewith ledgeraccountname "a:b:c")
assertBool "ledgeraccountname rejects an empty inner component" $ (isLeft $ parsewith ledgeraccountname "a::c")
assertBool "ledgeraccountname rejects an empty leading component" $ (isLeft $ parsewith ledgeraccountname ":b:c")
assertBool "ledgeraccountname rejects an empty trailing component" $ (isLeft $ parsewith ledgeraccountname "a:b:")
assertBool "ledgeraccountname parses a normal accountname" (isRight $ parsewith ledgeraccountname "a:b:c")
assertBool "ledgeraccountname rejects an empty inner component" (isLeft $ parsewith ledgeraccountname "a::c")
assertBool "ledgeraccountname rejects an empty leading component" (isLeft $ parsewith ledgeraccountname ":b:c")
assertBool "ledgeraccountname rejects an empty trailing component" (isLeft $ parsewith ledgeraccountname "a:b:")
,"ledgerposting" ~: do
parseWithCtx emptyCtx ledgerposting rawposting1_str `parseis` rawposting1
@ -651,7 +651,7 @@ tests = [
,"period expressions" ~: do
let todaysdate = parsedate "2008/11/26"
let str `gives` result = (show $ parsewith (periodexpr todaysdate) str) `is` ("Right "++result)
let str `gives` result = show (parsewith (periodexpr todaysdate) str) `is` ("Right " ++ result)
"from aug to oct" `gives` "(NoInterval,DateSpan (Just 2008-08-01) (Just 2008-10-01))"
"aug to oct" `gives` "(NoInterval,DateSpan (Just 2008-08-01) (Just 2008-10-01))"
"every day from aug to oct" `gives` "(Daily,DateSpan (Just 2008-08-01) (Just 2008-10-01))"
@ -943,7 +943,7 @@ tests = [
,"subAccounts" ~: do
l <- sampleledger
let a = ledgerAccount l "assets"
(map aname $ ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"]
map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"]
,"summariseTransactionsInDateSpan" ~: do
let gives (b,e,tnum,depth,showempty,ts) =

View File

@ -52,7 +52,7 @@ main = do
run cmd opts args
where
run cmd opts args
| Help `elem` opts = putStr $ usage
| Help `elem` opts = putStr usage
| Version `elem` opts = putStrLn versionmsg
| BinaryFilename `elem` opts = putStrLn binaryfilename
| cmd `isPrefixOf` "balance" = withLedgerDo opts args cmd balance
@ -69,4 +69,4 @@ main = do
| cmd `isPrefixOf` "web" = withLedgerDo opts args cmd web
#endif
| cmd `isPrefixOf` "test" = runtests opts args >> return ()
| otherwise = putStr $ usage
| otherwise = putStr usage

View File

@ -175,6 +175,6 @@ maketable opts rownames colnames results = Table rowhdrs colhdrs rows
where w = maximum $ map length ss
showtime :: [Opt] -> (Float -> String)
showtime opts = printf $ "%."++(show $ precisionopt opts)++"f"
showtime opts = printf $ "%." ++ show (precisionopt opts) ++ "f"
strace a = trace (show a) a

View File

@ -45,7 +45,7 @@ uniqueacctnames' depth uniquenames = group some ++ uniqueacctnames' depth rest
-- group ["a", "b", "c"] = ["a","a:b","a:b:c"]
group :: [String] -> [String]
group [] = []
group (a:as) = [a] ++ (map ((a++":")++) $ group as)
group (a:as) = [a] ++ map ((a++":")++) (group as)
pair :: [a] -> [(a,a)]
pair [] = []

View File

@ -15,7 +15,7 @@ main = do
let ls = lines s
let (firstpart, secondpart) = break ("individual inherited" `isInfixOf`) ls
putStr $ unlines firstpart
let fields = map getfields $ filter (not . null) $ drop 2 $ secondpart
let fields = map getfields $ filter (not . null) $ drop 2 secondpart
let maxnamelen = maximum $ map (length . head) fields
let fmt = "%-"++(show maxnamelen)++"s %10s %5s %6s %9s %10s"
putStrLn $ showheading fmt