diff --git a/data/Default.hs b/data/Default.hs --- a/data/Default.hs +++ b/data/Default.hs @@ -226,7 +226,6 @@ yes = concat . map f . g -- concatMap f . g yes = concat $ map f x -- concatMap f x yes = "test" ++ concatMap (' ':) ["of","this"] -- unwords ("test":["of","this"]) -yes = concat . intersperse " " -- unwords yes = if f a then True else b -- f a || b yes = not (a == b) -- a /= b yes = not (a /= b) -- a == b @@ -258,6 +257,9 @@ no = \x -> f x (g x) yes = \x -> f x (g y) -- flip f (g y) no = foo (\ v -> f v . g) +yes = concat . intersperse " " -- unwords +yes = Prelude.concat $ intersperse " " xs -- unwords xs +yes = concat $ Data.List.intersperse " " xs -- unwords xs import Prelude \ yes = flip mapM -- Control.Monad.forM diff --git a/data/Test.hs b/data/Test.hs --- a/data/Test.hs +++ b/data/Test.hs @@ -9,6 +9,17 @@ error = (x :: Int) ==> (x :: Int32) where _ = notTypeSafe + +error "Test1" = map ==> map +error "Test2" = filter ==> filter +error "Test3" = foldr ==> foldr + +ignore "Test1" = "" +ignore "Test3" +ignore "Test2" = ignoreTest +warn = ignoreTest3 + + {- main = readFile "foo" >>= putStr \ @@ -23,5 +34,12 @@ -- bad yes = 32 :: Int -- 32 :: Int32 + +ignoreTest = filter -- @Ignore ??? +ignoreTest2 = filter -- @Error ??? +ignoreTest3 = filter -- @Warning ??? +ignoreAny = map -- @Ignore ??? +ignoreNew = foldr -- @Ignore ??? + -} diff --git a/data/hlint.ghci b/data/hlint.ghci --- a/data/hlint.ghci +++ b/data/hlint.ghci @@ -1,10 +1,31 @@ -- -*- mode: haskell; -*- -- Begin copied material. -- -let { redir varcmd = case break Data.Char.isSpace varcmd of { (var,_:cmd) -> return $ unlines [":set -fno-print-bind-result","tmp <- System.Directory.getTemporaryDirectory","(f,h) <- System.IO.openTempFile tmp \"ghci\"","sto <- GHC.Handle.hDuplicate System.IO.stdout","GHC.Handle.hDuplicateTo h System.IO.stdout","System.IO.hClose h",cmd,"GHC.Handle.hDuplicateTo sto System.IO.stdout","let readFileNow f = readFile f >>= \\t->length t `seq` return t",var++" <- readFileNow f","System.Directory.removeFile f"]; _ -> return "putStrLn \"usage: :redir \"" } } -:def redir redir --- End copied material +:{ +let redir varcmd = case break Data.Char.isSpace varcmd of + (var,_:cmd) -> return $ unlines [":set -fno-print-bind-result", + "tmp <- System.Directory.getTemporaryDirectory", + "(f,h) <- System.IO.openTempFile tmp \"ghci\"", + "sto <- GHC.Handle.hDuplicate System.IO.stdout", + "GHC.Handle.hDuplicateTo h System.IO.stdout", + "System.IO.hClose h", + cmd, + "GHC.Handle.hDuplicateTo sto System.IO.stdout", + "let readFileNow f = readFile f >>= + \\t->Data.List.length t `seq` return t", + var++" <- readFileNow f", + "System.Directory.removeFile f"] + _ -> return "putStrLn \"usage: :redir \"" +:def redir cmdHelp redir ":redir \t-- execute , redirecting stdout to " +:} --- Integration with the hlint code style tool -let hlint _ = return $ unlines [":set -w", ":redir hlintvar1 :show modules", ":cmd return (\":! hlint \" ++ (concat $ Data.List.intersperse \" \" (map (fst . break (==',') . drop 2 . snd . break (== '(')) $ lines hlintvar1)))", ":set -Wall"] -:def hlint hlint +:{ +:def hlint const $ return $ unlines [":unset +t +s", + ":set -w", + ":redir hlintvar1 :show modules", + ":cmd return (\":! hlint \" ++ (concat $ Data.List.intersperse \" \" + (map (fst . break (==',') . Data.List.drop 2 . snd . + break (== '(')) $ lines hlintvar1)))", + ":set +t +s -Wall"] +:} diff --git a/hlint.cabal b/hlint.cabal --- a/hlint.cabal +++ b/hlint.cabal @@ -1,7 +1,7 @@ cabal-version: >= 1.6 build-type: Simple name: hlint -version: 1.6.15 +version: 1.6.16 -- license is GPL v2 only license: GPL license-file: LICENSE @@ -34,11 +34,11 @@ library build-depends: - base == 4.*, process, filepath, directory, mtl, containers, syb, + base == 4.*, process, filepath, directory, mtl, containers, hscolour >= 1.15, cpphs >= 1.9, haskell-src-exts == 1.6.*, - uniplate == 1.4.* + uniplate == 1.5.* ghc-options: -fno-warn-overlapping-patterns @@ -57,11 +57,12 @@ Parallel HSE.All HSE.Bracket + HSE.Eq HSE.Evaluate - HSE.Generics HSE.Match - HSE.Util HSE.NameMatch + HSE.Type + HSE.Util Hint.All Hint.Bracket Hint.Extensions diff --git a/hlint.htm b/hlint.htm --- a/hlint.htm +++ b/hlint.htm @@ -260,12 +260,12 @@ 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 are picked up from the hint files. Some example directives are:

    -
  • ignore "Eta reduce" = "" - supress all eta reduction suggestions.
    • +
  • ignore "Eta reduce" - supress all eta reduction suggestions.
  • ignore "Eta reduce" = Data.List Prelude - supress eta reduction hints in the Prelude and Data.List modules.
  • ignore = Data.List.map - don't give any hints in the function Data.List.map.
  • error = Data.List.map - any hint in the function is an error.
    • -
  • error "Use concatMap" = "" - the hint to use concatMap is an error.
    • -
  • warn "Use concatMap" = "" - the hint to use concatMap is a warning.
    • +
  • error "Use concatMap" - the hint to use concatMap is an error.
    • +
  • warn "Use concatMap" - the hint to use concatMap is a warning.

These directives are applied in the order they are given, with later hints overriding earlier ones. diff --git a/src/HSE/All.hs b/src/HSE/All.hs --- a/src/HSE/All.hs +++ b/src/HSE/All.hs @@ -2,14 +2,15 @@ module HSE.All( module HSE.Util, module HSE.Evaluate, module HSE.Bracket, module HSE.Match, - module HSE.Generics, + module HSE.Type, module HSE.Eq, module HSE.NameMatch, ParseFlags(..), parseFlags, parseFile, parseString ) where import HSE.Util import HSE.Evaluate -import HSE.Generics +import HSE.Eq +import HSE.Type import HSE.Bracket import HSE.Match import HSE.NameMatch diff --git a/src/HSE/Bracket.hs b/src/HSE/Bracket.hs --- a/src/HSE/Bracket.hs +++ b/src/HSE/Bracket.hs @@ -1,54 +1,112 @@ -{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE PatternGuards, TypeSynonymInstances #-} module HSE.Bracket where import Control.Monad.State -import Data.Data -import Data.Generics.Uniplate.Data import Data.Maybe +import HSE.Type import HSE.Util -paren :: Exp s -> Exp s -paren x = if isAtom x then x else Paren (ann x) x +class Brackets a where + remParen :: a -> Maybe a -- remove one paren, or Nothing if there is no paren + addParen :: a -> a -- write out a paren --- | Is this item lexically requiring no bracketing ever --- i.e. is totally atomic -isAtom :: Exp s -> Bool -isAtom x = case x of - Paren{} -> True - Var{} -> True - Con{} -> True - Lit{} -> True - Tuple{} -> True - List{} -> True - LeftSection{} -> True - RightSection{} -> True - RecConstr{} -> True - ListComp{} -> True - EnumFrom{} -> True - EnumFromTo{} -> True - EnumFromThen{} -> True - EnumFromThenTo{} -> True - _ -> False + -- | Is this item lexically requiring no bracketing ever + -- i.e. is totally atomic + isAtom :: a -> Bool + -- | Is the child safe free from brackets in the parent position. + -- Err on the side of caution, True = don't know + needBracket :: Int -> a -> a -> Bool --- Err on the side of caution, True = don't know -needBracket :: Int -> Exp s -> Exp s -> Bool -needBracket i parent child - | isAtom child = False - | InfixApp{} <- parent, isApp child = False - | ListComp{} <- parent = False - | List{} <- parent = False - | If{} <- parent, isAnyApp child = False - | App{} <- parent, i == 0, isApp child = False - | ExpTypeSig{} <- parent, i == 0 = False - | otherwise = True +instance Brackets Exp_ where + remParen (Paren _ x) = Just x + remParen _ = Nothing + addParen = Paren an + isAtom x = case x of + Paren{} -> True + Var{} -> True + Con{} -> True + Lit{} -> True + Tuple{} -> True + List{} -> True + LeftSection{} -> True + RightSection{} -> True + RecConstr{} -> True + ListComp{} -> True + EnumFrom{} -> True + EnumFromTo{} -> True + EnumFromThen{} -> True + EnumFromThenTo{} -> True + _ -> False + + needBracket i parent child + | isAtom child = False + | InfixApp{} <- parent, App{} <- child = False + | ListComp{} <- parent = False + | List{} <- parent = False + | Tuple{} <- parent = False + | If{} <- parent, isAnyApp child = False + | App{} <- parent, i == 0, App{} <- child = False + | ExpTypeSig{} <- parent, i == 0 = False + | otherwise = True + + +instance Brackets Type_ where + remParen (TyParen _ x) = Just x + remParen _ = Nothing + addParen = TyParen an + + isAtom x = case x of + TyParen{} -> True + TyTuple{} -> True + TyList{} -> True + TyVar{} -> True + TyCon{} -> True + _ -> False + + needBracket i parent child + | isAtom child = False + | TyFun{} <- parent, i == 1, TyFun{} <- child = False + | TyFun{} <- parent, TyApp{} <- child = False + | TyTuple{} <- parent = False + | TyList{} <- parent = False + | TyInfix{} <- parent, TyApp{} <- child = False + | otherwise = True + + +instance Brackets Pat_ where + remParen (PParen _ x) = Just x + remParen _ = Nothing + addParen = PParen an + + isAtom x = case x of + PParen{} -> True + PTuple{} -> True + PList{} -> True + PVar{} -> True + PApp _ _ [] -> True + PWildCard{} -> True + _ -> False + + needBracket i parent child + | isAtom child = False + | PTuple{} <- parent = False + | PList{} <- parent = False + | PInfixApp{} <- parent, PApp{} <- child = False + | otherwise = True + + +paren :: Exp_ -> Exp_ +paren x = if isAtom x then x else addParen x + + -- True implies I changed this level -descendBracket :: Data s => (Exp s -> (Bool, Exp s)) -> Exp s -> Exp s +descendBracket :: (Exp_ -> (Bool, Exp_)) -> Exp_ -> Exp_ descendBracket f x = flip evalState 0 $ flip descendM x $ \y -> do i <- get modify (+1) @@ -57,7 +115,7 @@ return $ p y -transformBracket :: Data s => (Exp s -> Maybe (Exp s)) -> Exp s -> Exp s +transformBracket :: (Exp_ -> Maybe Exp_) -> Exp_ -> Exp_ transformBracket f = snd . g where g = f2 . descendBracket g @@ -65,5 +123,5 @@ -- ensure that all the 1-level children are appropriately bracketed -ensureBracket1 :: Data s => Exp s -> Exp s +ensureBracket1 :: Exp_ -> Exp_ ensureBracket1 = descendBracket ((,) True) diff --git a/src/HSE/Eq.hs b/src/HSE/Eq.hs new file mode 100644 --- /dev/null +++ b/src/HSE/Eq.hs @@ -0,0 +1,55 @@ + +module HSE.Eq(eqExpShell) where + +import HSE.Type +import HSE.Util +import Data.Function +import Data.Data + + +-- A small expression +ex :: Exp_ +ex = Do an [] + + +eqExpShell :: Exp_ -> Exp_ -> Bool +eqExpShell x y = eqExpShellFast x y && eqExpShellSlow x y + +eqExpShellFast x y = toConstr x == toConstr y + +eqExpShellSlow = (==) `on` descend (const ex) + + +{- +-- The following eqExpShell method is based on the SYB functions. +-- It performs roughly the same as eqExpShell above, but is more +-- complex so is not used by default. +-- It is possible some overhead could be removed by optimising the +-- SYB calls. + +data Box = forall a . Data a => Box a + +eqExpShellSYB :: Exp_ -> Exp_ -> Bool +eqExpShellSYB = f + where + f :: (Data a, Data b) => a -> b -> Bool + f x y = + toConstr x == toConstr y && + andZipWith g (gmapQ Box x) (gmapQ Box y) + + g (Box x) (Box y) + | let tx = typeOf x in tx == typeAnn || tx == typeExp = True + | otherwise = f x y + + +typeAnn = typeOf an +typeExp = typeOf ex + + +andZipWith :: (a -> b -> Bool) -> [a] -> [b] -> Bool +andZipWith op = f + where + f (x:xs) (y:ys) = op x y && f xs ys + f [] [] = True + f _ _ = error "Internal error: andZipWith on unequal lengths" +-} diff --git a/src/HSE/Evaluate.hs b/src/HSE/Evaluate.hs --- a/src/HSE/Evaluate.hs +++ b/src/HSE/Evaluate.hs @@ -3,9 +3,9 @@ -- Evaluate a HSE Exp as much as possible module HSE.Evaluate(evaluate) where -import Data.Generics.Uniplate.Data import HSE.Match import HSE.Util +import HSE.Type import HSE.Bracket diff --git a/src/HSE/Generics.hs b/src/HSE/Generics.hs deleted file mode 100644 --- a/src/HSE/Generics.hs +++ /dev/null @@ -1,7 +0,0 @@ - -module HSE.Generics( - module Data.Generics, module Data.Generics.Uniplate.Data - ) where - -import Data.Generics hiding (Infix, Fixity) -import Data.Generics.Uniplate.Data diff --git a/src/HSE/Match.hs b/src/HSE/Match.hs --- a/src/HSE/Match.hs +++ b/src/HSE/Match.hs @@ -4,6 +4,7 @@ import Data.Char import Data.List +import HSE.Type import HSE.Util diff --git a/src/HSE/NameMatch.hs b/src/HSE/NameMatch.hs --- a/src/HSE/NameMatch.hs +++ b/src/HSE/NameMatch.hs @@ -1,6 +1,7 @@ module HSE.NameMatch(NameMatch, nameMatch) where +import HSE.Type import HSE.Util import HSE.Match import qualified Data.Map as Map @@ -37,6 +38,7 @@ f (Qual _ xm x) (Qual _ ym y) = x =~= y && xm =~= resolve ym f (Qual _ xm x) (UnQual _ y) = x =~= y && importedFrom xm x + f (UnQual _ x) (Qual _ ym y) = x =~= y f x y = x =~= y diff --git a/src/HSE/Type.hs b/src/HSE/Type.hs new file mode 100644 --- /dev/null +++ b/src/HSE/Type.hs @@ -0,0 +1,677 @@ + +module HSE.Type(module HSE.Type, module Export) where + +import Language.Haskell.Exts.Annotated as Export hiding (parse, loc, parseFile, paren) +import Data.Generics.Uniplate.Data as Export + +type S = SrcSpanInfo +type Module_ = Module S +type Decl_ = Decl S +type Exp_ = Exp S +type Pat_ = Pat S +type Type_ = Type S + + +{-! +deriving instance UniplateDirect (Pat S) (Pat S) +deriving instance UniplateDirect (Exp S) +deriving instance UniplateDirect (Pat S) +deriving instance UniplateDirect (Pat S) (Exp S) +deriving instance UniplateDirect (Binds S) (Exp S) +deriving instance UniplateDirect (Alt S) (Exp S) +deriving instance UniplateDirect (Stmt S) (Exp S) +deriving instance UniplateDirect (QualStmt S) (Exp S) +deriving instance UniplateDirect [QualStmt S] (Exp S) +deriving instance UniplateDirect (Bracket S) (Exp S) +deriving instance UniplateDirect (Splice S) (Exp S) +deriving instance UniplateDirect (XAttr S) (Exp S) +deriving instance UniplateDirect (Maybe (Exp S)) (Exp S) +deriving instance UniplateDirect (FieldUpdate S) (Exp S) +deriving instance UniplateDirect (PatField S) (Pat S) +deriving instance UniplateDirect (Exp S) (Pat S) +deriving instance UniplateDirect (RPat S) (Pat S) +deriving instance UniplateDirect (PXAttr S) (Pat S) +deriving instance UniplateDirect (Maybe (Pat S)) (Pat S) +deriving instance UniplateDirect (PatField S) (Exp S) +deriving instance UniplateDirect (RPat S) (Exp S) +deriving instance UniplateDirect (PXAttr S) (Exp S) +deriving instance UniplateDirect (Maybe (Pat S)) (Exp S) +deriving instance UniplateDirect (Decl S) (Exp S) +deriving instance UniplateDirect (IPBind S) (Exp S) +deriving instance UniplateDirect (GuardedAlts S) (Exp S) +deriving instance UniplateDirect (Maybe (Binds S)) (Exp S) +deriving instance UniplateDirect (Maybe (Exp S)) (Exp S) +deriving instance UniplateDirect (FieldUpdate S) (Exp S) +deriving instance UniplateDirect (PatField S) (Pat S) +deriving instance UniplateDirect (Exp S) (Pat S) +deriving instance UniplateDirect (RPat S) (Pat S) +deriving instance UniplateDirect (PXAttr S) (Pat S) +deriving instance UniplateDirect (Maybe (Pat S)) (Pat S) +deriving instance UniplateDirect (PatField S) (Exp S) +deriving instance UniplateDirect (RPat S) (Exp S) +deriving instance UniplateDirect (PXAttr S) (Exp S) +deriving instance UniplateDirect (Maybe (Pat S)) (Exp S) +deriving instance UniplateDirect (Decl S) (Exp S) +deriving instance UniplateDirect (IPBind S) (Exp S) +deriving instance UniplateDirect (GuardedAlts S) (Exp S) +deriving instance UniplateDirect (Maybe (Binds S)) (Exp S) +deriving instance UniplateDirect (Binds S) (Pat S) +deriving instance UniplateDirect (Alt S) (Pat S) +deriving instance UniplateDirect (Stmt S) (Pat S) +deriving instance UniplateDirect (Maybe (Exp S)) (Pat S) +deriving instance UniplateDirect (FieldUpdate S) (Pat S) +deriving instance UniplateDirect (QualStmt S) (Pat S) +deriving instance UniplateDirect [QualStmt S] (Pat S) +deriving instance UniplateDirect (Bracket S) (Pat S) +deriving instance UniplateDirect (Splice S) (Pat S) +deriving instance UniplateDirect (XAttr S) (Pat S) +deriving instance UniplateDirect (Maybe [ClassDecl S]) (Exp S) +deriving instance UniplateDirect (Maybe [InstDecl S]) (Exp S) +deriving instance UniplateDirect (Match S) (Exp S) +deriving instance UniplateDirect (Rhs S) (Exp S) +deriving instance UniplateDirect (Rule S) (Exp S) +deriving instance UniplateDirect (GuardedAlt S) (Exp S) +deriving instance UniplateDirect (Decl S) (Pat S) +deriving instance UniplateDirect (IPBind S) (Pat S) +deriving instance UniplateDirect (GuardedAlts S) (Pat S) +deriving instance UniplateDirect (Maybe (Binds S)) (Pat S) +deriving instance UniplateDirect (ClassDecl S) (Exp S) +deriving instance UniplateDirect (InstDecl S) (Exp S) +deriving instance UniplateDirect (GuardedRhs S) (Exp S) +deriving instance UniplateDirect (Maybe [ClassDecl S]) (Pat S) +deriving instance UniplateDirect (Maybe [InstDecl S]) (Pat S) +deriving instance UniplateDirect (Match S) (Pat S) +deriving instance UniplateDirect (Rhs S) (Pat S) +deriving instance UniplateDirect (Rule S) (Pat S) +deriving instance UniplateDirect (GuardedAlt S) (Pat S) +deriving instance UniplateDirect (ClassDecl S) (Pat S) +deriving instance UniplateDirect (InstDecl S) (Pat S) +deriving instance UniplateDirect (GuardedRhs S) (Pat S) +deriving instance UniplateDirect (Maybe (Binds S)) (Decl S) +deriving instance UniplateDirect (Exp S) (Name S) +deriving instance UniplateDirect (Decl S) +deriving instance UniplateDirect (Binds S) (Decl S) +deriving instance UniplateDirect (Name S) +deriving instance UniplateDirect (QName S) (Name S) +deriving instance UniplateDirect (QOp S) (Name S) +deriving instance UniplateDirect (Pat S) (Name S) +deriving instance UniplateDirect (Binds S) (Name S) +deriving instance UniplateDirect (Alt S) (Name S) +deriving instance UniplateDirect (Stmt S) (Name S) +deriving instance UniplateDirect (Maybe (Exp S)) (Name S) +deriving instance UniplateDirect (FieldUpdate S) (Name S) +deriving instance UniplateDirect (QualStmt S) (Name S) +deriving instance UniplateDirect [QualStmt S] (Name S) +deriving instance UniplateDirect (Type S) (Name S) +deriving instance UniplateDirect (Bracket S) (Name S) +deriving instance UniplateDirect (Splice S) (Name S) +deriving instance UniplateDirect (XAttr S) (Name S) +deriving instance UniplateDirect (Decl S) (Name S) +deriving instance UniplateDirect (Exp S) (Decl S) +deriving instance UniplateDirect (GuardedAlts S) (Name S) +deriving instance UniplateDirect (IPBind S) (Decl S) +deriving instance UniplateDirect (IPBind S) (Name S) +deriving instance UniplateDirect (Kind S) (Name S) +deriving instance UniplateDirect (Match S) (Decl S) +deriving instance UniplateDirect (Maybe (Binds S)) (Name S) +deriving instance UniplateDirect (Maybe (Context S)) (Name S) +deriving instance UniplateDirect (Maybe (Pat S)) (Name S) +deriving instance UniplateDirect (Maybe [ClassDecl S]) (Decl S) +deriving instance UniplateDirect (Maybe [InstDecl S]) (Decl S) +deriving instance UniplateDirect (Maybe [TyVarBind S]) (Name S) +deriving instance UniplateDirect (PXAttr S) (Name S) +deriving instance UniplateDirect (Pat S) (Decl S) +deriving instance UniplateDirect (PatField S) (Name S) +deriving instance UniplateDirect (RPat S) (Name S) +deriving instance UniplateDirect (Rhs S) (Decl S) +deriving instance UniplateDirect (Rule S) (Decl S) +deriving instance UniplateDirect (Maybe [ClassDecl S]) (Name S) +deriving instance UniplateDirect (InstHead S) (Name S) +deriving instance UniplateDirect (Maybe [InstDecl S]) (Name S) +deriving instance UniplateDirect (Op S) (Name S) +deriving instance UniplateDirect (Match S) (Name S) +deriving instance UniplateDirect (Maybe (Type S)) (Name S) +deriving instance UniplateDirect (Rhs S) (Name S) +deriving instance UniplateDirect (Rule S) (Name S) +deriving instance UniplateDirect ([Name S], String) (Name S) +deriving instance UniplateDirect (Alt S) (Decl S) +deriving instance UniplateDirect (Stmt S) (Decl S) +deriving instance UniplateDirect (Maybe (Exp S)) (Decl S) +deriving instance UniplateDirect (FieldUpdate S) (Decl S) +deriving instance UniplateDirect (QualStmt S) (Decl S) +deriving instance UniplateDirect [QualStmt S] (Decl S) +deriving instance UniplateDirect (Bracket S) (Decl S) +deriving instance UniplateDirect (Splice S) (Decl S) +deriving instance UniplateDirect (XAttr S) (Decl S) +deriving instance UniplateDirect (GuardedAlt S) (Name S) +deriving instance UniplateDirect (Context S) (Name S) +deriving instance UniplateDirect (ClassDecl S) (Decl S) +deriving instance UniplateDirect (InstDecl S) (Decl S) +deriving instance UniplateDirect (TyVarBind S) (Name S) +deriving instance UniplateDirect (PatField S) (Decl S) +deriving instance UniplateDirect (RPat S) (Decl S) +deriving instance UniplateDirect (PXAttr S) (Decl S) +deriving instance UniplateDirect (Maybe (Pat S)) (Decl S) +deriving instance UniplateDirect (GuardedRhs S) (Decl S) +deriving instance UniplateDirect (DeclHead S) (Name S) +deriving instance UniplateDirect (Maybe (Kind S)) (Name S) +deriving instance UniplateDirect (QualConDecl S) (Name S) +deriving instance UniplateDirect (Maybe (Deriving S)) (Name S) +deriving instance UniplateDirect (GadtDecl S) (Name S) +deriving instance UniplateDirect (FunDep S) (Name S) +deriving instance UniplateDirect (ClassDecl S) (Name S) +deriving instance UniplateDirect (InstDecl S) (Name S) +deriving instance UniplateDirect (GuardedRhs S) (Name S) +deriving instance UniplateDirect (Maybe [RuleVar S]) (Name S) +deriving instance UniplateDirect (GuardedAlts S) (Decl S) +deriving instance UniplateDirect (Asst S) (Name S) +deriving instance UniplateDirect (ConDecl S) (Name S) +deriving instance UniplateDirect (Deriving S) (Name S) +deriving instance UniplateDirect (RuleVar S) (Name S) +deriving instance UniplateDirect (GuardedAlt S) (Decl S) +deriving instance UniplateDirect (BangType S) (Name S) +deriving instance UniplateDirect (FieldDecl S) (Name S) +deriving instance UniplateDirect (Module S) (FunDep S) +deriving instance UniplateDirect (Module S) (IPName S) +deriving instance UniplateDirect (Module S) (Decl S) +deriving instance UniplateDirect (Module S) (Kind S) +deriving instance UniplateDirect (Module S) (Pat S) +deriving instance UniplateDirect (Module S) (CallConv S) +deriving instance UniplateDirect (Module S) (GuardedRhs S) +deriving instance UniplateDirect (Module S) (GuardedAlt S) +deriving instance UniplateDirect (Module S) (PatField S) +deriving instance UniplateDirect (Module S) Boxed +deriving instance UniplateDirect (Module S) (ImportDecl S) +deriving instance UniplateDirect (Module S) (Exp S) +deriving instance UniplateDirect (Module S) (QualStmt S) +deriving instance UniplateDirect (Exp S) (CallConv S) +deriving instance UniplateDirect (GuardedRhs S) +deriving instance UniplateDirect (Decl S) (GuardedRhs S) +deriving instance UniplateDirect (XAttr S) (GuardedRhs S) +deriving instance UniplateDirect (Maybe (Exp S)) (GuardedRhs S) +deriving instance UniplateDirect (Exp S) (GuardedRhs S) +deriving instance UniplateDirect (GuardedAlt S) +deriving instance UniplateDirect (Decl S) (GuardedAlt S) +deriving instance UniplateDirect (XAttr S) (GuardedAlt S) +deriving instance UniplateDirect (Maybe (Exp S)) (GuardedAlt S) +deriving instance UniplateDirect (Exp S) (GuardedAlt S) +deriving instance UniplateDirect (PatField S) +deriving instance UniplateDirect (Decl S) (PatField S) +deriving instance UniplateDirect (XAttr S) (PatField S) +deriving instance UniplateDirect (Maybe (Exp S)) (PatField S) +deriving instance UniplateDirect (Exp S) (PatField S) +deriving instance UniplateDirect Boxed +deriving instance UniplateDirect (Maybe (ModuleHead S)) Boxed +deriving instance UniplateDirect (Decl S) Boxed +deriving instance UniplateDirect (XAttr S) Boxed +deriving instance UniplateDirect (Maybe (Exp S)) Boxed +deriving instance UniplateDirect (Exp S) Boxed +deriving instance UniplateDirect (ImportDecl S) +deriving instance UniplateDirect (QualStmt S) +deriving instance UniplateDirect (Decl S) (QualStmt S) +deriving instance UniplateDirect (XAttr S) (QualStmt S) +deriving instance UniplateDirect (Maybe (Exp S)) (QualStmt S) +deriving instance UniplateDirect (Exp S) (QualStmt S) +deriving instance UniplateDirect (Maybe (Type S)) Boxed +deriving instance UniplateDirect (Rhs S) Boxed +deriving instance UniplateDirect (Maybe (Binds S)) Boxed +deriving instance UniplateDirect (Rule S) Boxed +deriving instance UniplateDirect (QName S) Boxed +deriving instance UniplateDirect (QOp S) Boxed +deriving instance UniplateDirect (Binds S) Boxed +deriving instance UniplateDirect (Alt S) Boxed +deriving instance UniplateDirect (Stmt S) Boxed +deriving instance UniplateDirect (FieldUpdate S) Boxed +deriving instance UniplateDirect (QualStmt S) Boxed +deriving instance UniplateDirect [QualStmt S] Boxed +deriving instance UniplateDirect (Bracket S) Boxed +deriving instance UniplateDirect (Splice S) Boxed +deriving instance UniplateDirect (Stmt S) (QualStmt S) +deriving instance UniplateDirect (Maybe [ClassDecl S]) (QualStmt S) +deriving instance UniplateDirect (Maybe [InstDecl S]) (QualStmt S) +deriving instance UniplateDirect (Match S) (QualStmt S) +deriving instance UniplateDirect (Pat S) (QualStmt S) +deriving instance UniplateDirect (Rhs S) (QualStmt S) +deriving instance UniplateDirect (Maybe (Binds S)) (QualStmt S) +deriving instance UniplateDirect (Rule S) (QualStmt S) +deriving instance UniplateDirect (Binds S) (QualStmt S) +deriving instance UniplateDirect (Alt S) (QualStmt S) +deriving instance UniplateDirect (FieldUpdate S) (QualStmt S) +deriving instance UniplateDirect [QualStmt S] (QualStmt S) +deriving instance UniplateDirect (Bracket S) (QualStmt S) +deriving instance UniplateDirect (Splice S) (QualStmt S) +deriving instance UniplateDirect (FunDep S) +deriving instance UniplateDirect (Decl S) (FunDep S) +deriving instance UniplateDirect (XAttr S) (FunDep S) +deriving instance UniplateDirect (Maybe (Exp S)) (FunDep S) +deriving instance UniplateDirect (Exp S) (FunDep S) +deriving instance UniplateDirect (IPName S) +deriving instance UniplateDirect (Decl S) (IPName S) +deriving instance UniplateDirect (XAttr S) (IPName S) +deriving instance UniplateDirect (Maybe (Exp S)) (IPName S) +deriving instance UniplateDirect (Exp S) (IPName S) +deriving instance UniplateDirect (Kind S) +deriving instance UniplateDirect (Decl S) (Kind S) +deriving instance UniplateDirect (XAttr S) (Kind S) +deriving instance UniplateDirect (Maybe (Exp S)) (Kind S) +deriving instance UniplateDirect (Exp S) (Kind S) +deriving instance UniplateDirect (CallConv S) +deriving instance UniplateDirect (Decl S) (CallConv S) +deriving instance UniplateDirect (XAttr S) (CallConv S) +deriving instance UniplateDirect (Maybe (Exp S)) (CallConv S) +deriving instance UniplateDirect (CallConv S) +deriving instance UniplateDirect (Pat S) (CallConv S) +deriving instance UniplateDirect (Binds S) (CallConv S) +deriving instance UniplateDirect (Alt S) (CallConv S) +deriving instance UniplateDirect (Stmt S) (CallConv S) +deriving instance UniplateDirect (FieldUpdate S) (CallConv S) +deriving instance UniplateDirect (QualStmt S) (CallConv S) +deriving instance UniplateDirect [QualStmt S] (CallConv S) +deriving instance UniplateDirect (Bracket S) (CallConv S) +deriving instance UniplateDirect (Splice S) (CallConv S) +deriving instance UniplateDirect (Stmt S) (GuardedRhs S) +deriving instance UniplateDirect (Maybe [ClassDecl S]) (GuardedRhs S) +deriving instance UniplateDirect (Maybe [InstDecl S]) (GuardedRhs S) +deriving instance UniplateDirect (Match S) (GuardedRhs S) +deriving instance UniplateDirect (Pat S) (GuardedRhs S) +deriving instance UniplateDirect (Rhs S) (GuardedRhs S) +deriving instance UniplateDirect (Maybe (Binds S)) (GuardedRhs S) +deriving instance UniplateDirect (Rule S) (GuardedRhs S) +deriving instance UniplateDirect (Binds S) (GuardedRhs S) +deriving instance UniplateDirect (Alt S) (GuardedRhs S) +deriving instance UniplateDirect (FieldUpdate S) (GuardedRhs S) +deriving instance UniplateDirect (QualStmt S) (GuardedRhs S) +deriving instance UniplateDirect [QualStmt S] (GuardedRhs S) +deriving instance UniplateDirect (Bracket S) (GuardedRhs S) +deriving instance UniplateDirect (Splice S) (GuardedRhs S) +deriving instance UniplateDirect (Stmt S) (GuardedAlt S) +deriving instance UniplateDirect (Maybe [ClassDecl S]) (GuardedAlt S) +deriving instance UniplateDirect (Maybe [InstDecl S]) (GuardedAlt S) +deriving instance UniplateDirect (Match S) (GuardedAlt S) +deriving instance UniplateDirect (Pat S) (GuardedAlt S) +deriving instance UniplateDirect (Rhs S) (GuardedAlt S) +deriving instance UniplateDirect (Maybe (Binds S)) (GuardedAlt S) +deriving instance UniplateDirect (Rule S) (GuardedAlt S) +deriving instance UniplateDirect (Binds S) (GuardedAlt S) +deriving instance UniplateDirect (Alt S) (GuardedAlt S) +deriving instance UniplateDirect (FieldUpdate S) (GuardedAlt S) +deriving instance UniplateDirect (QualStmt S) (GuardedAlt S) +deriving instance UniplateDirect [QualStmt S] (GuardedAlt S) +deriving instance UniplateDirect (Bracket S) (GuardedAlt S) +deriving instance UniplateDirect (Splice S) (GuardedAlt S) +deriving instance UniplateDirect (Pat S) (PatField S) +deriving instance UniplateDirect (Maybe [ClassDecl S]) (PatField S) +deriving instance UniplateDirect (Maybe [InstDecl S]) (PatField S) +deriving instance UniplateDirect (Match S) (PatField S) +deriving instance UniplateDirect (Rhs S) (PatField S) +deriving instance UniplateDirect (Maybe (Binds S)) (PatField S) +deriving instance UniplateDirect (Rule S) (PatField S) +deriving instance UniplateDirect (Binds S) (PatField S) +deriving instance UniplateDirect (Alt S) (PatField S) +deriving instance UniplateDirect (Stmt S) (PatField S) +deriving instance UniplateDirect (FieldUpdate S) (PatField S) +deriving instance UniplateDirect (QualStmt S) (PatField S) +deriving instance UniplateDirect [QualStmt S] (PatField S) +deriving instance UniplateDirect (Bracket S) (PatField S) +deriving instance UniplateDirect (Splice S) (PatField S) +deriving instance UniplateDirect (ModuleHead S) Boxed +deriving instance UniplateDirect (Type S) Boxed +deriving instance UniplateDirect (Maybe (Context S)) Boxed +deriving instance UniplateDirect (QualConDecl S) Boxed +deriving instance UniplateDirect (Maybe (Deriving S)) Boxed +deriving instance UniplateDirect (GadtDecl S) Boxed +deriving instance UniplateDirect (Maybe [ClassDecl S]) Boxed +deriving instance UniplateDirect (InstHead S) Boxed +deriving instance UniplateDirect (Maybe [InstDecl S]) Boxed +deriving instance UniplateDirect (Match S) Boxed +deriving instance UniplateDirect (Pat S) Boxed +deriving instance UniplateDirect (GuardedRhs S) Boxed +deriving instance UniplateDirect (Maybe [RuleVar S]) Boxed +deriving instance UniplateDirect (SpecialCon S) Boxed +deriving instance UniplateDirect (IPBind S) Boxed +deriving instance UniplateDirect (GuardedAlts S) Boxed +deriving instance UniplateDirect (ClassDecl S) (QualStmt S) +deriving instance UniplateDirect (InstDecl S) (QualStmt S) +deriving instance UniplateDirect (PatField S) (QualStmt S) +deriving instance UniplateDirect (RPat S) (QualStmt S) +deriving instance UniplateDirect (PXAttr S) (QualStmt S) +deriving instance UniplateDirect (Maybe (Pat S)) (QualStmt S) +deriving instance UniplateDirect (GuardedRhs S) (QualStmt S) +deriving instance UniplateDirect (IPBind S) (QualStmt S) +deriving instance UniplateDirect (GuardedAlts S) (QualStmt S) +deriving instance UniplateDirect (Maybe [ClassDecl S]) (FunDep S) +deriving instance UniplateDirect (Maybe [InstDecl S]) (FunDep S) +deriving instance UniplateDirect (Match S) (FunDep S) +deriving instance UniplateDirect (Pat S) (FunDep S) +deriving instance UniplateDirect (Rhs S) (FunDep S) +deriving instance UniplateDirect (Maybe (Binds S)) (FunDep S) +deriving instance UniplateDirect (Rule S) (FunDep S) +deriving instance UniplateDirect (Binds S) (FunDep S) +deriving instance UniplateDirect (Alt S) (FunDep S) +deriving instance UniplateDirect (Stmt S) (FunDep S) +deriving instance UniplateDirect (FieldUpdate S) (FunDep S) +deriving instance UniplateDirect (QualStmt S) (FunDep S) +deriving instance UniplateDirect [QualStmt S] (FunDep S) +deriving instance UniplateDirect (Bracket S) (FunDep S) +deriving instance UniplateDirect (Splice S) (FunDep S) +deriving instance UniplateDirect (Type S) (IPName S) +deriving instance UniplateDirect (Maybe (Context S)) (IPName S) +deriving instance UniplateDirect (QualConDecl S) (IPName S) +deriving instance UniplateDirect (Maybe (Deriving S)) (IPName S) +deriving instance UniplateDirect (GadtDecl S) (IPName S) +deriving instance UniplateDirect (Maybe [ClassDecl S]) (IPName S) +deriving instance UniplateDirect (InstHead S) (IPName S) +deriving instance UniplateDirect (Maybe [InstDecl S]) (IPName S) +deriving instance UniplateDirect (Match S) (IPName S) +deriving instance UniplateDirect (Pat S) (IPName S) +deriving instance UniplateDirect (Maybe (Type S)) (IPName S) +deriving instance UniplateDirect (Rhs S) (IPName S) +deriving instance UniplateDirect (Maybe (Binds S)) (IPName S) +deriving instance UniplateDirect (Rule S) (IPName S) +deriving instance UniplateDirect (Binds S) (IPName S) +deriving instance UniplateDirect (Alt S) (IPName S) +deriving instance UniplateDirect (Stmt S) (IPName S) +deriving instance UniplateDirect (FieldUpdate S) (IPName S) +deriving instance UniplateDirect (QualStmt S) (IPName S) +deriving instance UniplateDirect [QualStmt S] (IPName S) +deriving instance UniplateDirect (Bracket S) (IPName S) +deriving instance UniplateDirect (Splice S) (IPName S) +deriving instance UniplateDirect (DeclHead S) (Kind S) +deriving instance UniplateDirect (Type S) (Kind S) +deriving instance UniplateDirect (Maybe (Kind S)) (Kind S) +deriving instance UniplateDirect (Maybe (Context S)) (Kind S) +deriving instance UniplateDirect (QualConDecl S) (Kind S) +deriving instance UniplateDirect (Maybe (Deriving S)) (Kind S) +deriving instance UniplateDirect (GadtDecl S) (Kind S) +deriving instance UniplateDirect (Maybe [ClassDecl S]) (Kind S) +deriving instance UniplateDirect (InstHead S) (Kind S) +deriving instance UniplateDirect (Maybe [InstDecl S]) (Kind S) +deriving instance UniplateDirect (Match S) (Kind S) +deriving instance UniplateDirect (Pat S) (Kind S) +deriving instance UniplateDirect (Maybe (Type S)) (Kind S) +deriving instance UniplateDirect (Rhs S) (Kind S) +deriving instance UniplateDirect (Maybe (Binds S)) (Kind S) +deriving instance UniplateDirect (Rule S) (Kind S) +deriving instance UniplateDirect (Binds S) (Kind S) +deriving instance UniplateDirect (Alt S) (Kind S) +deriving instance UniplateDirect (Stmt S) (Kind S) +deriving instance UniplateDirect (FieldUpdate S) (Kind S) +deriving instance UniplateDirect (QualStmt S) (Kind S) +deriving instance UniplateDirect [QualStmt S] (Kind S) +deriving instance UniplateDirect (Bracket S) (Kind S) +deriving instance UniplateDirect (Splice S) (Kind S) +deriving instance UniplateDirect (Maybe [ClassDecl S]) (CallConv S) +deriving instance UniplateDirect (Maybe [InstDecl S]) (CallConv S) +deriving instance UniplateDirect (Match S) (CallConv S) +deriving instance UniplateDirect (Rhs S) (CallConv S) +deriving instance UniplateDirect (Maybe (Binds S)) (CallConv S) +deriving instance UniplateDirect (Rule S) (CallConv S) +deriving instance UniplateDirect (PatField S) (CallConv S) +deriving instance UniplateDirect (RPat S) (CallConv S) +deriving instance UniplateDirect (PXAttr S) (CallConv S) +deriving instance UniplateDirect (Maybe (Pat S)) (CallConv S) +deriving instance UniplateDirect (IPBind S) (CallConv S) +deriving instance UniplateDirect (GuardedAlts S) (CallConv S) +deriving instance UniplateDirect (ClassDecl S) (GuardedRhs S) +deriving instance UniplateDirect (InstDecl S) (GuardedRhs S) +deriving instance UniplateDirect (PatField S) (GuardedRhs S) +deriving instance UniplateDirect (RPat S) (GuardedRhs S) +deriving instance UniplateDirect (PXAttr S) (GuardedRhs S) +deriving instance UniplateDirect (Maybe (Pat S)) (GuardedRhs S) +deriving instance UniplateDirect (IPBind S) (GuardedRhs S) +deriving instance UniplateDirect (GuardedAlts S) (GuardedRhs S) +deriving instance UniplateDirect (ClassDecl S) (GuardedAlt S) +deriving instance UniplateDirect (InstDecl S) (GuardedAlt S) +deriving instance UniplateDirect (PatField S) (GuardedAlt S) +deriving instance UniplateDirect (RPat S) (GuardedAlt S) +deriving instance UniplateDirect (PXAttr S) (GuardedAlt S) +deriving instance UniplateDirect (Maybe (Pat S)) (GuardedAlt S) +deriving instance UniplateDirect (GuardedRhs S) (GuardedAlt S) +deriving instance UniplateDirect (IPBind S) (GuardedAlt S) +deriving instance UniplateDirect (GuardedAlts S) (GuardedAlt S) +deriving instance UniplateDirect (RPat S) (PatField S) +deriving instance UniplateDirect (PXAttr S) (PatField S) +deriving instance UniplateDirect (Maybe (Pat S)) (PatField S) +deriving instance UniplateDirect (ClassDecl S) (PatField S) +deriving instance UniplateDirect (InstDecl S) (PatField S) +deriving instance UniplateDirect (GuardedRhs S) (PatField S) +deriving instance UniplateDirect (IPBind S) (PatField S) +deriving instance UniplateDirect (GuardedAlts S) (PatField S) +deriving instance UniplateDirect (Maybe (ExportSpecList S)) Boxed +deriving instance UniplateDirect (Context S) Boxed +deriving instance UniplateDirect (ConDecl S) Boxed +deriving instance UniplateDirect (Deriving S) Boxed +deriving instance UniplateDirect (ClassDecl S) Boxed +deriving instance UniplateDirect (InstDecl S) Boxed +deriving instance UniplateDirect (PatField S) Boxed +deriving instance UniplateDirect (RPat S) Boxed +deriving instance UniplateDirect (PXAttr S) Boxed +deriving instance UniplateDirect (Maybe (Pat S)) Boxed +deriving instance UniplateDirect (RuleVar S) Boxed +deriving instance UniplateDirect (GuardedAlt S) Boxed +deriving instance UniplateDirect (GuardedAlt S) (QualStmt S) +deriving instance UniplateDirect (ClassDecl S) (FunDep S) +deriving instance UniplateDirect (InstDecl S) (FunDep S) +deriving instance UniplateDirect (PatField S) (FunDep S) +deriving instance UniplateDirect (RPat S) (FunDep S) +deriving instance UniplateDirect (PXAttr S) (FunDep S) +deriving instance UniplateDirect (Maybe (Pat S)) (FunDep S) +deriving instance UniplateDirect (GuardedRhs S) (FunDep S) +deriving instance UniplateDirect (IPBind S) (FunDep S) +deriving instance UniplateDirect (GuardedAlts S) (FunDep S) +deriving instance UniplateDirect (Context S) (IPName S) +deriving instance UniplateDirect (ConDecl S) (IPName S) +deriving instance UniplateDirect (Deriving S) (IPName S) +deriving instance UniplateDirect (ClassDecl S) (IPName S) +deriving instance UniplateDirect (InstDecl S) (IPName S) +deriving instance UniplateDirect (PatField S) (IPName S) +deriving instance UniplateDirect (RPat S) (IPName S) +deriving instance UniplateDirect (PXAttr S) (IPName S) +deriving instance UniplateDirect (Maybe (Pat S)) (IPName S) +deriving instance UniplateDirect (GuardedRhs S) (IPName S) +deriving instance UniplateDirect (Maybe [RuleVar S]) (IPName S) +deriving instance UniplateDirect (IPBind S) (IPName S) +deriving instance UniplateDirect (GuardedAlts S) (IPName S) +deriving instance UniplateDirect (TyVarBind S) (Kind S) +deriving instance UniplateDirect (Maybe [TyVarBind S]) (Kind S) +deriving instance UniplateDirect (Context S) (Kind S) +deriving instance UniplateDirect (ConDecl S) (Kind S) +deriving instance UniplateDirect (Deriving S) (Kind S) +deriving instance UniplateDirect (ClassDecl S) (Kind S) +deriving instance UniplateDirect (InstDecl S) (Kind S) +deriving instance UniplateDirect (PatField S) (Kind S) +deriving instance UniplateDirect (RPat S) (Kind S) +deriving instance UniplateDirect (PXAttr S) (Kind S) +deriving instance UniplateDirect (Maybe (Pat S)) (Kind S) +deriving instance UniplateDirect (GuardedRhs S) (Kind S) +deriving instance UniplateDirect (Maybe [RuleVar S]) (Kind S) +deriving instance UniplateDirect (IPBind S) (Kind S) +deriving instance UniplateDirect (GuardedAlts S) (Kind S) +deriving instance UniplateDirect (ClassDecl S) (CallConv S) +deriving instance UniplateDirect (InstDecl S) (CallConv S) +deriving instance UniplateDirect (GuardedRhs S) (CallConv S) +deriving instance UniplateDirect (GuardedAlt S) (CallConv S) +deriving instance UniplateDirect (GuardedAlt S) (GuardedRhs S) +deriving instance UniplateDirect (GuardedAlt S) (PatField S) +deriving instance UniplateDirect (ExportSpecList S) Boxed +deriving instance UniplateDirect (Asst S) Boxed +deriving instance UniplateDirect (BangType S) Boxed +deriving instance UniplateDirect (FieldDecl S) Boxed +deriving instance UniplateDirect (GuardedAlt S) (FunDep S) +deriving instance UniplateDirect (Asst S) (IPName S) +deriving instance UniplateDirect (BangType S) (IPName S) +deriving instance UniplateDirect (FieldDecl S) (IPName S) +deriving instance UniplateDirect (RuleVar S) (IPName S) +deriving instance UniplateDirect (GuardedAlt S) (IPName S) +deriving instance UniplateDirect (Asst S) (Kind S) +deriving instance UniplateDirect (BangType S) (Kind S) +deriving instance UniplateDirect (FieldDecl S) (Kind S) +deriving instance UniplateDirect (RuleVar S) (Kind S) +deriving instance UniplateDirect (GuardedAlt S) (Kind S) +deriving instance UniplateDirect (ExportSpec S) Boxed +deriving instance UniplateDirect (Module S) (Splice S) +deriving instance UniplateDirect (Module S) (Bracket S) +deriving instance UniplateDirect (Splice S) +deriving instance UniplateDirect (Decl S) (Splice S) +deriving instance UniplateDirect (XAttr S) (Splice S) +deriving instance UniplateDirect (Maybe (Exp S)) (Splice S) +deriving instance UniplateDirect (Exp S) (Splice S) +deriving instance UniplateDirect (Bracket S) +deriving instance UniplateDirect (Decl S) (Bracket S) +deriving instance UniplateDirect (XAttr S) (Bracket S) +deriving instance UniplateDirect (Maybe (Exp S)) (Bracket S) +deriving instance UniplateDirect (Exp S) (Bracket S) +deriving instance UniplateDirect (Maybe [ClassDecl S]) (Splice S) +deriving instance UniplateDirect (Maybe [InstDecl S]) (Splice S) +deriving instance UniplateDirect (Match S) (Splice S) +deriving instance UniplateDirect (Pat S) (Splice S) +deriving instance UniplateDirect (Rhs S) (Splice S) +deriving instance UniplateDirect (Maybe (Binds S)) (Splice S) +deriving instance UniplateDirect (Rule S) (Splice S) +deriving instance UniplateDirect (Binds S) (Splice S) +deriving instance UniplateDirect (Alt S) (Splice S) +deriving instance UniplateDirect (Stmt S) (Splice S) +deriving instance UniplateDirect (FieldUpdate S) (Splice S) +deriving instance UniplateDirect (QualStmt S) (Splice S) +deriving instance UniplateDirect [QualStmt S] (Splice S) +deriving instance UniplateDirect (Bracket S) (Splice S) +deriving instance UniplateDirect (Pat S) (Bracket S) +deriving instance UniplateDirect (Maybe [ClassDecl S]) (Bracket S) +deriving instance UniplateDirect (Maybe [InstDecl S]) (Bracket S) +deriving instance UniplateDirect (Match S) (Bracket S) +deriving instance UniplateDirect (Rhs S) (Bracket S) +deriving instance UniplateDirect (Maybe (Binds S)) (Bracket S) +deriving instance UniplateDirect (Rule S) (Bracket S) +deriving instance UniplateDirect (Binds S) (Bracket S) +deriving instance UniplateDirect (Alt S) (Bracket S) +deriving instance UniplateDirect (Stmt S) (Bracket S) +deriving instance UniplateDirect (FieldUpdate S) (Bracket S) +deriving instance UniplateDirect (QualStmt S) (Bracket S) +deriving instance UniplateDirect [QualStmt S] (Bracket S) +deriving instance UniplateDirect (Splice S) (Bracket S) +deriving instance UniplateDirect (ClassDecl S) (Splice S) +deriving instance UniplateDirect (InstDecl S) (Splice S) +deriving instance UniplateDirect (PatField S) (Splice S) +deriving instance UniplateDirect (RPat S) (Splice S) +deriving instance UniplateDirect (PXAttr S) (Splice S) +deriving instance UniplateDirect (Maybe (Pat S)) (Splice S) +deriving instance UniplateDirect (GuardedRhs S) (Splice S) +deriving instance UniplateDirect (IPBind S) (Splice S) +deriving instance UniplateDirect (GuardedAlts S) (Splice S) +deriving instance UniplateDirect (PatField S) (Bracket S) +deriving instance UniplateDirect (RPat S) (Bracket S) +deriving instance UniplateDirect (PXAttr S) (Bracket S) +deriving instance UniplateDirect (Maybe (Pat S)) (Bracket S) +deriving instance UniplateDirect (ClassDecl S) (Bracket S) +deriving instance UniplateDirect (InstDecl S) (Bracket S) +deriving instance UniplateDirect (GuardedRhs S) (Bracket S) +deriving instance UniplateDirect (IPBind S) (Bracket S) +deriving instance UniplateDirect (GuardedAlts S) (Bracket S) +deriving instance UniplateDirect (GuardedAlt S) (Splice S) +deriving instance UniplateDirect (GuardedAlt S) (Bracket S) +deriving instance UniplateDirect (Exp S) (Exp S) +deriving instance UniplateDirect [Pat S] (Pat S) +deriving instance UniplateDirect (Module S) (Name S) +deriving instance UniplateDirect (Maybe (ModuleHead S)) (Name S) +deriving instance UniplateDirect (OptionPragma S) (Name S) +deriving instance UniplateDirect (ImportDecl S) (Name S) +deriving instance UniplateDirect (ModuleHead S) (Name S) +deriving instance UniplateDirect (Maybe (ImportSpecList S)) (Name S) +deriving instance UniplateDirect (Maybe (ExportSpecList S)) (Name S) +deriving instance UniplateDirect (ImportSpecList S) (Name S) +deriving instance UniplateDirect (ExportSpecList S) (Name S) +deriving instance UniplateDirect (ImportSpec S) (Name S) +deriving instance UniplateDirect (ExportSpec S) (Name S) +deriving instance UniplateDirect (CName S) (Name S) +deriving instance UniplateDirect [Stmt S] (Exp S) +deriving instance UniplateDirect (Decl S) (Type S) +deriving instance UniplateDirect (Type S) +deriving instance UniplateDirect (Maybe (Context S)) (Type S) +deriving instance UniplateDirect (QualConDecl S) (Type S) +deriving instance UniplateDirect (Maybe (Deriving S)) (Type S) +deriving instance UniplateDirect (GadtDecl S) (Type S) +deriving instance UniplateDirect (Maybe [ClassDecl S]) (Type S) +deriving instance UniplateDirect (InstHead S) (Type S) +deriving instance UniplateDirect (Maybe [InstDecl S]) (Type S) +deriving instance UniplateDirect (Exp S) (Type S) +deriving instance UniplateDirect (Match S) (Type S) +deriving instance UniplateDirect (Pat S) (Type S) +deriving instance UniplateDirect (Maybe (Type S)) (Type S) +deriving instance UniplateDirect (Rhs S) (Type S) +deriving instance UniplateDirect (Maybe (Binds S)) (Type S) +deriving instance UniplateDirect (Rule S) (Type S) +deriving instance UniplateDirect (Context S) (Type S) +deriving instance UniplateDirect (ConDecl S) (Type S) +deriving instance UniplateDirect (Deriving S) (Type S) +deriving instance UniplateDirect (ClassDecl S) (Type S) +deriving instance UniplateDirect (InstDecl S) (Type S) +deriving instance UniplateDirect (Binds S) (Type S) +deriving instance UniplateDirect (Alt S) (Type S) +deriving instance UniplateDirect (Stmt S) (Type S) +deriving instance UniplateDirect (Maybe (Exp S)) (Type S) +deriving instance UniplateDirect (FieldUpdate S) (Type S) +deriving instance UniplateDirect (QualStmt S) (Type S) +deriving instance UniplateDirect [QualStmt S] (Type S) +deriving instance UniplateDirect (Bracket S) (Type S) +deriving instance UniplateDirect (Splice S) (Type S) +deriving instance UniplateDirect (XAttr S) (Type S) +deriving instance UniplateDirect (PatField S) (Type S) +deriving instance UniplateDirect (RPat S) (Type S) +deriving instance UniplateDirect (PXAttr S) (Type S) +deriving instance UniplateDirect (Maybe (Pat S)) (Type S) +deriving instance UniplateDirect (GuardedRhs S) (Type S) +deriving instance UniplateDirect (Maybe [RuleVar S]) (Type S) +deriving instance UniplateDirect (Asst S) (Type S) +deriving instance UniplateDirect (BangType S) (Type S) +deriving instance UniplateDirect (FieldDecl S) (Type S) +deriving instance UniplateDirect (IPBind S) (Type S) +deriving instance UniplateDirect (GuardedAlts S) (Type S) +deriving instance UniplateDirect (RuleVar S) (Type S) +deriving instance UniplateDirect (GuardedAlt S) (Type S) +deriving instance UniplateDirect (Exp S) (QName S) +deriving instance UniplateDirect (QName S) +deriving instance UniplateDirect (QOp S) (QName S) +deriving instance UniplateDirect (Pat S) (QName S) +deriving instance UniplateDirect (Binds S) (QName S) +deriving instance UniplateDirect (Alt S) (QName S) +deriving instance UniplateDirect (Stmt S) (QName S) +deriving instance UniplateDirect (Maybe (Exp S)) (QName S) +deriving instance UniplateDirect (FieldUpdate S) (QName S) +deriving instance UniplateDirect (QualStmt S) (QName S) +deriving instance UniplateDirect [QualStmt S] (QName S) +deriving instance UniplateDirect (Type S) (QName S) +deriving instance UniplateDirect (Bracket S) (QName S) +deriving instance UniplateDirect (Splice S) (QName S) +deriving instance UniplateDirect (XAttr S) (QName S) +deriving instance UniplateDirect (PatField S) (QName S) +deriving instance UniplateDirect (RPat S) (QName S) +deriving instance UniplateDirect (PXAttr S) (QName S) +deriving instance UniplateDirect (Maybe (Pat S)) (QName S) +deriving instance UniplateDirect (Decl S) (QName S) +deriving instance UniplateDirect (IPBind S) (QName S) +deriving instance UniplateDirect (GuardedAlts S) (QName S) +deriving instance UniplateDirect (Maybe (Binds S)) (QName S) +deriving instance UniplateDirect (Maybe (Context S)) (QName S) +deriving instance UniplateDirect (QualConDecl S) (QName S) +deriving instance UniplateDirect (Maybe (Deriving S)) (QName S) +deriving instance UniplateDirect (GadtDecl S) (QName S) +deriving instance UniplateDirect (Maybe [ClassDecl S]) (QName S) +deriving instance UniplateDirect (InstHead S) (QName S) +deriving instance UniplateDirect (Maybe [InstDecl S]) (QName S) +deriving instance UniplateDirect (Match S) (QName S) +deriving instance UniplateDirect (Maybe (Type S)) (QName S) +deriving instance UniplateDirect (Rhs S) (QName S) +deriving instance UniplateDirect (Rule S) (QName S) +deriving instance UniplateDirect (GuardedAlt S) (QName S) +deriving instance UniplateDirect (Context S) (QName S) +deriving instance UniplateDirect (ConDecl S) (QName S) +deriving instance UniplateDirect (Deriving S) (QName S) +deriving instance UniplateDirect (ClassDecl S) (QName S) +deriving instance UniplateDirect (InstDecl S) (QName S) +deriving instance UniplateDirect (GuardedRhs S) (QName S) +deriving instance UniplateDirect (Maybe [RuleVar S]) (QName S) +deriving instance UniplateDirect (Asst S) (QName S) +deriving instance UniplateDirect (BangType S) (QName S) +deriving instance UniplateDirect (FieldDecl S) (QName S) +deriving instance UniplateDirect (RuleVar S) (QName S) +!-} diff --git a/src/HSE/Util.hs b/src/HSE/Util.hs --- a/src/HSE/Util.hs +++ b/src/HSE/Util.hs @@ -1,60 +1,51 @@ +{-# LANGUAGE FlexibleContexts #-} -module HSE.Util(module Language.Haskell.Exts.Annotated, module HSE.Util) where +module HSE.Util where import Control.Monad -import Data.Generics -import Data.Generics.Uniplate.Data import Data.List import Data.Maybe -import Language.Haskell.Exts.Annotated hiding (parse, loc, parseFile, paren) - - -type S = SrcSpanInfo -type Module_ = Module S -type Decl_ = Decl S -type Exp_ = Exp S -type Pat_ = Pat S -type Type_ = Type S +import HSE.Type --------------------------------------------------------------------- -- ACCESSOR/TESTER -opExp :: QOp s -> Exp s +opExp :: QOp S -> Exp_ opExp (QVarOp s op) = Var s op opExp (QConOp s op) = Con s op -moduleDecls :: Module s -> [Decl s] +moduleDecls :: Module_ -> [Decl_] moduleDecls (Module _ _ _ _ xs) = xs -moduleName :: Module s -> String +moduleName :: Module_ -> String moduleName (Module _ Nothing _ _ _) = "Main" moduleName (Module _ (Just (ModuleHead _ (ModuleName _ x) _ _)) _ _ _) = x -moduleImports :: Module s -> [ImportDecl s] +moduleImports :: Module_ -> [ImportDecl S] moduleImports (Module _ _ _ x _) = x -modulePragmas :: Module s -> [OptionPragma s] +modulePragmas :: Module_ -> [OptionPragma S] modulePragmas (Module _ _ x _ _) = x -isChar :: Exp s -> Bool +isChar :: Exp_ -> Bool isChar (Lit _ Char{}) = True isChar _ = False -fromChar :: Exp s -> Char +fromChar :: Exp_ -> Char fromChar (Lit _ (Char _ x _)) = x -isString :: Exp s -> Bool +isString :: Exp_ -> Bool isString (Lit _ String{}) = True isString _ = False -fromString :: Exp s -> String +fromString :: Exp_ -> String fromString (Lit _ (String _ x _)) = x isPString (PLit _ String{}) = True; isPString _ = False fromPString (PLit _ (String _ x _)) = x -fromParen :: Exp s -> Exp s +fromParen :: Exp_ -> Exp_ fromParen (Paren _ x) = fromParen x fromParen x = x @@ -66,6 +57,7 @@ isVar Var{} = True; isVar _ = False isApp App{} = True; isApp _ = False isInfixApp InfixApp{} = True; isInfixApp _ = False +isList List{} = True; isList _ = False isAnyApp x = isApp x || isInfixApp x isParen Paren{} = True; isParen _ = False isLambda Lambda{} = True; isLambda _ = False @@ -103,11 +95,11 @@ -- VECTOR APPLICATION -apps :: [Exp s] -> Exp s -apps xs = foldl1 (App $ ann $ head xs) xs +apps :: [Exp_] -> Exp_ +apps = foldl1 (App an) -fromApps :: Exp s -> [Exp s] +fromApps :: Exp_ -> [Exp_] fromApps (App _ x y) = fromApps x ++ [y] fromApps x = [x] @@ -115,48 +107,48 @@ -- Rule for the Uniplate Apps functions -- Given (f a) b, consider the children to be: children f ++ [a,b] -childrenApps :: Data s => Exp s -> [Exp s] +childrenApps :: Exp_ -> [Exp_] childrenApps (App _ x@App{} y) = childrenApps x ++ [y] childrenApps (App _ x y) = children x ++ [y] childrenApps x = children x -descendApps :: Data s => (Exp s -> Exp s) -> Exp s -> Exp s +descendApps :: (Exp_ -> Exp_) -> Exp_ -> Exp_ descendApps f (App s x@App{} y) = App s (descendApps f x) (f y) descendApps f (App s x y) = App s (descend f x) (f y) descendApps f x = descend f x -descendAppsM :: (Data s, Monad m) => (Exp s -> m (Exp s)) -> Exp s -> m (Exp s) +descendAppsM :: Monad m => (Exp_ -> m Exp_) -> Exp_ -> m Exp_ descendAppsM f (App s x@App{} y) = liftM2 (App s) (descendAppsM f x) (f y) descendAppsM f (App s x y) = liftM2 (App s) (descendM f x) (f y) descendAppsM f x = descendM f x -universeApps :: Data s => Exp s -> [Exp s] +universeApps :: Exp_ -> [Exp_] universeApps x = x : concatMap universeApps (childrenApps x) -transformApps :: Data s => (Exp s -> Exp s) -> Exp s -> Exp s +transformApps :: (Exp_ -> Exp_) -> Exp_ -> Exp_ transformApps f = f . descendApps (transformApps f) -transformAppsM :: (Data s, Monad m) => (Exp s -> m (Exp s)) -> Exp s -> m (Exp s) +transformAppsM :: (Monad m) => (Exp_ -> m Exp_) -> Exp_ -> m Exp_ transformAppsM f x = f =<< descendAppsM (transformAppsM f) x --------------------------------------------------------------------- -- UNIPLATE FUNCTIONS -universeS :: (Functor f, Data (f S), Data x) => x -> [f S] +universeS :: Biplate x (f S) => x -> [f S] universeS = universeBi -childrenS :: (Functor f, Data (f S), Data x) => x -> [f S] +childrenS :: Biplate x (f S) => x -> [f S] childrenS = childrenBi -vars :: Data a => a -> [String] +vars :: Biplate a Exp_ => a -> [String] vars xs = [prettyPrint x | Var _ (UnQual _ x) <- universeS xs] -pvars :: Data a => a -> [String] +pvars :: Biplate a Pat_ => a -> [String] pvars xs = [prettyPrint x | PVar _ x <- universeS xs] --------------------------------------------------------------------- diff --git a/src/Hint/Bracket.hs b/src/Hint/Bracket.hs --- a/src/Hint/Bracket.hs +++ b/src/Hint/Bracket.hs @@ -1,54 +1,87 @@ +{-# LANGUAGE ViewPatterns #-} {- +Raise an error if you are bracketing an atom, or are enclosed be a list bracket + -yes = (f x) x -- f x x +-- expression bracket reduction +yes = (f x) x -- @Warning f x x no = f (x x) yes = (foo) -- foo -yes = (f x) ||| y -- f x ||| y -yes = if (f x) then y else z -- if f x then y else z -yes = if x then (f y) else z -- if x then f y else z -yes = (a foo) :: Int -- a foo :: Int +yes = (foo bar) -- @Warning foo bar +yes = foo (bar) -- @Error bar +yes = foo ((x x)) -- @Error (x x) +yes = (f x) ||| y -- @Warning f x ||| y +yes = if (f x) then y else z -- @Warning if f x then y else z +yes = if x then (f y) else z -- @Warning if x then f y else z +yes = (a foo) :: Int -- @Warning a foo :: Int +yes = [(foo bar)] -- @Warning [foo bar] +yes = foo ((x y), z) -- @Warning (x y, z) +-- type bracket reduction +foo :: (Int -> Int) -> Int +foo :: Int -> (Int -> Int) -- @Warning Int -> Int -> Int +foo :: (Maybe Int) -> a -- @Warning Maybe Int -> a +instance Named (DeclHead S) + +-- pattern bracket reduction +foo (True) = 1 +foo ((True)) = 1 -- @Error True + +-- dollar reduction tests no = groupFsts . sortFst $ mr yes = split "to" $ names -- split "to" names yes = white $ keysymbol -- white keysymbol yes = operator foo $ operator -- operator foo operator no = operator foo $ operator bar + +-- $/bracket rotation tests yes = (b $ c d) ++ e -- b (c d) ++ e yes = (a b $ c d) ++ e -- a b (c d) ++ e no = (f . g $ a) ++ e -yes = [(foo bar)] -- [foo bar] -} module Hint.Bracket where -import Control.Arrow import Type import Hint import HSE.All +import Data.Maybe bracketHint :: DeclHint -bracketHint _ _ = concatMap bracketExp . childrenBi +bracketHint _ _ x = + concatMap (\x -> bracket True x ++ dollar x) (childrenBi x :: [Exp_]) ++ + concatMap (bracket False) (childrenBi x :: [Type_]) ++ + concatMap (bracket False) (childrenBi x :: [Pat_]) -bracketExp :: Exp_ -> [Idea] -bracketExp x = - [g x (fromParen x) | isParen x] ++ f x + +bracket :: (Annotated a, Uniplate (a S), Pretty (a S), Brackets (a S)) => Bool -> a S -> [Idea] +bracket bad = f Nothing where - f x = testDirect x ++ testDollar x ++ concatMap f (children x) - g = warn "Redundant brackets" + msg = "Redundant bracket" - testDirect x = [g x y | let y = descendBracket (isParen &&& fromParen) x, x /=~= y] + -- f (Maybe (index, parent, gen)) child + f Just{} o@(remParen -> Just x) | isAtom x = err msg o x : g x + f Nothing o@(remParen -> Just x) | bad = warn msg o x : g x + f (Just (i,o,gen)) (remParen -> Just x) | not $ needBracket i o x = warn msg o (gen x) : g x + f _ x = g x - testDollar x = - [idea Error "Redundant $" x y | InfixApp _ a d b <- [x], opExp d ~= "$" - ,let y = App an a b, not $ needBracket 0 y a, not $ needBracket 1 y b] - ++ - [idea Error "Redundant $" x (t y) - |(t, Paren _ (InfixApp _ a1 op1 a2)) <- infixes x - ,opExp op1 ~= "$", isVar a1 || isApp a1 || isParen a1, not $ isAtom a2 - ,let y = App an a1 (Paren an a2)] + g :: (Annotated a, Uniplate (a S), Pretty (a S), Brackets (a S)) => a S -> [Idea] + g o = concat [f (Just (i,o,gen)) x | (i,(x,gen)) <- zip [0..] $ holes o] + + +dollar :: Exp_ -> [Idea] +dollar = concatMap f . universe + where + msg = warn "Redundant $" + f x = [msg x y | InfixApp _ a d b <- [x], opExp d ~= "$" + ,let y = App an a b, not $ needBracket 0 y a, not $ needBracket 1 y b] + ++ + [msg x (t y) |(t, Paren _ (InfixApp _ a1 op1 a2)) <- infixes x + ,opExp op1 ~= "$", isVar a1 || isApp a1 || isParen a1, not $ isAtom a2 + ,let y = App an a1 (Paren an a2)] -- return both sides, and a way to put them together again diff --git a/src/Hint/Extensions.hs b/src/Hint/Extensions.hs --- a/src/Hint/Extensions.hs +++ b/src/Hint/Extensions.hs @@ -99,7 +99,7 @@ hasT t x = not $ null (universeBi x `asTypeOf` [t]) hasT2 ~(t1,t2) = hasT t1 & hasT t2 -hasS :: (Data (f S), Data x, Functor f) => (f S -> Bool) -> x -> Bool +hasS :: Biplate x (f S) => (f S -> Bool) -> x -> Bool hasS test = any test . universeBi has f = any f . universeBi diff --git a/src/Hint/Lambda.hs b/src/Hint/Lambda.hs --- a/src/Hint/Lambda.hs +++ b/src/Hint/Lambda.hs @@ -52,7 +52,7 @@ lambdaExp :: Exp_ -> [Idea] -lambdaExp o@(Lambda _ [v] y) | isAtom y, Just x <- f v, x `notElem` universeBi y = +lambdaExp o@(Lambda _ [v] y) | isAtom y, Just x <- f v, x `notElem` vars y = [warn "Use const" o res] where f (view -> PVar_ x) = Just x @@ -65,7 +65,7 @@ lambdaExp o@(Paren _ (App _ (Var _ x@(UnQual _ Symbol{})) y)) | isAtom y = [warn "Operator rotate" o $ LeftSection an y (QVarOp an x)] lambdaExp o@(App _ (App _ (App _ flp x) y) z) | flp ~= "flip" = - [idea Error "Redundant flip" o $ App an (App an x z) y] + [err "Redundant flip" o $ App an (App an x z) y] lambdaExp _ = [] diff --git a/src/Hint/Match.hs b/src/Hint/Match.hs --- a/src/Hint/Match.hs +++ b/src/Hint/Match.hs @@ -24,20 +24,22 @@ --------------------------------------------------------------------- -- PERFORM MATCHING +fmapAn = fmap (const an) + readMatch :: [Setting] -> DeclHint -readMatch = findIdeas . filter isMatchExp +readMatch settings = findIdeas [m{lhs = fmapAn $ lhs m} | m@MatchExp{} <- settings] findIdeas :: [Setting] -> NameMatch -> Module S -> Decl_ -> [Idea] findIdeas matches nm _ decl = [ idea (rankS m) (hintS m) x y - | x <- universeBi decl, not $ isParen x - , m <- matches, Just y <- [matchIdea nm m x]] + | x <- universeBi decl, not $ isParen x, let x2 = fmapAn x + , m <- matches, Just y <- [matchIdea nm m x2]] matchIdea :: NameMatch -> Setting -> Exp_ -> Maybe Exp_ matchIdea nm MatchExp{lhs=lhs,rhs=rhs,side=side} x = do - u <- unify nm (fmap (const an) lhs) (fmap (const an) x) + u <- unify nm lhs x u <- check u guard $ checkSide side u let rhs2 = subst u rhs @@ -46,18 +48,28 @@ -- unify a b = c, a[c] = b +-- note: App is unrolled because it's really common 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) unify nm x y | isParen x || isParen y = unify nm (fromParen x) (fromParen y) unify nm (Var _ (fromNamed -> v)) y | isUnifyVar v = Just [(v,y)] unify nm (Var _ x) (Var _ y) | nm x y = Just [] -unify nm x y | ((==) `on` descend (const $ toNamed "_")) x y = concatZipWithM (unify nm) (children x) (children y) +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 _ _ = Nothing + +-- types that are not already handled in unify +{-# INLINE isOther #-} +isOther Do{} = False +isOther Lambda{} = False +isOther Var{} = False +isOther App{} = False +isOther _ = True unifyStmt :: NameMatch -> Stmt S -> Stmt S -> Maybe [(String,Exp_)] diff --git a/src/Hint/Monad.hs b/src/Hint/Monad.hs --- a/src/Hint/Monad.hs +++ b/src/Hint/Monad.hs @@ -48,15 +48,14 @@ monadExp :: Exp_ -> [Idea] monadExp x = case x of (view -> App2 op x1 x2) | op ~= ">>" -> f x1 - Do _ xs -> [idea Error "Redundant return" x y | Just y <- [monadReturn xs]] ++ - [idea Error "Use join" x (Do an y) | Just y <- [monadJoin xs]] ++ - [idea Error "Redundant do" x y | [Qualifier _ y] <- [xs]] ++ - [idea Error "Use let" x (Do an y) | Just y <- [monadLet xs]] ++ + Do _ xs -> [err "Redundant return" x y | Just y <- [monadReturn xs]] ++ + [err "Use join" x (Do an y) | Just y <- [monadJoin xs]] ++ + [err "Redundant do" x y | [Qualifier _ y] <- [xs]] ++ + [err "Use let" x (Do an y) | Just y <- [monadLet xs]] ++ concat [f x | Qualifier _ x <- init xs] _ -> [] where - f x = [idea Error ("Use " ++ name) x y - |Just (name,y) <- [monadCall x]] + f x = [err ("Use " ++ name) x y | Just (name,y) <- [monadCall x]] -- see through Paren and down if/case etc diff --git a/src/Hint/Naming.hs b/src/Hint/Naming.hs --- a/src/Hint/Naming.hs +++ b/src/Hint/Naming.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleContexts #-} {- Suggest the use of camelCase @@ -88,6 +89,8 @@ g [] = [] -replaceNames :: Data a => [(String,String)] -> a -> a +replaceNames :: Biplate a (Name S) => [(String,String)] -> a -> a replaceNames rep = descendBi f - where f x = fromMaybe x $ lookup x rep + where f (Ident _ x) = Ident an $ fromMaybe x $ lookup x rep + f x = x + diff --git a/src/Settings.hs b/src/Settings.hs --- a/src/Settings.hs +++ b/src/Settings.hs @@ -8,7 +8,6 @@ import Data.List import System.FilePath import Util -import Data.Generics.Uniplate.Data -- Given a list of hint files to start from @@ -63,6 +62,7 @@ readSetting (PatBind _ (PVar _ name) _ bod bind) = readSetting $ FunBind an [Match an name [PLit an (String an "" "")] bod bind] readSetting (FunBind _ xs) | length xs /= 1 = concatMap (readSetting . FunBind an . (:[])) xs +readSetting (SpliceDecl an (App _ (Var _ x) (Lit _ y))) = readSetting $ FunBind an [Match an (toNamed $ fromNamed x) [PLit an y] (UnGuardedRhs an $ Lit an $ String an "" "") Nothing] readSetting x = error $ "Failed to read hint " ++ prettyPrint (getPointLoc $ ann x) ++ "\n" ++ prettyPrint x diff --git a/src/Test.hs b/src/Test.hs --- a/src/Test.hs +++ b/src/Test.hs @@ -35,7 +35,7 @@ src <- doesDirectoryExist "src/Hint" (fail,total) <- fmap ((sum *** sum) . unzip) $ sequence $ [runTestDyn dataDir (dataDir h) | h <- dataLs, takeExtension h == ".hs", not $ "HLint" `isPrefixOf` takeBaseName h] ++ - [runTest h ("src/Hint" name <.> "hs") | (name,h) <- staticHints, src] + [runTest id h ("src/Hint" name <.> "hs") | (name,h) <- staticHints, src] unless src $ putStrLn "Warning, couldn't find source code, so non-hint tests skipped" if fail == 0 then putStrLn $ "Tests passed (" ++ show total ++ ")" @@ -49,9 +49,8 @@ let bad = [putStrLn $ "No name for the hint " ++ prettyPrint (lhs x) | x@MatchExp{} <- settings, hintS x == defaultName] sequence_ bad - (f1,t1) <- runTestTypes settings - (f2,t2) <- runTest (dynamicHints settings) file + (f2,t2) <- runTest (classify settings) (dynamicHints settings) file return (length bad + f1 + f2, t1 + t2) @@ -89,8 +88,8 @@ -- return the number of fails/total -runTest :: Hint -> FilePath -> IO (Int,Int) -runTest hint file = do +runTest :: (Idea -> Idea) -> Hint -> FilePath -> IO (Int,Int) +runTest classify hint file = do tests <- parseTestFile file let failures = concatMap f tests putStr $ unlines failures @@ -104,13 +103,18 @@ "WANTED: " ++ fromMaybe "" out ++ "\n\n" | not good] where - ideas = applyHintStr parseFlags [hint] file inp + ideas = map classify $ applyHintStr parseFlags [hint] file inp good = case out of - Nothing -> ideas == [] + Nothing -> null ideas Just x -> length ideas == 1 && length (show ideas) >= 0 && -- force, mainly for hpc not (isParseError (head ideas)) && - (x == "???" || on (==) norm (to $ head ideas) x) + match x (head ideas) + + match "???" _ = True + match x y | "@" `isPrefixOf` x = a == show (rank y) && match (dropWhile isSpace b) y + where (a,b) = break isSpace $ tail x + match x y = on (==) norm (to y) x -- FIXME: Should use a better check for expected results norm = filter $ \x -> not (isSpace x) && x /= ';' diff --git a/src/Type.hs b/src/Type.hs --- a/src/Type.hs +++ b/src/Type.hs @@ -66,6 +66,7 @@ idea rank hint from to = rawIdea rank hint (toSrcLoc $ ann from) (f from) (f to) where f = dropWhile isSpace . prettyPrint warn mr = idea Warning mr +err mr = idea Error mr -- Any 1-letter variable names are assumed to be unification variables