hlint 1.6.18 → 1.6.19

raw patch · 14 files changed

+246/−110 lines, 14 filesdep ~haskell-src-extsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: haskell-src-exts

API changes (from Hackage documentation)

Files

• data/Default.hs +8/−5
• hlint.cabal +3/−2
• hlint.htm +15/−5
• src/CmdLine.hs +19/−7
• src/FindHints.hs +48/−0
• src/HLint.hs +39/−27
• src/HSE/All.hs +8/−1
• src/HSE/Bracket.hs +2/−0
• src/HSE/Util.hs +21/−0
• src/Hint/ListRec.hs +1/−1
• src/Hint/Match.hs +79/−43
• src/Hint/Structure.hs +1/−17
• src/Settings.hs +1/−1
• src/Test.hs +1/−1

@@ -96,10 +96,10 @@ error "Redundant if" = (if a then (if b then t else f) else f) ==> if a && b then t else f error "Redundant if" = (if x then True else y) ==> x || y where _ = notEq y False error "Redundant if" = (if x then y else False) ==> x && y where _ = notEq y True-error "Use if" = case a of {True -> t; False -> f} ==> if a then t else f-error "Use if" = case a of {False -> f; True -> t} ==> if a then t else f-error "Use if" = case a of {True -> t; _ -> f} ==> if a then t else f-error "Use if" = case a of {False -> f; _ -> t} ==> if a then t else f+warn  "Use if" = case a of {True -> t; False -> f} ==> if a then t else f+warn  "Use if" = case a of {False -> f; True -> t} ==> if a then t else f+warn  "Use if" = case a of {True -> t; _ -> f} ==> if a then t else f+warn  "Use if" = case a of {False -> f; _ -> t} ==> if a then t else f  -- ARROW @@ -237,7 +237,7 @@ {- <TEST> yes = concat . map f -- concatMap f-yes = foo . bar . concat . map f . baz . bar -- (concatMap f . baz . bar)+yes = foo . bar . concat . map f . baz . bar -- concatMap f . baz . bar yes = map f (map g x) -- map (f . g) x yes = concat.map (\x->if x==e then l' else [x]) -- concatMap (\x->if x==e then l' else [x]) yes = f x where f x = concat . map head -- concatMap head@@ -286,6 +286,9 @@ test a = foo (\x -> True) -- const True h a = flip f x (y z) -- f (y z) x h a = flip f x $ y z+yes x = case x of {True -> a ; False -> b} -- if x then a else b+yes x = case x of {False -> a ; _ -> b} -- if x then b else a+no = const . ok . toResponse $ "saved"   import Prelude \

@@ -1,7 +1,7 @@ cabal-version:      >= 1.6 build-type:         Simple name:               hlint-version:            1.6.18+version:            1.6.19 -- license is GPL v2 only license:            GPL license-file:       LICENSE@@ -37,7 +37,7 @@         base == 4.*, process, filepath, directory, mtl, containers,         hscolour == 1.16.*,         cpphs == 1.11.*,-        haskell-src-exts == 1.8.*,+        haskell-src-exts == 1.8.* && >= 1.8.1,         uniplate == 1.5.*      ghc-options:        -fno-warn-overlapping-patterns@@ -47,6 +47,7 @@         Language.Haskell.HLint     other-modules:         CmdLine+        FindHints         Hint         HLint         Settings

@@ -246,7 +246,7 @@ <h3>Ignoring hints</h3>  <p>-	Some of the hints are subjective, and some users believe they should be ignored. Some hints are applicable usually, but occasionally don't always make sense. The ignoring mechanism provides features for supressing certain hints. <!-- Ignore directives can either be written as pragmas in the file being analysed, or in the hint files. Examples of pragmas are:+	Some of the hints are subjective, and some users believe they should be ignored. Some hints are applicable usually, but occasionally don't always make sense. The ignoring mechanism provides features for supressing certain hints. Ignore directives can either be written as pragmas in the file being analysed, or in the hint files. Examples of pragmas are: </p> <ul> 	<li><tt>{-# ANN module "HLint: ignore Eta reduce" #-}</tt> - ignore all eta reduction suggestions in this module.</li>@@ -255,7 +255,7 @@ 	<li><tt>{-# ANN module "HLint: error Use concatMap" #-}</tt> - the hint to use concatMap is an error.</li> 	<li><tt>{-# ANN warn "HLint: Use concatMap" #-}</tt> - the hint to use concatMap is a warning.</li> </ul>-<p> -->+<p> 	Ignore directives can also be written in the hint files: </p> <ul>@@ -279,9 +279,19 @@ error = concat (map f x) ==> concatMap f x </pre> <p>-	The line can be read as replace <tt>concat (map <i>f</i> <i>x</i>)</tt> with <tt>concatMap <i>f</i> <i>x</i></tt>. Anything with a 1-letter variable is treated as a substitution parameter. For examples of more complex hints see the supplied hints file. In general, hints should <i>not</i> be given in point free style, as this reduces the power of the matching. Hints may start with <tt>error</tt> or <tt>warn</tt> to denote how severe they are by default.-</p><p>-	If you come up with interesting hints, please submit them. For example, some of the hints about <tt>last</tt> were supplied by Henning Thielemann.+	The line can be read as replace <tt>concat (map <i>f</i> <i>x</i>)</tt> with <tt>concatMap <i>f</i> <i>x</i></tt>. Anything with a 1-letter variable is treated as a substitution parameter. For examples of more complex hints see the supplied hints file. In general, hints should <i>not</i> be given in point free style, as this reduces the power of the matching. Hints may start with <tt>error</tt> or <tt>warn</tt> to denote how severe they are by default. If you come up with interesting hints, please submit them for inclusion.+</p>+<p>+	You can search for possible hints to add from a source file with the <tt>--find</tt> flag, for example:+</p>+<pre>+$ hlint --find=src/Utils.hs+-- hints found in src/Util.hs+warn = null (intersect a b) ==> disjoint a b+warn = dropWhile isSpace ==> ltrim+</pre>+<p>+	These hints are suitable for inclusion in a custom hint file. </p>      </body>

@@ -1,5 +1,5 @@ -module CmdLine(Cmd(..), getCmd) where+module CmdLine(Cmd(..), getCmd, exitWithHelp) where  import Control.Monad import Data.List@@ -26,6 +26,7 @@     ,cmdCpphs :: CpphsOptions        -- ^ options for cpphs     ,cmdDataDir :: FilePath          -- ^ the data directory     ,cmdEncoding :: String           -- ^ the text encoding+    ,cmdFindHints :: [FilePath]      -- ^ source files to look for hints in     }  @@ -39,6 +40,7 @@           | Ext String           | DataDir String           | Encoding String+          | FindHints FilePath             deriving Eq  @@ -52,6 +54,7 @@        ,Option "e" ["extension"] (ReqArg Ext "ext") "File extensions to search (defaults to hs and lhs)"        ,Option "u" ["utf8"] (NoArg $ Encoding "UTF-8") "Use UTF-8 text encoding"        ,Option ""  ["encoding"] (ReqArg Encoding "encoding") "Choose the text encoding"+       ,Option "f" ["find"] (ReqArg FindHints "file") "Find hints in a Haskell file"        ,Option "t" ["test"] (NoArg Test) "Run in test mode"        ,Option "d" ["datadir"] (ReqArg DataDir "dir") "Override the data directory"        ,Option ""  ["cpp-define"] (ReqArg Define "name[=value]") "CPP #define"@@ -63,7 +66,6 @@ getCmd :: [String] -> IO Cmd getCmd args = do     let (opt,files,err) = getOpt Permute opts args-    let test = Test `elem` opt     unless (null err) $         error $ unlines $ "Unrecognised arguments:" : err @@ -71,15 +73,17 @@         putStr versionText         exitWith ExitSuccess -    when (Help `elem` opt || (null files && not test)) $ do-        putStr helpText-        exitWith ExitSuccess+    when (Help `elem` opt) exitWithHelp +    let test = Test `elem` opt+     dataDir <- last $ getDataDir : [return x | DataDir x <- opt]      let exts = [x | Ext x <- opt]-    files <- concatMapM (getFile $ if null exts then ["hs","lhs"] else exts) files-    +        exts2 = if null exts then ["hs","lhs"] else exts+    files <- concatMapM (getFile exts2) files+    findHints <- concatMapM (getFile exts2) [x | FindHints x <- opt]+     let hintFiles = [x | Hints x <- opt]     hints <- mapM (getHintFile dataDir) $ hintFiles ++ ["HLint" | null hintFiles] @@ -103,11 +107,19 @@         ,cmdCpphs = cpphs         ,cmdDataDir = dataDir         ,cmdEncoding = encoding+        ,cmdFindHints = findHints         }  +exitWithHelp :: IO a+exitWithHelp = do+    putStr helpText+    exitWith ExitSuccess++ versionText :: String versionText = "HLint v" ++ showVersion version ++ ", (C) Neil Mitchell 2006-2010\n"+  helpText :: String helpText = unlines

@@ -0,0 +1,48 @@+{-# LANGUAGE PatternGuards, ViewPatterns #-}++module FindHints(findHints) where++import Control.Monad+import HSE.All+++-- find definitions in a source file, and write them to std out+findHints :: ParseFlags -> FilePath -> IO ()+findHints flags file = do+    x <- parseFile_ flags file+    let xs = concatMap (findHint $ UnQual an) $ moduleDecls x+    putStrLn $ "-- hints found in " ++ file+    when (null xs) $ putStrLn "-- no hints found"+    putStrLn $ unlines xs+++findHint :: (Name S -> QName S) -> Decl_ -> [String]+findHint qual (InstDecl _ _ _ (Just xs)) = concatMap (findHint qual) [x | InsDecl _ x <- xs]+findHint qual (PatBind _ (PVar _ name) Nothing (UnGuardedRhs _ bod) Nothing) = findExp (qual name) [] bod+findHint qual (FunBind _ [InfixMatch _ p1 name ps rhs bind]) = findHint qual $ FunBind an [Match an name (p1:ps) rhs bind]+findHint qual (FunBind _ [Match _ name ps (UnGuardedRhs _ bod) Nothing]) = findExp (qual name) [] $ Lambda an ps bod+findHint _ _ = []+++-- given a result function name, a list of variables, a body expression, give some hints+findExp :: QName S -> [String] -> Exp_ -> [String]+findExp name vs (Lambda _ ps bod) | length ps2 == length ps = findExp name (vs++ps2) bod+                                  | otherwise = []+    where ps2 = [x | PVar_ x <- map view ps]+findExp name vs Var{} = []+findExp name vs (InfixApp _ x dot y) | isDot dot = findExp name (vs++["_hlint"]) $ App an x $ Paren an $ App an y (toNamed "_hlint")++findExp name vs bod = ["warn = " ++ prettyPrint lhs ++ " ==> " ++ prettyPrint rhs]+    where+        lhs = hintParen $ transform f bod+        rhs = apps $ Var an name : map snd rep++        rep = zip vs $ map (toNamed . return) ['a'..]+        f (view -> Var_ x) | Just y <- lookup x rep = y+        f (InfixApp _ x dol y) | isDol dol = App an x (paren y)+        f x = x+++hintParen o@(InfixApp _ _ _ x) | isAnyApp x || isAtom x = o+hintParen o@App{} = o+hintParen o = paren o

@@ -13,6 +13,7 @@ import Type import Hint import Test+import FindHints import Util import Parallel import Hint.All@@ -23,36 +24,47 @@ --   of errors reported. hlint :: [String] -> IO Int hlint args = do-    Cmd{..} <- getCmd args-    if cmdTest then test cmdDataDir else do-        settings <- readSettings cmdDataDir cmdHintFiles-        let extra = [Classify Ignore x ("","") | x <- cmdIgnore]-        let apply :: FilePath -> IO [Idea]-            apply = applyHint flags (allHints settings) (filter isClassify settings ++ extra)-            flags = parseFlags{cpphs=Just cmdCpphs, encoding=cmdEncoding} -        ideas <- fmap concat $ parallel [listM' =<< apply x | x <- cmdFiles]-        let visideas = filter (\i -> cmdShowAll || rank i /= Ignore) ideas-        showItem <- if cmdColor then showANSI else return show-        mapM_ (putStrLn . showItem) visideas+    cmd@Cmd{..} <- getCmd args+    let flags = parseFlags{cpphs=Just cmdCpphs, encoding=cmdEncoding} +    if cmdTest then+        test cmdDataDir+     else if not $ null cmdFindHints then+        mapM_ (findHints flags) cmdFindHints >> return 0+     else if null cmdFiles then+        exitWithHelp+     else+        runHints cmd flags -        -- figure out statistics        -        let counts = map (head &&& length) $ group $ sort $ map rank ideas-        let [ignore,warn,err] = map (fromMaybe 0 . flip lookup counts) [Ignore,Warning,Error]-        let total = ignore + warn + err-        let shown = if cmdShowAll then total else total - ignore -        let ignored = [show i ++ " ignored" | let i = total - shown, i /= 0]-        let errors = [show err ++ " error" ++ ['s'|err/=1] | err /= 0]+runHints :: Cmd -> ParseFlags -> IO Int+runHints Cmd{..} flags = do+    settings <- readSettings cmdDataDir cmdHintFiles+    let extra = [Classify Ignore x ("","") | x <- cmdIgnore]+    let apply :: FilePath -> IO [Idea]+        apply = applyHint flags (allHints settings) (filter isClassify settings ++ extra)+    ideas <- fmap concat $ parallel [listM' =<< apply x | x <- cmdFiles]+    let visideas = filter (\i -> cmdShowAll || rank i /= Ignore) ideas+    showItem <- if cmdColor then showANSI else return show+    mapM_ (putStrLn . showItem) visideas -        if shown == 0 then do-            when (cmdReports /= []) $ putStrLn "Skipping writing reports"-            printMsg "No relevant suggestions" ignored-         else do-            forM_ cmdReports $ \x -> do-                putStrLn $ "Writing report to " ++ x ++ " ..."-                writeReport cmdDataDir x visideas-            printMsg ("Found " ++ show shown ++ " suggestion" ++ ['s'|shown/=1]) (errors++ignored)-        return err+    -- figure out statistics        +    let counts = map (head &&& length) $ group $ sort $ map rank ideas+    let [ignore,warn,err] = map (fromMaybe 0 . flip lookup counts) [Ignore,Warning,Error]+    let total = ignore + warn + err+    let shown = if cmdShowAll then total else total - ignore++    let ignored = [show i ++ " ignored" | let i = total - shown, i /= 0]+    let errors = [show err ++ " error" ++ ['s'|err/=1] | err /= 0]++    if shown == 0 then do+        when (cmdReports /= []) $ putStrLn "Skipping writing reports"+        printMsg "No relevant suggestions" ignored+     else do+        forM_ cmdReports $ \x -> do+            putStrLn $ "Writing report to " ++ x ++ " ..."+            writeReport cmdDataDir x visideas+        printMsg ("Found " ++ show shown ++ " suggestion" ++ ['s'|shown/=1]) (errors++ignored)+    return err   printMsg :: String -> [String] -> IO ()

@@ -5,7 +5,7 @@     module HSE.Type, module HSE.Eq,     module HSE.NameMatch,     ParseFlags(..), parseFlags, parseFlagsNoLocations,-    parseFile, parseString+    parseFile, parseFile_, parseString     ) where  import Util@@ -52,6 +52,13 @@ parseFile flags file = do     src <- readFileEncoding (encoding flags) file     parseString flags file src+++-- throw an error if the parse is invalid+parseFile_ :: ParseFlags -> FilePath -> IO Module_+parseFile_ flags file = do+    (_, res) <- parseFile flags file+    return $! fromParseResult res   extension = knownExtensions \\ badExtensions

@@ -43,6 +43,7 @@         EnumFromThenTo{} -> True         _ -> False +    -- note: i is the index in children, not in the AST     needBracket i parent child          | isAtom child = False         | InfixApp{} <- parent, App{} <- child = False@@ -53,6 +54,7 @@         | App{} <- parent, i == 0, App{} <- child = False         | ExpTypeSig{} <- parent, i == 0 = False         | Paren{} <- parent = False+        | isDotApp parent, isDotApp child, i == 1 = False         | otherwise = True  

@@ -89,6 +89,27 @@ unqual (Qual an _ x) = UnQual an x unqual x = x ++isDol :: QOp S -> Bool+isDol (QVarOp _ (UnQual _ (Symbol _ "$"))) = True+isDol _ = False++isDot :: QOp S -> Bool+isDot (QVarOp _ (UnQual _ (Symbol _ "."))) = True+isDot _ = False++isDotApp :: Exp_ -> Bool+isDotApp (InfixApp _ _ dot _) | isDot dot = True+isDotApp _ = False++dotApp :: Exp_ -> Exp_ -> Exp_+dotApp x = InfixApp an x (QVarOp an $ UnQual an $ Symbol an ".")++dotApps :: [Exp_] -> Exp_+dotApps [x] = x+dotApps (x:xs) = dotApp x (dotApps xs)++ --------------------------------------------------------------------- -- HSE FUNCTIONS 

@@ -78,7 +78,7 @@         [toNamed "map", niceLambda [x] lhs, toNamed xs]      | [] <- vs, App2 op lhs rhs <- view cons-    , null $ vars op `intersect` [x,xs]+    , vars op `disjoint` [x,xs]     , fromParen rhs == recursive, xs `notElem` vars lhs     = Just $ (,,) "foldr" Warning $ appsBracket         [toNamed "foldr", niceLambda [x] $ appsBracket [op,lhs], nil, toNamed xs]

@@ -1,10 +1,34 @@ {-# LANGUAGE PatternGuards, ViewPatterns #-}  {--Supported meta-hints:+The matching does a fairly simple unification between the two terms, treating+any single letter variable on the left as a free variable. After the matching+we substitute, transform and check the side conditions. We also "see through"+both ($) and (.) functions on the right. +TRANSFORM PATTERNS _eval_ - perform deep evaluation, must be used at the top of a RHS _noParen_ - don't bracket this particular item++SIDE CONDITIONS+(&&), (||), not - boolean connectives+isAtom x - does x never need brackets+isFoo x - is the root constructor of x a "Foo"+notEq x y - are x and y not equal+notIn xs ys - are all x variables not in ys expressions+notTypeSafe - no semantics, a hint for testing only++($) AND (.)+We see through ($) simply by expanding it if nothing else matches.+We see through (.) by translating rules that have (.) equivalents+to separate rules. For example:++concat (map f x) ==> concatMap f x+-- we spot both these rules can eta reduce with respect to x+concat . map f ==> concatMap f+-- we use the associativity of (.) to add+concat . map f . x ==> concatMap f . x+-- currently 36 of 169 rules have (.) equivalents -}  module Hint.Match(readMatch) where@@ -15,19 +39,42 @@ import Hint import HSE.All import Control.Monad+import Control.Arrow import Data.Function import Util  ------------------------------------------------------------------------- PERFORM MATCHING- fmapAn = fmap (const an) ++---------------------------------------------------------------------+-- READ THE RULE+ readMatch :: [Setting] -> DeclHint-readMatch settings = findIdeas [m{lhs = fmapAn $ lhs m, side = fmap fmapAn $ side m} | m@MatchExp{} <- settings]+readMatch settings = findIdeas (concatMap readRule settings)  +readRule :: Setting -> [Setting]+readRule m@MatchExp{lhs=(fmapAn -> lhs), rhs=(fmapAn -> rhs), side=(fmap fmapAn -> side)} =+    (:) m{lhs=lhs,side=side,rhs=rhs} $ fromMaybe [] $ do+        (l,v1) <- dotVersion lhs+        (r,v2) <- dotVersion rhs+        guard $ v1 == v2 && l /= [] && r /= [] && v1 `notElem` vars side+        return [m{lhs=dotApps l, rhs=dotApps r, side=side}+               ,m{lhs=dotApps (l++[toNamed v1]), rhs=dotApps (r++[toNamed v1]), side=side}]+readRule _ = []+++-- find a dot version of this rule, return the sequence of app prefixes, and the var+dotVersion :: Exp_ -> Maybe ([Exp_], String)+dotVersion (view -> Var_ v) | isUnifyVar v = Just ([], v)+dotVersion (fromApps -> xs) | length xs > 1 = fmap (first (apps (init xs) :)) $ dotVersion (fromParen $ last xs)+dotVersion _ = Nothing+++---------------------------------------------------------------------+-- PERFORM THE MATCHING+ findIdeas :: [Setting] -> NameMatch -> Module S -> Decl_ -> [Idea] findIdeas matches nm _ decl =   [ idea (rankS m) (hintS m) x y@@ -39,16 +86,17 @@ matchIdea nm decl MatchExp{lhs=lhs,rhs=rhs,side=side} parent x = do     u <- unify nm lhs x     u <- check u-    let sub = subst u rhs-    guard $ checkDot lhs sub-    let res = addBracket parent $ unqualify nm $ dotContract $ performEval sub+    let res = addBracket parent $ unqualify nm $ performEval $ subst u rhs     guard $ checkSide side $ ("original",x) : ("result",res) : u     guard $ checkDefine decl parent res     return res  +---------------------------------------------------------------------+-- UNIFICATION+ -- unify a b = c, a[c] = b--- note: App is unrolled because it's really common+-- note: App is unrolled because it's really common (performance reasons) unify :: NameMatch -> Exp_ -> Exp_ -> Maybe [(String,Exp_)] unify nm (Do _ xs) (Do _ ys) | length xs == length ys = concatZipWithM (unifyStmt nm) xs ys unify nm (Lambda _ xs x) (Lambda _ ys y) | length xs == length ys = liftM2 (++) (unify nm x y) (concatZipWithM unifyPat xs ys)@@ -57,10 +105,9 @@ unify nm (Var _ x) (Var _ y) | nm x y = Just [] unify nm (App _ x1 x2) (App _ y1 y2) = liftM2 (++) (unify nm x1 y1) (unify nm x2 y2) unify nm x y | isOther x && isOther y && eqExpShell x y = concatZipWithM (unify nm) (children x) (children y)-unify nm x o@(view -> App2 op y1 y2)-  | op ~= "$" = unify nm x $ App an y1 y2-  | op ~= "." = unify nm x $ dotExpand o-unify nm x (InfixApp _ lhs op rhs) = unify nm x $ App an (App an (opExp op) lhs) rhs+unify nm x (InfixApp _ lhs op rhs)+    | isDol op = unify nm x $ App an lhs rhs+    | otherwise = unify nm x $ App an (App an (opExp op) lhs) rhs unify nm _ _ = Nothing  -- types that are not already handled in unify@@ -85,12 +132,29 @@ unifyPat _ _ = Nothing  +---------------------------------------------------------------------+-- SUBSTITUTION UTILITIES+ -- check the unification is valid check :: [(String,Exp_)] -> Maybe [(String,Exp_)] check = mapM f . groupSortFst     where f (x,ys) = if length (nub ys) == 1 then Just (x,head ys) else Nothing  +-- perform a substitution+subst :: [(String,Exp_)] -> Exp_ -> Exp_+subst bind = transform g . transformBracket f+    where+        f (Var _ (fromNamed -> x)) | isUnifyVar x = lookup x bind+        f _ = Nothing++        g (App _ np (Paren _ x)) | np ~= "_noParen_" = x+        g x = x+++---------------------------------------------------------------------+-- SIDE CONDITIONS+ checkSide :: Maybe Exp_ -> [(String,Exp_)] -> Bool checkSide x bind = maybe True f x     where@@ -119,42 +183,14 @@                   f x = x  --- If they have have a lambda in the pattern--- don't allow dot contraction to happen, as it's usually wrong-checkDot :: Exp_ -> Exp_ -> Bool-checkDot lhs rhs2 = not $ any isLambda (universeS lhs) && toNamed "?" `elem` universe rhs2-- -- does the result look very much like the declaration checkDefine :: Decl_ -> Maybe (Int, Exp_) -> Exp_ -> Bool checkDefine x Nothing y = fromNamed x /= fromNamed (transformBi unqual $ head $ fromApps y) checkDefine _ _ _ = True  --- perform a substitution-subst :: [(String,Exp_)] -> Exp_ -> Exp_-subst bind = transform g . transformBracket f-    where-        f (Var _ (fromNamed -> x)) | isUnifyVar x = lookup x bind-        f _ = Nothing--        g (App _ np (Paren _ x)) | np ~= "_noParen_" = x-        g x = x---dotExpand :: Exp_ -> Exp_-dotExpand (view -> App2 op x1 x2) | op ~= "." = ensureBracket1 $ App an x1 (dotExpand x2)-dotExpand x = ensureBracket1 $ App an x (toNamed "?")----- simplify, removing any introduced ? vars, from expanding (.)-dotContract :: Exp_ -> Exp_-dotContract x = fromMaybe x (f x)-    where-        f x | isParen x = f $ fromParen x-        f (App _ x y) | "?" <- fromNamed y = Just x-                      | Just z <- f y = Just $ InfixApp an x (toNamed ".") z-        f _ = Nothing+---------------------------------------------------------------------+-- TRANSFORMATION  -- if it has _eval_ do evaluation on it performEval :: Exp_ -> Exp_

@@ -6,8 +6,6 @@ <TEST> yes x y = if a then b else if c then d else e -- yes x y ; | a = b ; | c = d ; | otherwise = e no x y = if a then b else c-yes x = case x of {True -> a ; False -> b} -- if x then a else b-yes x = case x of {False -> a ; _ -> b} -- if x then b else a foo b | c <- f b = c -- foo (f -> c) = c foo x y b z | c:cs <- f g b = c -- foo x y (f g -> c:cs) z = c foo b | c <- f b = c + b@@ -29,8 +27,7 @@   structureHint :: DeclHint-structureHint _ _ x = concat [concatMap useGuards xs | FunBind _ xs <- [x]] ++-                      concatMap useIf (universeBi x)+structureHint _ _ x = concat [concatMap useGuards xs | FunBind _ xs <- [x]]   useGuards :: Match S -> [Idea]@@ -56,16 +53,3 @@ asGuards (Paren _ x) = asGuards x asGuards (If _ a b c) = GuardedRhs an [Qualifier an a] b : asGuards c asGuards x = [GuardedRhs an [Qualifier an $ toNamed "otherwise"] x]---useIf :: Exp_ -> [Idea]-useIf x@(Case _ on [simpAlt -> Just (as,av), simpAlt -> Just (bs,bv)])-    | as == "True"  && bs `elem` ["False","_"] = iff av bv-    | as == "False" && bs `elem` ["True" ,"_"] = iff bv av-    where-        iff t f = [warn "Use if" x (If an on t f)]-useIf _ = []--simpAlt (Alt _ p (UnGuardedAlt _ x) Nothing) = Just (prettyPrint p, x)-simpAlt _ = Nothing-

@@ -23,7 +23,7 @@ -- currently it doesn't readHints :: FilePath -> FilePath -> IO [Either String Module_] readHints dataDir file = do-    y <- (fromParseResult . snd) `fmap` parseFile parseFlags{implies=True} file+    y <- parseFile_ parseFlags{implies=True} file     ys <- concatMapM (f . fromNamed . importModule) $ moduleImports y     return $ Right y:ys     where

@@ -1,6 +1,6 @@ {-# LANGUAGE PatternGuards #-} -module Test where+module Test(test) where  import Control.Arrow import Control.Exception