From b1976931979d8b40d135e8bfc7f66b76873c219a Mon Sep 17 00:00:00 2001 From: "marko.kocic" Date: Tue, 22 Sep 2009 16:51:27 +0000 Subject: [PATCH] Hlint: Warning: Redundant brackets --- Commands/Add.hs | 6 +++--- Commands/Convert.hs | 2 +- Commands/Stats.hs | 6 +++--- Commands/UI.hs | 2 +- Ledger/Amount.hs | 4 ++-- Ledger/Dates.hs | 4 ++-- Ledger/LedgerTransaction.hs | 8 ++++---- Ledger/Parse.hs | 2 +- Ledger/RawLedger.hs | 12 ++++++------ Ledger/Utils.hs | 2 +- Options.hs | 8 ++++---- Setup.hs | 2 +- Tests.hs | 18 +++++++++--------- tools/bench.hs | 2 +- tools/generateledger.hs | 2 +- tools/listbydeps.hs | 2 +- tools/simplifyprof.hs | 2 +- 17 files changed, 42 insertions(+), 42 deletions(-) diff --git a/Commands/Add.hs b/Commands/Add.hs index bb1e27500..cbaefa087 100644 --- a/Commands/Add.hs +++ b/Commands/Add.hs @@ -111,7 +111,7 @@ getPostings historicalps enteredps = do -- input is valid. May also raise an EOF exception if control-d is pressed. askFor :: String -> Maybe String -> Maybe (String -> Bool) -> IO String askFor prompt def validator = do - hPutStr stderr $ prompt ++ (maybe "" showdef def) ++ ": " + hPutStr stderr $ prompt ++ maybe "" showdef def ++ ": " hFlush stderr l <- getLine let input = if null l then fromMaybe l def else l @@ -166,14 +166,14 @@ compareStrings "" "" = 1 compareStrings (_:[]) "" = 0 compareStrings "" (_:[]) = 0 compareStrings (a:[]) (b:[]) = if toUpper a == toUpper b then 1 else 0 -compareStrings s1 s2 = 2.0 * (fromIntegral i) / (fromIntegral u) +compareStrings s1 s2 = 2.0 * fromIntegral i / fromIntegral u where i = length $ intersect pairs1 pairs2 u = length pairs1 + length pairs2 pairs1 = wordLetterPairs $ uppercase s1 pairs2 = wordLetterPairs $ uppercase s2 wordLetterPairs = concatMap letterPairs . words -letterPairs (a:b:rest) = [a,b]:(letterPairs (b:rest)) +letterPairs (a:b:rest) = [a,b] : letterPairs (b:rest) letterPairs _ = [] compareLedgerDescriptions s t = compareStrings s' t' diff --git a/Commands/Convert.hs b/Commands/Convert.hs index 41358a80e..067f5e164 100644 --- a/Commands/Convert.hs +++ b/Commands/Convert.hs @@ -70,7 +70,7 @@ print_ledger_txn debug (baseacct,fieldpositions,rules) csvrecord unknownacct | (readDef 0 amount' :: Double) < 0 = "income:unknown" | otherwise = "expenses:unknown" (acct,desc) = choose_acct_desc rules (unknownacct,description) - when (debug) $ hPutStrLn stderr $ printf "using %s for %s" desc description + when debug $ hPutStrLn stderr $ printf "using %s for %s" desc description printf "%s%s %s\n" (fixdate date) (if not (null number) then printf " (%s)" number else "") desc printf " %-30s %15s\n" acct (printf "$%s" amount' :: String) printf " %s\n\n" baseacct diff --git a/Commands/Stats.hs b/Commands/Stats.hs index 9d087463f..03d8d71ab 100644 --- a/Commands/Stats.hs +++ b/Commands/Stats.hs @@ -23,7 +23,7 @@ showStats _ _ l today = 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" + fmt = "%-" ++ show w1 ++ "s: %-" ++ show w2 ++ "s" w1 = maximum $ map (length . fst) stats w2 = maximum $ map (length . show . snd) stats stats = [ @@ -57,9 +57,9 @@ showStats _ _ l today = txnrate | days==0 = 0 | otherwise = fromIntegral tnum / fromIntegral days :: Double tnum30 = length $ filter withinlast30 ts - withinlast30 t = (d>=(addDays (-30) today) && (d<=today)) where d = ltdate t + withinlast30 t = d >= addDays (-30) today && (d<=today) where d = ltdate t txnrate30 = fromIntegral tnum30 / 30 :: Double tnum7 = length $ filter withinlast7 ts - withinlast7 t = (d>=(addDays (-7) today) && (d<=today)) where d = ltdate t + withinlast7 t = d >= addDays (-7) today && (d<=today) where d = ltdate t txnrate7 = fromIntegral tnum7 / 7 :: Double diff --git a/Commands/UI.hs b/Commands/UI.hs index 71a214857..9cc8cac38 100644 --- a/Commands/UI.hs +++ b/Commands/UI.hs @@ -311,7 +311,7 @@ renderScreen (a@AppState{aw=w,ah=h,abuf=buf,amsg=msg}) = -- trying for more speed mainimg = vert_cat (map (string defaultattr) above) <-> - (string currentlineattr thisline) + string currentlineattr thisline <-> vert_cat (map (string defaultattr) below) (thisline,below) | null rest = (blankline,[]) diff --git a/Ledger/Amount.hs b/Ledger/Amount.hs index 5197720f3..59a15164c 100644 --- a/Ledger/Amount.hs +++ b/Ledger/Amount.hs @@ -116,7 +116,7 @@ showAmount' (Amount (Commodity {comma=comma,precision=p}) q _) = quantity -- | Add thousands-separating commas to a decimal number string punctuatethousands :: String -> String punctuatethousands s = - sign ++ (addcommas int) ++ frac + sign ++ addcommas int ++ frac where (sign,num) = break isDigit s (int,frac) = break (=='.') num @@ -206,5 +206,5 @@ nullmixedamt = Mixed [] -- | A temporary value for parsed transactions which had no amount specified. missingamt :: MixedAmount -missingamt = Mixed [Amount (Commodity {symbol="AUTO",side=L,spaced=False,comma=False,precision=0}) 0 Nothing] +missingamt = Mixed [Amount Commodity {symbol="AUTO",side=L,spaced=False,comma=False,precision=0} 0 Nothing] diff --git a/Ledger/Dates.hs b/Ledger/Dates.hs index af887ae47..919205f0d 100644 --- a/Ledger/Dates.hs +++ b/Ledger/Dates.hs @@ -303,8 +303,8 @@ monthabbrevs = ["jan","feb","mar","apr","may","jun","jul","aug","sep","oct","n weekdays = ["monday","tuesday","wednesday","thursday","friday","saturday","sunday"] weekdayabbrevs = ["mon","tue","wed","thu","fri","sat","sun"] -monthIndex s = maybe 0 (+1) $ (lowercase s) `elemIndex` months -monIndex s = maybe 0 (+1) $ (lowercase s) `elemIndex` monthabbrevs +monthIndex s = maybe 0 (+1) $ lowercase s `elemIndex` months +monIndex s = maybe 0 (+1) $ lowercase s `elemIndex` monthabbrevs month :: GenParser Char st SmartDate month = do diff --git a/Ledger/LedgerTransaction.hs b/Ledger/LedgerTransaction.hs index 3ec4adab7..802a83893 100644 --- a/Ledger/LedgerTransaction.hs +++ b/Ledger/LedgerTransaction.hs @@ -17,10 +17,10 @@ import Ledger.Amount instance Show LedgerTransaction where show = showLedgerTransaction instance Show ModifierTransaction where - show t = "= " ++ (mtvalueexpr t) ++ "\n" ++ unlines (map show (mtpostings t)) + show t = "= " ++ mtvalueexpr t ++ "\n" ++ unlines (map show (mtpostings t)) instance Show PeriodicTransaction where - show t = "~ " ++ (ptperiodicexpr t) ++ "\n" ++ unlines (map show (ptpostings t)) + show t = "~ " ++ ptperiodicexpr t ++ "\n" ++ unlines (map show (ptpostings t)) nullledgertxn :: LedgerTransaction nullledgertxn = LedgerTransaction { @@ -67,7 +67,7 @@ showLedgerTransaction' elide effective t = 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 @@ -81,7 +81,7 @@ showLedgerTransaction' elide effective t = 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 "" + showcomment s = if length s > 0 then " ; "++s else "" showstatus p = if pstatus p then "* " else "" -- | Show an account name, clipped to the given width if any, and diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs index 4e316b8ba..8ea27233f 100644 --- a/Ledger/Parse.hs +++ b/Ledger/Parse.hs @@ -74,7 +74,7 @@ parseLedgerFile t f = liftIO (readFile f) >>= parseLedger t f parseLedger :: LocalTime -> FilePath -> String -> ErrorT String IO RawLedger parseLedger reftime inname intxt = case runParser ledgerFile emptyCtx inname intxt of - Right m -> liftM (rawLedgerConvertTimeLog reftime) $ m `ap` (return rawLedgerEmpty) + Right m -> liftM (rawLedgerConvertTimeLog reftime) $ m `ap` return rawLedgerEmpty Left err -> throwError $ show err diff --git a/Ledger/RawLedger.hs b/Ledger/RawLedger.hs index 642dd4757..6781d592e 100644 --- a/Ledger/RawLedger.hs +++ b/Ledger/RawLedger.hs @@ -40,19 +40,19 @@ rawLedgerEmpty = RawLedger { modifier_txns = [] } addLedgerTransaction :: LedgerTransaction -> RawLedger -> RawLedger -addLedgerTransaction t l0 = l0 { ledger_txns = t : (ledger_txns l0) } +addLedgerTransaction t l0 = l0 { ledger_txns = t : ledger_txns l0 } addModifierTransaction :: ModifierTransaction -> RawLedger -> RawLedger -addModifierTransaction mt l0 = l0 { modifier_txns = mt : (modifier_txns l0) } +addModifierTransaction mt l0 = l0 { modifier_txns = mt : modifier_txns l0 } addPeriodicTransaction :: PeriodicTransaction -> RawLedger -> RawLedger -addPeriodicTransaction pt l0 = l0 { periodic_txns = pt : (periodic_txns l0) } +addPeriodicTransaction pt l0 = l0 { periodic_txns = pt : periodic_txns l0 } addHistoricalPrice :: HistoricalPrice -> RawLedger -> RawLedger -addHistoricalPrice h l0 = l0 { historical_prices = h : (historical_prices l0) } +addHistoricalPrice h l0 = l0 { historical_prices = h : historical_prices l0 } addTimeLogEntry :: TimeLogEntry -> RawLedger -> RawLedger -addTimeLogEntry tle l0 = l0 { open_timelog_entries = tle : (open_timelog_entries l0) } +addTimeLogEntry tle l0 = l0 { open_timelog_entries = tle : open_timelog_entries l0 } rawLedgerTransactions :: RawLedger -> [Transaction] rawLedgerTransactions = txnsof . ledger_txns @@ -90,7 +90,7 @@ filterRawLedgerTransactionsByDate :: DateSpan -> RawLedger -> RawLedger filterRawLedgerTransactionsByDate (DateSpan begin end) (RawLedger ms ps ts tls hs f fp) = RawLedger ms ps (filter matchdate ts) tls hs f fp where - matchdate t = (maybe True (ltdate t>=) begin) && (maybe True (ltdate t<) end) + matchdate t = maybe True (ltdate t>=) begin && maybe True (ltdate t<) end -- | Keep only ledger transactions which have the requested -- cleared/uncleared status, if there is one. diff --git a/Ledger/Utils.hs b/Ledger/Utils.hs index a4091aff0..1263d613d 100644 --- a/Ledger/Utils.hs +++ b/Ledger/Utils.hs @@ -242,7 +242,7 @@ parseWithCtx :: b -> GenParser Char b a -> String -> Either ParseError a parseWithCtx ctx p = runParser p ctx "" fromparse :: Either ParseError a -> a -fromparse = either (\e -> error $ "parse error at "++(show e)) id +fromparse = either (\e -> error $ "parse error at "++ show e) id nonspace :: GenParser Char st Char nonspace = satisfy (not . isSpace) diff --git a/Options.hs b/Options.hs index dc54565be..f35e2c95c 100644 --- a/Options.hs +++ b/Options.hs @@ -17,7 +17,7 @@ import Control.Monad (liftM) progname = "hledger" timeprogname = "hours" -usagehdr = ( +usagehdr = "Usage: hledger [OPTIONS] [COMMAND [PATTERNS]]\n" ++ " hours [OPTIONS] [COMMAND [PATTERNS]]\n" ++ " hledger convert CSVFILE ACCOUNTNAME RULESFILE\n" ++ @@ -48,7 +48,7 @@ usagehdr = ( "DATES can be y/m/d or ledger-style smart dates like \"last month\".\n" ++ "\n" ++ "Options:" - ) + usageftr = "" usage = usageInfo usagehdr options ++ usageftr @@ -134,7 +134,7 @@ parseArguments = do -- istimequery <- usingTimeProgramName -- let os' = if istimequery then (Period "today"):os else os os' <- fixOptDates os - let os'' = if Debug `elem` os' then (Verbose:os') else os' + let os'' = if Debug `elem` os' then Verbose:os' else os' case (as,es) of (cmd:args,[]) -> return (os'',cmd,args) ([],[]) -> return (os'',"",[]) @@ -216,7 +216,7 @@ ledgerFilePathFromOpts :: [Opt] -> IO String ledgerFilePathFromOpts opts = do istimequery <- usingTimeProgramName f <- if istimequery then myTimelogPath else myLedgerPath - return $ last $ f:(optValuesForConstructor File opts) + return $ last $ f : optValuesForConstructor File opts -- | Gather filter pattern arguments into a list of account patterns and a -- list of description patterns. We interpret pattern arguments as diff --git a/Setup.hs b/Setup.hs index 3bfddb58e..1959ebc82 100644 --- a/Setup.hs +++ b/Setup.hs @@ -9,4 +9,4 @@ main = defaultMainWithHooks $ simpleUserHooks{runTests=runTests'} runTests' :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO () runTests' _ _ _ lbi = system testprog >> return () - where testprog = (buildDir lbi) "hledger" "hledger test" + where testprog = buildDir lbi "hledger" "hledger test" diff --git a/Tests.hs b/Tests.hs index b6d4a48e4..f69f985d6 100644 --- a/Tests.hs +++ b/Tests.hs @@ -216,8 +216,8 @@ runtests opts args = do then exitFailure else exitWith ExitSuccess where - runner | (Verbose `elem` opts) = runVerboseTests - | otherwise = \t -> runTestTT t >>= return . (flip (,) 0) + runner | Verbose `elem` opts = runVerboseTests + | otherwise = \t -> runTestTT t >>= return . flip (,) 0 ts = TestList $ filter matchname $ concatMap tflatten tests --ts = tfilter matchname $ TestList tests -- unflattened matchname = matchpats args . tname @@ -305,9 +305,9 @@ tests = [ (a1 + a3) `is` Amount (comm "$") 0 Nothing (a2 + a3) `is` Amount (comm "$") (-2.46) Nothing (a3 + a3) `is` Amount (comm "$") (-2.46) Nothing - (sum [a2,a3]) `is` Amount (comm "$") (-2.46) Nothing - (sum [a3,a3]) `is` Amount (comm "$") (-2.46) Nothing - (sum [a1,a2,a3,-a3]) `is` Amount (comm "$") 0 Nothing + sum [a2,a3] `is` Amount (comm "$") (-2.46) Nothing + sum [a3,a3] `is` Amount (comm "$") (-2.46) Nothing + sum [a1,a2,a3,-a3] `is` Amount (comm "$") 0 Nothing ,"balance report tests" ~: let (opts,args) `gives` es = do @@ -983,7 +983,7 @@ tests = [ ,"postingamount" ~: do parseWithCtx emptyCtx postingamount " $47.18" `parseis` Mixed [dollars 47.18] parseWithCtx emptyCtx postingamount " $1." `parseis` - Mixed [Amount (Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0}) 1 Nothing] + Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} 1 Nothing] ] @@ -1061,9 +1061,9 @@ entry1_str = unlines ] entry1 = - (LedgerTransaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" + LedgerTransaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting, - Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting] "") + Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting] "" entry2_str = unlines @@ -1390,7 +1390,7 @@ price1 = HistoricalPrice (parsedate "2004/05/01") "XYZ" "$" 55 a1 = Mixed [(hours 1){price=Just $ Mixed [Amount (comm "$") 10 Nothing]}] a2 = Mixed [(hours 2){price=Just $ Mixed [Amount (comm "EUR") 10 Nothing]}] -a3 = Mixed $ (amounts a1) ++ (amounts a2) +a3 = Mixed $ amounts a1 ++ amounts a2 rawLedgerWithAmounts :: [String] -> RawLedger rawLedgerWithAmounts as = diff --git a/tools/bench.hs b/tools/bench.hs index 2beab6c74..712c6b727 100644 --- a/tools/bench.hs +++ b/tools/bench.hs @@ -170,7 +170,7 @@ maketable opts rownames colnames results = Table rowhdrs colhdrs rows where rowhdrs = Group NoLine $ map Header $ padright rownames colhdrs = Group SingleLine $ map Header colnames - rows = map (map ((showtime opts) . minimum)) results + rows = map (map (showtime opts . minimum)) results padright ss = map (printf (printf "%%-%ds" w)) ss where w = maximum $ map length ss diff --git a/tools/generateledger.hs b/tools/generateledger.hs index f1eddfde5..b578c797d 100644 --- a/tools/generateledger.hs +++ b/tools/generateledger.hs @@ -50,7 +50,7 @@ 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)) +pair (a:b:rest) = (a,b):pair rest getCurrentDay :: IO Day getCurrentDay = do diff --git a/tools/listbydeps.hs b/tools/listbydeps.hs index 62642b9e2..c913a6bb2 100644 --- a/tools/listbydeps.hs +++ b/tools/listbydeps.hs @@ -13,7 +13,7 @@ import Data.Ord that it imports. -} findDeps base pkg = do - let hi = base ++ (map dotToSlash pkg) ++ ".hs" + let hi = base ++ map dotToSlash pkg ++ ".hs" ex <- doesFileExist hi if not ex then return [] else do src <- readFile hi diff --git a/tools/simplifyprof.hs b/tools/simplifyprof.hs index 71d8c27e5..15ddd7639 100644 --- a/tools/simplifyprof.hs +++ b/tools/simplifyprof.hs @@ -17,7 +17,7 @@ main = do putStr $ unlines firstpart 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" + let fmt = "%-" ++ show maxnamelen ++ "s %10s %5s %6s %9s %10s" putStrLn $ showheading fmt putStr $ unlines $ map (format fmt) fields