Hlint: Warning: Eta reduce

Commands/Balance.hs

@@ -109,7 +109,7 @@ import System.IO.UTF8
 
 -- | Print a balance report.
 balance :: [Opt] -> [String] -> Ledger -> IO ()
-balance opts args l = putStr $ showBalanceReport opts args l
+balance opts args = putStr . showBalanceReport opts args
 
 -- | Generate a balance report with the specified options for this ledger.
 showBalanceReport :: [Opt] -> [String] -> Ledger -> String
@@ -154,6 +154,6 @@ isInteresting opts l a
       notlikesub = not $ isZeroMixedAmount exclbalance where exclbalance = sumTransactions $ atransactions acct
       numinterestingsubs = length $ filter isInterestingTree subtrees
           where
-            isInterestingTree t = treeany (isInteresting opts l . aname) t
+            isInterestingTree = treeany (isInteresting opts l . aname)
             subtrees = map (fromJust . ledgerAccountTreeAt l) $ ledgerSubAccounts l $ ledgerAccount l a
 

Commands/Convert.hs

@@ -111,7 +111,7 @@ choose_acct_desc rules (acct,desc) | null matchingrules = (acct,desc)
       matched = fst $ fst $ fromJust m
       d = fromMaybe matched repl
 
-matchregex s = matchRegexPR ("(?i)"++s)
+matchregex = matchRegexPR . ("(?i)" ++)
 
 fixdate :: String -> String
 fixdate s = maybe "0000/00/00" showDate $ 

Commands/Histogram.hs

@@ -17,7 +17,7 @@ barchar = '*'
 -- | Print a histogram of some statistic per reporting interval, such as
 -- number of transactions per day.
 histogram :: [Opt] -> [String] -> Ledger -> IO ()
-histogram opts args l = putStr $ showHistogram opts args l
+histogram opts args = putStr . showHistogram opts args
 
 showHistogram :: [Opt] -> [String] -> Ledger -> String
 showHistogram opts args l = concatMap (printDayWith countBar) daytxns
@@ -33,7 +33,7 @@ showHistogram opts args l = concatMap (printDayWith countBar) daytxns
       filterempties
           | Empty `elem` opts = id
           | otherwise = filter (not . isZeroMixedAmount . tamount)
-      matchapats t = matchpats apats $ taccount t
+      matchapats = matchpats apats . taccount
       (apats,_) = parsePatternArgs args
       filterdepth | interval == NoInterval = filter (\t -> (accountNameLevel $ taccount t) <= depth)
                   | otherwise = id
@@ -43,6 +43,6 @@ printDayWith f (DateSpan b _, ts) = printf "%s %s\n" (show $ fromJust b) (f ts)
 
 countBar ts = replicate (length ts) barchar
 
-total ts = show $ sumTransactions ts
+total = show . sumTransactions
 
 -- totalBar ts = replicate (sumTransactions ts) barchar

Commands/Print.hs

@@ -14,7 +14,7 @@ import System.IO.UTF8
 
 -- | Print ledger transactions in standard format.
 print' :: [Opt] -> [String] -> Ledger -> IO ()
-print' opts args l = putStr $ showLedgerTransactions opts args l
+print' opts args = putStr . showLedgerTransactions opts args
 
 showLedgerTransactions :: [Opt] -> [String] -> Ledger -> String
 showLedgerTransactions opts args l = concatMap showLedgerTransactionUnelided txns

Commands/Register.hs

@@ -14,7 +14,7 @@ import System.IO.UTF8
 
 -- | Print a register report.
 register :: [Opt] -> [String] -> Ledger -> IO ()
-register opts args l = putStr $ showRegisterReport opts args l
+register opts args = putStr . showRegisterReport opts args
 
 {- |
 Generate the register report. Each ledger entry is displayed as two or
@@ -42,7 +42,7 @@ showRegisterReport opts args l
       (precedingts, ts') = break (matchdisplayopt dopt) ts
       (displayedts, _) = span (matchdisplayopt dopt) ts'
       startbal = sumTransactions precedingts
-      matchapats t = matchpats apats $ taccount t
+      matchapats = matchpats apats . taccount
       (apats,_) = parsePatternArgs args
       matchdisplayopt Nothing _ = True
       matchdisplayopt (Just e) t = (fromparse $ parsewith datedisplayexpr e) t

Commands/UI.hs

@@ -141,7 +141,7 @@ resize x y a = setCursorY cy' a{aw=x,ah=y}
       cy' = min cy (y-2)
 
 moveToTop :: AppState -> AppState
-moveToTop a = setPosY 0 a
+moveToTop = setPosY 0
 
 moveToBottom :: AppState -> AppState
 moveToBottom a = setPosY (length $ abuf a) a
@@ -216,7 +216,7 @@ enter scr@RegisterScreen a = updateData $ pushLoc Loc{scr=scr,sy=0,cy=0} a
 enter scr@PrintScreen a    = updateData $ pushLoc Loc{scr=scr,sy=0,cy=0} a
 -- enter scr@LedgerScreen a   = updateData $ pushLoc Loc{scr=scr,sy=0,cy=0} a
 
-resetTrailAndEnter scr a = enter scr $ clearLocs a
+resetTrailAndEnter scr = enter scr . clearLocs
 
 -- | Regenerate the display data appropriate for the current screen.
 updateData :: AppState -> AppState
@@ -318,7 +318,7 @@ renderScreen (a@AppState{aw=w,ah=h,abuf=buf,amsg=msg}) =
                        | otherwise = (head rest, tail rest)
       (above,rest) = splitAt cy linestorender
       linestorender = map padclipline $ take (h-1) $ drop sy $ buf ++ replicate h blankline
-      padclipline l = take w $ l ++ blankline
+      padclipline = take w . (++ blankline)
       blankline = replicate w ' '
 --       mainimg = (renderString attr $ unlines $ above)
 --           <->
@@ -334,7 +334,7 @@ padClipString :: Int -> Int -> String -> [String]
 padClipString h w s = rows
     where
       rows = map padclipline $ take h $ lines s ++ replicate h blankline
-      padclipline l = take w $ l ++ blankline
+      padclipline = take w . (++ blankline)
       blankline = replicate w ' '
 
 renderString :: Attr -> String -> Image
@@ -346,7 +346,7 @@ renderString attr s = vert_cat $ map (string attr) rows
       ls = lines s
 
 renderStatus :: Int -> String -> Image
-renderStatus w s = string statusattr (take w (s ++ repeat ' ')) 
+renderStatus w = string statusattr . take w . (++ repeat ' ')
 
 
 -- the all-important theming engine

Ledger/AccountName.hs

@@ -34,14 +34,14 @@ accountNameLevel a = (length $ filter (==acctsepchar) a) + 1
 -- | ["a:b:c","d:e"] -> ["a","a:b","a:b:c","d","d:e"]
 expandAccountNames :: [AccountName] -> [AccountName]
 expandAccountNames as = nub $ concat $ map expand as
-    where expand as = map accountNameFromComponents (tail $ inits $ accountNameComponents as)
+    where expand = map accountNameFromComponents . tail . inits . accountNameComponents
 
 -- | ["a:b:c","d:e"] -> ["a","d"]
 topAccountNames :: [AccountName] -> [AccountName]
 topAccountNames as = [a | a <- expandAccountNames as, accountNameLevel a == 1]
 
 parentAccountName :: AccountName -> AccountName
-parentAccountName a = accountNameFromComponents $ init $ accountNameComponents a
+parentAccountName = accountNameFromComponents . init . accountNameComponents
 
 parentAccountNames :: AccountName -> [AccountName]
 parentAccountNames a = parentAccountNames' $ parentAccountName a
@@ -50,7 +50,7 @@ parentAccountNames a = parentAccountNames' $ parentAccountName a
       parentAccountNames' a = [a] ++ (parentAccountNames' $ parentAccountName a)
 
 isAccountNamePrefixOf :: AccountName -> AccountName -> Bool
-p `isAccountNamePrefixOf` s = ((p ++ [acctsepchar] ) `isPrefixOf` s)
+isAccountNamePrefixOf = isPrefixOf . (++ [acctsepchar])
 
 isSubAccountNameOf :: AccountName -> AccountName -> Bool
 s `isSubAccountNameOf` p = 

Ledger/Amount.hs

@@ -126,12 +126,12 @@ punctuatethousands s =
 
 -- | Does this amount appear to be zero when displayed with its given precision ?
 isZeroAmount :: Amount -> Bool
-isZeroAmount a = null $ filter (`elem` "123456789") $ showAmount a
+isZeroAmount = null . filter (`elem` "123456789") . showAmount
 
 -- | Is this amount "really" zero, regardless of the display precision ?
 -- Since we are using floating point, for now just test to some high precision.
 isReallyZeroAmount :: Amount -> Bool
-isReallyZeroAmount a = null $ filter (`elem` "123456789") $ printf "%.10f" $ quantity a
+isReallyZeroAmount = null . filter (`elem` "123456789") . printf "%.10f" . quantity
 
 -- | Access a mixed amount's components.
 amounts :: MixedAmount -> [Amount]

Ledger/Dates.hs

@@ -30,7 +30,7 @@ import Ledger.Utils
 
 
 showDate :: Day -> String
-showDate d = formatTime defaultTimeLocale "%Y/%m/%d" d
+showDate = formatTime defaultTimeLocale "%Y/%m/%d"
 
 getCurrentDay :: IO Day
 getCurrentDay = do
@@ -38,7 +38,7 @@ getCurrentDay = do
     return $ localDay (zonedTimeToLocalTime t)
 
 elapsedSeconds :: Fractional a => UTCTime -> UTCTime -> a
-elapsedSeconds t1 t2 = realToFrac $ diffUTCTime t1 t2
+elapsedSeconds t1 = realToFrac . diffUTCTime t1
 
 -- | Split a DateSpan into one or more consecutive spans at the specified interval.
 splitSpan :: Interval -> DateSpan -> [DateSpan]
@@ -420,4 +420,4 @@ justdatespan rdate = do
 
 nulldatespan = DateSpan Nothing Nothing
 
-mkdatespan b e = DateSpan (Just $ parsedate b) (Just $ parsedate e)
+mkdatespan b = DateSpan (Just $ parsedate b) . Just . parsedate

Ledger/Ledger.hs

@@ -127,27 +127,27 @@ transactionsByAccount ts = m'
 --      m' = Map.insert "top" sortedts m
 
 filtertxns :: [String] -> [Transaction] -> [Transaction]
-filtertxns apats ts = filter (matchpats apats . taccount) ts
+filtertxns apats = filter (matchpats apats . taccount)
 
 -- | List a ledger's account names.
 ledgerAccountNames :: Ledger -> [AccountName]
-ledgerAccountNames l = drop 1 $ flatten $ accountnametree l
+ledgerAccountNames = drop 1 . flatten . accountnametree
 
 -- | Get the named account from a ledger.
 ledgerAccount :: Ledger -> AccountName -> Account
-ledgerAccount l a = (accountmap l) ! a
+ledgerAccount = (!) . accountmap
 
 -- | List a ledger's accounts, in tree order
 ledgerAccounts :: Ledger -> [Account]
-ledgerAccounts l = drop 1 $ flatten $ ledgerAccountTree 9999 l
+ledgerAccounts = drop 1 . flatten . ledgerAccountTree 9999
 
 -- | List a ledger's top-level accounts, in tree order
 ledgerTopAccounts :: Ledger -> [Account]
-ledgerTopAccounts l = map root $ branches $ ledgerAccountTree 9999 l
+ledgerTopAccounts = map root . branches . ledgerAccountTree 9999
 
 -- | Accounts in ledger whose name matches the pattern, in tree order.
 ledgerAccountsMatching :: [String] -> Ledger -> [Account]
-ledgerAccountsMatching pats l = filter (matchpats pats . aname) $ accounts l
+ledgerAccountsMatching pats = filter (matchpats pats . aname) . accounts
 
 -- | List a ledger account's immediate subaccounts
 ledgerSubAccounts :: Ledger -> Account -> [Account]
@@ -156,7 +156,7 @@ ledgerSubAccounts l Account{aname=a} =
 
 -- | List a ledger's "transactions", ie postings with transaction info attached.
 ledgerTransactions :: Ledger -> [Transaction]
-ledgerTransactions l = rawLedgerTransactions $ rawledger l
+ledgerTransactions = rawLedgerTransactions . rawledger
 
 -- | Get a ledger's tree of accounts to the specified depth.
 ledgerAccountTree :: Int -> Ledger -> Tree Account

Ledger/LedgerTransaction.hs

@@ -65,7 +65,7 @@ showLedgerTransaction' elide t =
       status = if ltstatus t then " *" else ""
       code = if (length $ ltcode t) > 0 then (printf " (%s)" $ ltcode t) else ""
       desc = " " ++ ltdescription t
-      showdate d = printf "%-10s" (showDate d)
+      showdate = printf "%-10s" . showDate
       showpostings ps
           | elide && length ps > 1 && isLedgerTransactionBalanced t
               = map showposting (init ps) ++ [showpostingnoamt (last ps)]

Ledger/Parse.hs

@@ -113,7 +113,7 @@ ledgerInclude = do many1 spacenonewline
                    let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n"
                    return $ do contents <- expandPath outerPos filename >>= readFileE outerPos
                                case runParser ledgerFile outerState filename contents of
-                                 Right l   -> l `catchError` (\err -> throwError $ inIncluded ++ err)
+                                 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 leftError err = return $ Left $ currentPos ++ whileReading ++ show err
@@ -376,7 +376,7 @@ ledgercode = try (do { char '(' <?> "code"; code <- anyChar `manyTill` char ')';
 ledgerpostings :: GenParser Char LedgerFileCtx [Posting]
 ledgerpostings = do
   ctx <- getState
-  let p `parses` s = isRight $ parseWithCtx ctx p s
+  let parses p = isRight . parseWithCtx ctx p
   ls <- many1 linebeginningwithspaces
   let ls' = filter (not . (ledgercommentline `parses`)) ls
   guard (not $ null ls')

Ledger/RawLedger.hs

@@ -65,7 +65,7 @@ rawLedgerAccountNames :: RawLedger -> [AccountName]
 rawLedgerAccountNames = sort . expandAccountNames . rawLedgerAccountNamesUsed
 
 rawLedgerAccountNameTree :: RawLedger -> Tree AccountName
-rawLedgerAccountNameTree l = accountNameTreeFrom $ rawLedgerAccountNames l
+rawLedgerAccountNameTree = accountNameTreeFrom . rawLedgerAccountNames
 
 -- | Remove ledger transactions we are not interested in.
 -- Keep only those which fall between the begin and end dates, and match
@@ -191,5 +191,5 @@ matchpats pats str =
       match "" = True
       match pat = containsRegex (abspat pat) str
       negateprefix = "not:"
-      isnegativepat pat = negateprefix `isPrefixOf` pat
+      isnegativepat = (negateprefix `isPrefixOf`)
       abspat pat = if isnegativepat pat then drop (length negateprefix) pat else pat

Ledger/Transaction.hs

@@ -34,7 +34,7 @@ flattenLedgerTransaction (LedgerTransaction d _ s _ desc _ ps _, n) =
     [Transaction n s d desc (paccount p) (pamount p) (ptype p) | p <- ps]
 
 accountNamesFromTransactions :: [Transaction] -> [AccountName]
-accountNamesFromTransactions ts = nub $ map taccount ts
+accountNamesFromTransactions = nub . map taccount
 
 sumTransactions :: [Transaction] -> MixedAmount
 sumTransactions = sum . map tamount

Ledger/Utils.hs

@@ -130,14 +130,14 @@ padright w s = intercalate "\n" $ map (printf (printf "%%-%ds" w)) $ lines s
 
 -- | Clip a multi-line string to the specified width and height from the top left.
 cliptopleft :: Int -> Int -> String -> String
-cliptopleft w h s = intercalate "\n" $ take h $ map (take w) $ lines s
+cliptopleft w h = intercalate "\n" . take h . map (take w) . lines
 
 -- | Clip and pad a multi-line string to fill the specified width and height.
 fitto :: Int -> Int -> String -> String
 fitto w h s = intercalate "\n" $ take h $ rows ++ repeat blankline
     where
       rows = map (fit w) $ lines s
-      fit w s = take w $ s ++ repeat ' '
+      fit w = take w . (++ repeat ' ')
       blankline = replicate w ' '
 
 -- math
@@ -236,10 +236,10 @@ tracewith f e = trace (f e) e
 -- parsing
 
 parsewith :: Parser a -> String -> Either ParseError a
-parsewith p ts = parse p "" ts
+parsewith p = parse p ""
 
 parseWithCtx :: b -> GenParser Char b a -> String -> Either ParseError a
-parseWithCtx ctx p ts = runParser p ctx "" ts
+parseWithCtx ctx p = runParser p ctx ""
 
 fromparse :: Either ParseError a -> a
 fromparse = either (\e -> error $ "parse error at "++(show e)) id
@@ -248,7 +248,7 @@ nonspace :: GenParser Char st Char
 nonspace = satisfy (not . isSpace)
 
 spacenonewline :: GenParser Char st Char
-spacenonewline = satisfy (\c -> c `elem` " \v\f\t")
+spacenonewline = satisfy (`elem` " \v\f\t")
 
 restofline :: GenParser Char st String
 restofline = anyChar `manyTill` newline

Options.hs

@@ -116,7 +116,7 @@ optsWithConstructor f opts = concatMap get opts
     where get o = if f v == o then [o] else [] where v = value o
 
 optsWithConstructors fs opts = concatMap get opts
-    where get o = if any (\f -> f == o) fs then [o] else []
+    where get o = if any (== o) fs then [o] else []
 
 optValuesForConstructor f opts = concatMap get opts
     where get o = if f v == o then [v] else [] where v = value o

Tests.hs

@@ -499,7 +499,7 @@ tests = [
 
   ,"dateSpanFromOpts" ~: do
     let todaysdate = parsedate "2008/11/26"
-    let opts `gives` spans = show (dateSpanFromOpts todaysdate opts) `is` spans
+    let gives = is . show . dateSpanFromOpts todaysdate
     [] `gives` "DateSpan Nothing Nothing"
     [Begin "2008", End "2009"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"
     [Period "in 2008"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"
@@ -519,9 +519,9 @@ tests = [
      let now = utcToLocalTime tz now'
          nowstr = showtime now
          yesterday = prevday today
-         clockin t a = TimeLogEntry In t a
+         clockin = TimeLogEntry In
-         mktime d s = LocalTime d $ fromMaybe midnight $ parseTime defaultTimeLocale "%H:%M:%S" s
+         mktime d = LocalTime d . fromMaybe midnight . parseTime defaultTimeLocale "%H:%M:%S"
-         showtime t = formatTime defaultTimeLocale "%H:%M" t
+         showtime = formatTime defaultTimeLocale "%H:%M"
          assertEntriesGiveStrings name es ss = assertEqual name ss (map ltdescription $ entriesFromTimeLogEntries now es)
 
      assertEntriesGiveStrings "started yesterday, split session at midnight"
@@ -544,7 +544,7 @@ tests = [
      ["assets","assets:cash","assets:checking","expenses","expenses:vacation"]
 
   ,"intervalFromOpts" ~: do
-    let opts `gives` interval = intervalFromOpts opts `is` interval
+    let gives = is . intervalFromOpts
     [] `gives` NoInterval
     [WeeklyOpt] `gives` Weekly
     [MonthlyOpt] `gives` Monthly
@@ -777,8 +777,8 @@ tests = [
   ,"register report with display expression" ~:
    do 
     l <- sampleledger
-    let displayexpr `gives` dates = 
+    let gives displayexpr = 
-            registerdates (showRegisterReport [Display displayexpr] [] l) `is` dates
+            (registerdates (showRegisterReport [Display displayexpr] [] l) `is`)
     "d<[2008/6/2]"  `gives` ["2008/01/01","2008/06/01"]
     "d<=[2008/6/2]" `gives` ["2008/01/01","2008/06/01","2008/06/02"]
     "d=[2008/6/2]"  `gives` ["2008/06/02"]
@@ -889,7 +889,7 @@ tests = [
       ,"                                актив:наличные                 -100            0"]
 
   ,"smart dates" ~: do
-    let str `gives` datestr = fixSmartDateStr (parsedate "2008/11/26") str `is` datestr
+    let gives = is . fixSmartDateStr (parsedate "2008/11/26")
     "1999-12-02"   `gives` "1999/12/02"
     "1999.12.02"   `gives` "1999/12/02"
     "1999/3/2"     `gives` "1999/03/02"
@@ -924,7 +924,7 @@ tests = [
 --     "next january" `gives` "2009/01/01"
 
   ,"splitSpan" ~: do
-    let (interval,span) `gives` spans = splitSpan interval span `is` spans
+    let gives (interval, span) = (splitSpan interval span `is`)
     (NoInterval,mkdatespan "2008/01/01" "2009/01/01") `gives`
      [mkdatespan "2008/01/01" "2009/01/01"]
     (Quarterly,mkdatespan "2008/01/01" "2009/01/01") `gives`
@@ -946,8 +946,8 @@ tests = [
     (map aname $ ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"]
 
   ,"summariseTransactionsInDateSpan" ~: do
-    let (b,e,tnum,depth,showempty,ts) `gives` summaryts = 
+    let gives (b,e,tnum,depth,showempty,ts) = 
-            summariseTransactionsInDateSpan (mkdatespan b e) tnum depth showempty ts `is` summaryts
+            (summariseTransactionsInDateSpan (mkdatespan b e) tnum depth showempty ts `is`)
     let ts =
             [
              nulltxn{tdescription="desc",taccount="expenses:food:groceries",tamount=Mixed [dollars 1]}

Utils.hs

@@ -47,5 +47,5 @@ readLedgerWithOpts opts args f = do
 -- | Convert a RawLedger to a canonicalised, cached and filtered Ledger
 -- based on the command-line options/arguments and a reference time.
 filterAndCacheLedgerWithOpts ::  [Opt] -> [String] -> LocalTime -> String -> RawLedger -> Ledger
-filterAndCacheLedgerWithOpts opts args t = filterAndCacheLedger (optsToFilterSpec opts args t)
+filterAndCacheLedgerWithOpts opts args = filterAndCacheLedger . optsToFilterSpec opts args
 

tools/bench.hs

@@ -92,16 +92,16 @@ data Opt = File {value::String}
 
 -- option value getters.
 fileopt :: [Opt] -> String
-fileopt opts = optValueWithDefault File "bench.tests" opts
+fileopt = optValueWithDefault File "bench.tests"
 
 precisionopt :: [Opt] -> Int
-precisionopt opts = read $ optValueWithDefault Prec "2" opts
+precisionopt = read . optValueWithDefault Prec "2"
 
 numopt :: [Opt] -> Int
-numopt opts = read $ optValueWithDefault Num "2" opts
+numopt = read . optValueWithDefault Num "2"
 
 verboseopt :: [Opt] -> Bool
-verboseopt opts = Verbose `elem` opts
+verboseopt = (Verbose `elem`)
 
 -- options utilities
 parseargs :: [String] -> ([Opt],[String])

tools/doctest.hs

@@ -70,7 +70,7 @@ splitDocTest s = (strip $ drop 1 $ strip $ head ls, unlines $ tail ls)
 doctests :: String -> [String]
 doctests s = filter isDocTest $ haddockLiterals s
     where
-      isDocTest s = (("$" `isPrefixOf`) . dropws) $ head $ lines s
+      isDocTest = (("$" `isPrefixOf`) . dropws) . head . lines
 
 -- extract haddock literal blocks from haskell source code
 haddockLiterals :: String -> [String]