packages feed

haskell-tools-builtin-refactorings 1.0.0.4 → 1.0.1.1

raw patch · 375 files changed

+3467/−4375 lines, 375 filesdep +aesondep +classyplatedep +deepseqdep −old-timedep −polyparsedep ~Cabal

Dependencies added: aeson, classyplate, deepseq, minisat-solver

Dependencies removed: old-time, polyparse

Dependency ranges changed: Cabal

Files

Language/Haskell/Tools/Refactor/Builtin.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
-module Language.Haskell.Tools.Refactor.Builtin ( builtinRefactorings ) where
+{-# LANGUAGE FlexibleContexts, MonoLocalBinds #-}
 
-import Language.Haskell.Tools.Refactor (RefactoringChoice)
+module Language.Haskell.Tools.Refactor.Builtin ( builtinRefactorings, builtinQueries ) where
+
+import Language.Haskell.Tools.Refactor (RefactoringChoice, QueryChoice)
 import Language.Haskell.Tools.Refactor.Builtin.ExtractBinding (extractBindingRefactoring)
 import Language.Haskell.Tools.Refactor.Builtin.FloatOut (floatOutRefactoring)
 import Language.Haskell.Tools.Refactor.Builtin.GenerateExports (generateExportsRefactoring)
@@ -10,6 +11,8 @@ import Language.Haskell.Tools.Refactor.Builtin.OrganizeExtensions (organizeExtensionsRefactoring, projectOrganizeExtensionsRefactoring)
 import Language.Haskell.Tools.Refactor.Builtin.OrganizeImports (organizeImportsRefactoring, projectOrganizeImportsRefactoring)
 import Language.Haskell.Tools.Refactor.Builtin.RenameDefinition (renameDefinitionRefactoring)
+import Language.Haskell.Tools.Refactor.Builtin.GetMatches (getMatchesQuery)
+import Language.Haskell.Tools.Refactor.Builtin.AutoCorrect
 
 builtinRefactorings :: [RefactoringChoice]
 builtinRefactorings
@@ -23,4 +26,8 @@     , extractBindingRefactoring
     , organizeExtensionsRefactoring
     , projectOrganizeExtensionsRefactoring
+    , autoCorrectRefactoring
     ]
+
+builtinQueries :: [QueryChoice]
+builtinQueries = [ getMatchesQuery ]
+ Language/Haskell/Tools/Refactor/Builtin/AutoCorrect.hs view
@@ -0,0 +1,140 @@+{-# LANGUAGE FlexibleContexts, MonoLocalBinds, ScopedTypeVariables, TupleSections, ViewPatterns #-}
+
+module Language.Haskell.Tools.Refactor.Builtin.AutoCorrect (autoCorrect, tryItOut, autoCorrectRefactoring) where
+
+import SrcLoc
+import GHC
+import Type
+-- import Outputable
+-- 
+import Control.Monad.State
+import Control.Reference
+import Data.List
+import Data.Maybe
+-- 
+import Language.Haskell.Tools.Refactor as HT
+-- 
+import Language.Haskell.Tools.PrettyPrint
+
+autoCorrectRefactoring :: RefactoringChoice
+autoCorrectRefactoring = SelectionRefactoring "AutoCorrect" (localRefactoring . autoCorrect)
+
+tryItOut :: String -> String -> IO ()
+tryItOut mod sp = tryRefactor (localRefactoring . autoCorrect) mod sp
+
+autoCorrect :: RealSrcSpan -> LocalRefactoring
+autoCorrect sp mod
+  = do res <- mapM (\f -> f sp mod) [reParen, reOrder]
+       case catMaybes res of mod':_ -> return mod'
+                             []     -> refactError "Cannot auto-correct the selection."
+
+--------------------------------------------------------------------------------------------
+
+reOrder :: RealSrcSpan -> HT.Module -> LocalRefactor (Maybe HT.Module)
+reOrder sp mod = do let accessibleMods = semanticsModule mod : semanticsPrelTransMods mod ++ concatMap semanticsTransMods (mod ^? modImports & annList :: [HT.ImportDecl])
+                        rng:_ = map getRange (mod ^? nodesContained sp :: [Expr])
+                    insts <- liftGhc $ fst <$> getInstances accessibleMods
+                    (res,done) <- liftGhc $ flip runStateT False ((nodesContained sp & filtered ((==rng) . getRange) !~ reOrderExpr insts) mod)
+                    return (if done then Just res else Nothing)
+
+reOrderExpr :: [ClsInst] -> Expr -> StateT Bool Ghc Expr
+reOrderExpr insts e@(App (App f a1) a2)
+  = do funTy <- lift $ typeExpr f
+       arg1Ty <- lift $ typeExpr a1
+       arg2Ty <- lift $ typeExpr a2
+       -- liftIO $ putStrLn $ (show $ isJust $ appTypeMatches insts funTy [arg1Ty, arg2Ty]) ++ " " ++ (show $ isJust $ appTypeMatches insts funTy [arg2Ty, arg1Ty]) ++ " " ++ (showSDocUnsafe $ ppr $ funTy) ++ " " ++ (showSDocUnsafe $ ppr $ arg1Ty) ++ " " ++ (showSDocUnsafe $ ppr $ arg2Ty)
+       if not (isJust (appTypeMatches insts funTy [arg1Ty, arg2Ty])) && isJust (appTypeMatches insts funTy [arg2Ty, arg1Ty])
+          then put True >> return (exprArg .= a1 $ exprFun&exprArg .= a2 $ e)
+          else return e
+reOrderExpr insts e@(InfixApp lhs op rhs) 
+  = do let funTy = idType $ semanticsId (op ^. operatorName)
+       lhsTy <- lift $ typeExpr lhs
+       rhsTy <- lift $ typeExpr rhs
+       -- liftIO $ putStrLn $ (show $ isJust $ appTypeMatches insts funTy [lhsTy, rhsTy]) ++ " " ++ (show $ isJust $ appTypeMatches insts funTy [lhsTy, rhsTy]) ++ " " ++ (showSDocUnsafe $ ppr $ funTy) ++ " " ++ (showSDocUnsafe $ ppr $ lhsTy) ++ " " ++ (showSDocUnsafe $ ppr $ rhsTy)
+       if not (isJust (appTypeMatches insts funTy [lhsTy, rhsTy])) && isJust (appTypeMatches insts funTy [rhsTy, lhsTy])
+          then put True >> return (exprLhs .= rhs $ exprRhs .= lhs $ e)
+          else return e
+reOrderExpr _ e = return e
+
+------------------------------------------------------------------------------------------
+
+reParen :: RealSrcSpan -> HT.Module -> LocalRefactor (Maybe HT.Module)
+reParen sp mod = do let accessibleMods = semanticsModule mod : semanticsPrelTransMods mod ++ concatMap semanticsTransMods (mod ^? modImports & annList :: [HT.ImportDecl])
+                        rng:_ = map getRange (mod ^? nodesContained sp :: [Expr])
+                    insts <- liftGhc $ fst <$> getInstances accessibleMods
+                    (res,done) <- liftGhc $ flip runStateT False ((nodesContained sp & filtered ((==rng) . getRange) !~ reParenExpr insts) mod)
+                    return (if done then Just res else Nothing)
+
+reParenExpr :: [ClsInst] -> Expr -> StateT Bool Ghc Expr
+reParenExpr insts e = do atoms <- lift $ extractAtoms e
+                         case correctParening insts $ map (_2 .- Left) atoms of
+                           [e'] -> put True >> return (wrapAtom e')
+                           [] -> return e
+                           ls -> -- TODO: choose the best one
+                                 error $ "multiple correct parentheses were found: " ++ intercalate ", " (map (either prettyPrintAtom prettyPrint) ls)
+
+data Atom = NameA HT.Name
+          | OperatorA Operator
+          | LiteralA Literal
+
+prettyPrintAtom :: Atom -> String
+prettyPrintAtom (NameA n) = prettyPrint n
+prettyPrintAtom (OperatorA o) = prettyPrint o
+prettyPrintAtom (LiteralA l) = prettyPrint l
+
+type Build = Either Atom Expr
+
+extractAtoms :: Expr -> Ghc [(GHC.Type, Atom)]
+extractAtoms e = do lits <- mapM (\l -> (, LiteralA l) <$> literalType l) (e ^? biplateRef)
+                    return $ sortOn (srcSpanStart . atomRange . snd) 
+                           $ map (\n -> (idType $ semanticsId (n ^. simpleName), NameA n)) (e ^? biplateRef) 
+                               ++ map (\o -> (idType $ semanticsId (o ^. operatorName), OperatorA o)) (e ^? biplateRef) 
+                               ++ lits
+
+atomRange :: Atom -> SrcSpan
+atomRange (NameA n) = getRange n
+atomRange (OperatorA n) = getRange n
+atomRange (LiteralA n) = getRange n
+
+wrapAtom :: Build -> Expr
+wrapAtom (Right e) = e
+wrapAtom (Left (NameA n)) = mkVar n
+wrapAtom (Left (OperatorA (NormalOp o))) = mkVar (mkParenName o)
+wrapAtom (Left (OperatorA (BacktickOp n))) = mkVar (mkNormalName n)
+wrapAtom (Left (LiteralA l)) = mkLit l
+
+correctParening :: [ClsInst] -> [(GHC.Type, Build)] -> [Build]
+correctParening _ [(_,e)] = [e]
+correctParening insts ls = concatMap (correctParening insts) (reduceAtoms insts ls)
+
+reduceAtoms :: [ClsInst] -> [(GHC.Type, Build)] -> [[(GHC.Type, Build)]]
+reduceAtoms _ [(t,e)] = [[(t,e)]]
+reduceAtoms insts ls = concatMap (reduceBy insts ls) [0 .. length ls - 2]
+
+reduceBy :: [ClsInst] -> [(GHC.Type, Build)] -> Int -> [[(GHC.Type, Build)]]
+reduceBy insts (zip [0..] -> ls) i = maybeToList (reduceFunctionApp ls i) ++ maybeToList (reduceOperatorApp ls i)
+  where reduceFunctionApp ls i | Just (funT, fun) <- lookup i ls
+                               , Just (argT, arg) <- lookup (i+1) ls
+                               , Just (subst, resTyp) <- appTypeMatches insts funT [argT]
+          = Just $ map ((_1 .- substTy subst) . snd) (take i ls) 
+                     ++ [(resTyp, mkParen' (mkApp' fun arg))] 
+                     ++ map ((_1 .- substTy subst) . snd) (drop (i + 2) ls)
+        reduceFunctionApp _ _ = Nothing
+        
+        reduceOperatorApp ls i | Just (opT, Left (OperatorA op)) <- lookup i ls
+                               , Just (lArgT, lArg) <- lookup (i-1) ls
+                               , Just (rArgT, rArg) <- lookup (i+1) ls
+                               , Just (subst, resTyp) <- appTypeMatches insts opT [lArgT, rArgT]
+          = Just $ map ((_1 .- substTy subst) . snd) (take (i - 1) ls) 
+                     ++ [(resTyp, mkParen' (mkInfixApp' lArg op rArg))] 
+                     ++ map ((_1 .- substTy subst) . snd) (drop (i + 2) ls)
+        reduceOperatorApp _ _ = Nothing
+
+mkApp' :: Build -> Build -> Build
+mkApp' (wrapAtom -> f) (wrapAtom -> a) = Right $ mkApp f a
+
+mkInfixApp' :: Build -> Operator -> Build -> Build
+mkInfixApp' (wrapAtom -> lhs) op (wrapAtom -> rhs) = Right $ mkInfixApp lhs op rhs
+
+mkParen' :: Build -> Build
+mkParen' (wrapAtom -> e) = Right $ mkParen e
Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers.hs view
@@ -1,25 +1,32 @@ module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers
-  ( module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.RecordWildCardsChecker
-  , module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.FlexibleInstancesChecker
-  , module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.DerivingsChecker
-  , module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.BangPatternsChecker
-  , module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.PatternSynonymsChecker
-  , module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.TemplateHaskellChecker
-  , module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.ViewPatternsChecker
-  , module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.LambdaCaseChecker
-  , module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.TupleSectionsChecker
-  , module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.UnboxedTuplesChecker
-  , module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.MagicHashChecker
+  ( module X
   ) where
 
-import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.BangPatternsChecker
-import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.DerivingsChecker
-import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.FlexibleInstancesChecker
-import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.LambdaCaseChecker
-import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.MagicHashChecker
-import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.PatternSynonymsChecker
-import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.RecordWildCardsChecker
-import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.TemplateHaskellChecker
-import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.TupleSectionsChecker
-import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.UnboxedTuplesChecker
-import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.ViewPatternsChecker
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.ArrowsChecker                  as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.BangPatternsChecker            as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.ConstraintKindsChecker         as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.ConstrainedClassMethodsChecker as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.DefaultSignaturesChecker       as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.DerivingsChecker               as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.ExplicitForAllChecker          as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.ExplicitNamespacesChecker      as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.FlexibleInstancesChecker       as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.FunctionalDependenciesChecker  as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.GADTsChecker                   as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.KindSignaturesChecker          as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.LambdaCaseChecker              as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.MagicHashChecker               as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.MultiParamTypeClassesChecker   as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.MultiWayIfChecker              as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.OverloadedStringsChecker       as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.ParallelListCompChecker        as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.PatternSynonymsChecker         as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.RecordWildCardsChecker         as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.RecursiveDoChecker             as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.TemplateHaskellChecker         as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.TupleSectionsChecker           as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.TypeFamiliesChecker            as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.TypeOperatorsChecker           as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.TypeSynonymInstancesChecker    as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.UnboxedTuplesChecker           as X
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.ViewPatternsChecker            as X
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/ArrowsChecker.hs view
@@ -0,0 +1,12 @@+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.ArrowsChecker where
+
+import Language.Haskell.Tools.Refactor
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+
+chkArrowsExpr :: CheckNode Expr
+-- chkArrowsExpr e@Proc{}     = addOccurence Arrows e
+chkArrowsExpr e@ArrowApp{} = addOccurence Arrows e
+chkArrowsExpr e            = return e
+
+chkArrowsCmd :: CheckNode Cmd
+chkArrowsCmd = addOccurence Arrows
Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/BangPatternsChecker.hs view
@@ -1,12 +1,7 @@-{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
-
 module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.BangPatternsChecker where
 
 import Language.Haskell.Tools.Refactor
 import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
-
--- NOTE: Here we implicitly constrained the type with ExtDomain.
---       but we don't really need any.
 
 chkBangPatterns :: CheckNode Pattern
 chkBangPatterns = conditional chkBangPatterns' BangPatterns
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/ConstrainedClassMethodsChecker.hs view
@@ -0,0 +1,60 @@+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.ConstrainedClassMethodsChecker where
+
+import qualified GHC
+import qualified Class  as GHC
+import qualified VarSet as GHC
+import qualified TcType as GHC
+
+import Control.Monad.Trans.Maybe (MaybeT(..))
+
+import Language.Haskell.Tools.Refactor
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+
+chkConstrainedClassMethodsDecl :: CheckNode Decl
+chkConstrainedClassMethodsDecl = conditional chkCCMDecl ConstrainedClassMethods
+  where chkCCMDecl cd@(ClassDecl _ dh _ _) = chkCCMDeclHead dh >> return cd
+        chkCCMDecl x = return x
+
+-- | Check a DeclHead for ConstrainedClassMethods.
+-- Adds the extension if it is needed or the lookup fails.
+chkCCMDeclHead :: CheckNode DeclHead
+chkCCMDeclHead dh = do
+  mNeedsCCM <- runMaybeT . chkCCMDeclHead' $ dh
+  case mNeedsCCM of
+    Just False -> return dh
+    _          -> addOccurence ConstrainedClassMethods dh
+
+
+-- | Helper function for chkCCMDeclHead.
+-- True  <=> Lookup is succesful and ConstrainedClassMethods is needed
+-- False <=> Lookup is succesful, but CCM is not needed, or the argument is not a class DeclHead
+-- fails <=> Lookup is unsuccesful (either name or type lookup)
+chkCCMDeclHead' :: DeclHead -> MaybeT ExtMonad Bool
+chkCCMDeclHead' dh = do
+  sname   <- declHeadSemName dh
+  tything <- MaybeT . GHC.lookupName $ sname
+  case tything of
+    GHC.ATyCon tc | GHC.isClassTyCon tc -> liftMaybe . fmap classNeedsCCM . GHC.tyConClass_maybe $ tc
+    _ -> return False
+
+
+-- | Decides whether a class really needs the ConstrainedClassMethods extension
+-- A class needs CCM iff at least one of its class methods
+-- has a constraint with a non-empty type variable set, that contains only class type variables.
+classNeedsCCM :: GHC.Class -> Bool
+classNeedsCCM cls = any methodNeedsCCM methods
+  where
+    methods     = GHC.classMethods cls
+    tyvars      = GHC.classTyVars cls
+    clsTyVarSet = GHC.mkVarSet tyvars
+
+    methodNeedsCCM :: GHC.Id -> Bool
+    methodNeedsCCM methodId = any constraintNeedsCCM constraints
+      where
+        (_,_,tau)         = GHC.tcSplitMethodTy . GHC.idType $ methodId
+        (_,constraints,_) = GHC.tcSplitNestedSigmaTys tau
+
+        constraintNeedsCCM :: GHC.TcPredType -> Bool
+        constraintNeedsCCM pred = not (GHC.isEmptyVarSet predTyVars)
+                                  && predTyVars `GHC.subVarSet` clsTyVarSet
+          where predTyVars = GHC.tyCoVarsOfType pred
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/ConstraintKindsChecker.hs view
@@ -0,0 +1,48 @@+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.ConstraintKindsChecker where
+
+import Name as GHC (isTyVarName)
+import Kind as GHC (returnsConstraintKind)
+
+import Control.Reference ((^?), (^.), (&))
+
+import Data.Generics.Uniplate.Data()
+import Data.Generics.Uniplate.Operations
+
+import Language.Haskell.Tools.Refactor
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+
+
+chkConstraintKindsDecl :: CheckNode Decl
+chkConstraintKindsDecl = conditional chkConstraintKindsDecl' ConstraintKinds
+
+chkConstraintKindsDecl' :: CheckNode Decl
+chkConstraintKindsDecl' d@(TypeDecl dh rhs)
+  -- Has any constraints of form (x t1 t2)
+  | ctxts <- universeBi rhs :: [Context]
+  , any hasTyVarHeadAsserts ctxts
+  = addOccurence ConstraintKinds d
+  -- Right-hand side has kind Constraint
+  | otherwise = do
+  let ty = typeOrKindFromId . declHeadQName $ dh
+  if hasConstraintKind ty || returnsConstraintKind ty
+     then addOccurence ConstraintKinds d
+     else return d
+chkConstraintKindsDecl' d = return d
+
+hasTyVarHeadAsserts :: Context -> Bool
+hasTyVarHeadAsserts = hasAnyTyVarHeads . (^. contextAssertion)
+
+hasAnyTyVarHeads :: Assertion -> Bool
+hasAnyTyVarHeads (ClassAssert n _)
+  | Just n' <- semanticsName n = isTyVarName n'
+  | otherwise               = False
+hasAnyTyVarHeads ta@TupleAssert{}
+  | Just assertions <- ta ^? innerAsserts & annListElems
+  = any hasAnyTyVarHeads assertions
+hasAnyTyVarHeads _ = False
+
+declHeadQName :: DeclHead -> QualifiedName
+declHeadQName (NameDeclHead n)       = n ^. simpleName
+declHeadQName (ParenDeclHead dh)     = declHeadQName dh
+declHeadQName (DeclHeadApp dh _)     = declHeadQName dh
+declHeadQName (InfixDeclHead _ op _) = op ^. operatorName
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/DefaultSignaturesChecker.hs view
@@ -0,0 +1,8 @@+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.DefaultSignaturesChecker where
+
+import Language.Haskell.Tools.Refactor
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+
+chkDefaultSigs :: CheckNode ClassElement
+chkDefaultSigs ce@ClsDefaultSig{} = addOccurence DefaultSignatures ce
+chkDefaultSigs x = return x
Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/DerivingsChecker.hs view
@@ -1,5 +1,6 @@-{-# LANGUAGE FlexibleContexts, MultiWayIf, RankNTypes, TypeFamilies, ViewPatterns #-}
+{-# LANGUAGE FlexibleContexts, MultiWayIf, ViewPatterns #-}
 
+
 {-
   NOTE: We need Decl level checking in order to gain extra information
         from the newtype and data keywords.
@@ -27,13 +28,11 @@ import Language.Haskell.Tools.AST
 import Language.Haskell.Tools.Refactor as Refact hiding (Enum)
 import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad as Ext
-import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Utils.TypeLookup
 
 import Control.Monad.Trans.Maybe (MaybeT(..))
 import qualified Data.Map as Map (fromList, lookup)
 
 import qualified GHC (Name(..), isNewTyCon)
-import qualified Name as GHC (Name)
 import PrelNames
 import THNames (liftClassName)
 
@@ -188,7 +187,7 @@ nameFromStock :: InstanceHead -> Maybe GHC.Name
 nameFromStock x
   | InstanceHead name <- skipParens x,
-    Just sname <- getSemName name,
+    Just sname <- semanticsName name,
     isStockClass sname
     = Just sname
   | otherwise = Nothing
@@ -223,7 +222,6 @@   | Just strat' <- strat = do
     addOccurence_  Ext.DerivingStrategies d
     addOccurence_  Ext.StandaloneDeriving d
-    chkSynonym ty
     chkStrat strat' cls
     return d
   | otherwise = do
@@ -254,9 +252,6 @@ {-
   NOTE: Returns false if the type is certainly not a type synonym.
         Returns true if it is a synonym for a newtype or it could not have been looked up.
-  NOTE: It always has the following side-effects:
-        - If the input is a type synonym, then adds TypeSynonymInstances
-          (regardless of it being a newtype or not)
 
   This behaviour will produce false positives.
   This is desirable since the underlying type might be a newtype
@@ -270,6 +265,4 @@     Just tycon -> isSynNewType' tycon
   where isSynNewType' x = case lookupSynDef x of
                             Nothing  -> return False
-                            Just def -> do
-                                        addOccurence_ TypeSynonymInstances t
-                                        return (GHC.isNewTyCon def)
+                            Just def -> return (GHC.isNewTyCon def)
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/ExplicitForAllChecker.hs view
@@ -0,0 +1,27 @@+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.ExplicitForAllChecker where
+
+import Control.Reference ((^.))
+
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.Refactor
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+
+chkExplicitForAllType :: CheckNode Type
+chkExplicitForAllType = conditional chkType ExplicitForAll
+  where chkType :: CheckNode Type
+        chkType t
+          | UTyForall{} <- t ^. element
+          = addOccurence ExplicitForAll t
+          | otherwise = return t
+
+chkExplicitForAllConDecl :: CheckNode ConDecl
+chkExplicitForAllConDecl = conditional (chkQuantifiedTyVarsWith (^. conTypeArgs)) ExplicitForAll
+
+chkExplicitForAllGadtConDecl :: CheckNode GadtConDecl
+chkExplicitForAllGadtConDecl = conditional (chkQuantifiedTyVarsWith (^. gadtConTypeArgs)) ExplicitForAll
+
+chkQuantifiedTyVarsWith :: HasRange a => (a -> TyVarList) -> CheckNode a
+chkQuantifiedTyVarsWith getTyVars conDecl =
+  if (annLength . getTyVars $ conDecl) > 0
+    then addOccurence ExplicitForAll conDecl
+    else return conDecl
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/ExplicitNamespacesChecker.hs view
@@ -0,0 +1,14 @@+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.ExplicitNamespacesChecker where
+
+import Control.Reference ((^.))
+
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.Refactor
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+
+chkExplicitNamespacesIESpec :: CheckNode IESpec
+chkExplicitNamespacesIESpec = conditional chkIESpec ExplicitNamespaces
+  where chkIESpec :: CheckNode IESpec
+        chkIESpec x@(IESpec (AnnJust imod) _ _)
+          | UImportType <- imod ^. element = addOccurence ExplicitNamespaces x
+        chkIESpec x = return x
Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/FlexibleInstancesChecker.hs view
@@ -1,102 +1,84 @@-{-# LANGUAGE FlexibleContexts, MultiWayIf, TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts, GADTs, MultiWayIf #-}
 
 module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.FlexibleInstancesChecker where
 
-import Control.Reference ((^.), (!~), biplateRef)
-import Language.Haskell.Tools.Refactor as Refact
-import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
-import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Utils.TypeLookup (lookupSynDefM)
+import qualified GHC
+import qualified Class   as GHC
+import qualified TcType  as GHC
+import qualified Type    as GHC
+import qualified TyCoRep as GHC
+import qualified Name    as GHC (isTyVarName, isTyConName, isWiredInName)
 
+import Util (equalLength)
+import ListSetOps (hasNoDups)
 
+import Data.Maybe (mapMaybe)
 import Control.Monad.Trans.Maybe (MaybeT(..))
+
 import Data.Data (Data(..))
-import Data.List (nub)
+import Data.List (nubBy)
+import Data.Function (on)
+import Control.Reference ((^.), (.-), biplateRef)
 
-import Name as GHC (isTyVarName, isTyConName, isWiredInName)
+import Language.Haskell.Tools.Refactor
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad hiding (StandaloneDeriving)
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.TypeSynonymInstancesChecker
 
+
 {-# ANN module "HLint: ignore Redundant bracket" #-}
 
 -- TODO: write "deriving instance ..." tests (should work)
--- TODO: should expand type synonyms  !!!
-
--- NOTE: Here we implicitly constrained the type with ExtDomain.
---       but we only really need HasNameInfo.
-
--- NOTE: We need Decl level checking, in order to distinguish
---       class instances from data and type family instances.
-
-chkFlexibleInstances :: CheckNode Decl
-chkFlexibleInstances = conditional chkFlexibleInstances' FlexibleInstances
-
-chkFlexibleInstances' :: CheckNode Decl
-chkFlexibleInstances' d@(Refact.StandaloneDeriving _ _ rule) = checkedReturn rule d
-chkFlexibleInstances' d@(InstanceDecl rule _)                = checkedReturn rule d
-chkFlexibleInstances' d = return d
-
-checkedReturn :: InstanceRule -> a -> ExtMonad a
-checkedReturn rule x = chkInstanceRule rule >> return x
+-- NOTE: could use AST.SemaInfoTypes.getInstances (but it doesn't have location info)
 
--- this check DOES transform the AST for its internal computations
--- but returns the original one in the end
--- NOTE: There are two traversals:
---       First one on the class level, and the second one one on the type level.
---       Since biplateRef is lazy, it won't go down to the type level in the first traversal
-chkInstanceRule :: CheckNode InstanceRule
-chkInstanceRule r@(InstanceRule _ _ ihead) = do
-  chkInstanceHead ihead
-  return $! r
-chkInstanceRule r = return r
+-- | We need to check declarations because we want to avoid checking type family instances
+chkFlexibleInstancesDecl :: CheckNode Decl
+chkFlexibleInstancesDecl = conditional (chkInstancesDeclWith $ chkInstanceRuleWith chkInstanceHead) FlexibleInstances
 
-refact ::
-     (Data.Data.Data (node dom stage), Data.Data.Data (inner dom stage),
-      Monad m) =>
-     (inner dom stage -> m (inner dom stage))
-     -> node dom stage -> m (node dom stage)
-refact op = biplateRef !~ op
+refact :: (Data.Data.Data (node dom stage), Data.Data.Data (inner dom stage)) =>
+          (inner dom stage -> inner dom stage) ->
+           node dom stage  -> node dom stage
+refact op = biplateRef .- op
 
 
--- one IHApp will only check its own tyvars (their structure and uniqueness)
--- thus with MultiParamTypeclasses each param will be checked independently
--- (so the same type variable can appear in multiple params)
+-- | Checks every single type argument in an instance declaration
+-- If the class being instantiated could not have been looked up, it keeps FlexibleInstances
 chkInstanceHead :: CheckNode InstanceHead
-chkInstanceHead x@(InfixInstanceHead tyvars _) = do
-  tyvars' <- refact rmTypeMisc tyvars
-  chkTyVars tyvars'
-  addOccurence_ MultiParamTypeClasses x
-  addOccurence_ TypeOperators x
-  return x
-chkInstanceHead app@(AppInstanceHead f tyvars) = do
-  tyvars' <- refact rmTypeMisc tyvars
-  chkTyVars tyvars'
-  case f of
-    AppInstanceHead _ _ -> addOccurence_ MultiParamTypeClasses app
-    _ -> return ()
-  chkInstanceHead f
-  return app
-chkInstanceHead x@(ParenInstanceHead h) = do
-  chkInstanceHead h
-  return x
-chkInstanceHead app = return app
+chkInstanceHead ih = do
+  let types = collectTyArgs ih
+  mCls <- runMaybeT . lookupClassFromInstance $ ih
+  case mCls of
+    Just cls -> mapM_ (chkTypeArg cls) types >> return ih
+    Nothing  -> addOccurence FlexibleInstances ih
 
--- TODO: skip other unnecessary parts of the AST (eg.: UType ctors)
--- where can UTyPromoted appear?
--- can i write forall in instance heads?
--- unboxed tuple (has different kind, can't use in ihead), par array?
--- TH ctors
--- other misc ...
--- synonym expansion (runMaybeT . lookupSynDefM $ vars) (now: if synonym, keep FC)
-chkTyVars :: CheckNode Type
-chkTyVars vars = do
-  msyn <- runMaybeT . lookupSynDefM $ vars
-  maybe (performCheck vars) (const $ addOccurence FlexibleInstances vars) msyn
+-- | Checks a type argument of class whether it needs FlexibleInstances
+-- First checks the structure of the type argument opaquely
+-- Then, for type synonyms, it checks whether their GHC representation itself
+-- needs the extension.
+--
+-- Might find false positive occurences for phantom types:
+-- > type Phatom a b = [a]
+-- > instance C (Phatnom a a)
+-- > instance C (Phantom a Int)
+chkTypeArg :: GHC.Class -> Type -> ExtMonad Type
+chkTypeArg cls ty = do
+  chkNormalTypeArg ty
+  maybeTM (return ty) (chkSynonymTypeArg cls) (semanticsTypeSynRhs ty)
+  where chkSynonymTypeArg :: GHC.Class -> GHC.Type -> ExtMonad Type
+        chkSynonymTypeArg cls' ty'
+          | tyArgNeedsFI cls' ty' = addOccurence FlexibleInstances ty
+          | otherwise             = return ty
 
+-- | Checks a type argument of class whether it has only (distinct) type variable arguments.
+chkNormalTypeArg :: CheckNode Type
+chkNormalTypeArg vars = performCheck . refact rmTypeMisc $ vars
+
   where performCheck vars = do
           (isOk, (_, vs)) <- runStateT (runMaybeT (chkAll vars)) ([],[])
           case isOk of
             Just isOk ->
-              unless (isOk && length vs == (length . nub $ vs)) --tyvars are different
+              unless (isOk && length vs == (length . nubBy ((==) `on` (semanticsName . (^. simpleName))) $ vs)) --tyvars are different
                 (addOccurence_ FlexibleInstances vars)
-            Nothing   -> error "chkTyVars: Couldn't look up something"
+            Nothing   -> error "chkNormalTypeArg: Couldn't look up something"
           return vars
 
         chkAll x =
@@ -117,16 +99,16 @@           -- NOTE: -XHaskell98 operator type variables??
           -- NOTE VarType is either TyCon or TyVar
           --      if it is a TyCon, it cannot be wired in (Int, Char, etc)
-          if | isTyVarName   sname -> addTyVarM x >> return False
-             | isWiredInName sname -> addTyConM x >> return False
-             | isTyConName   sname -> addTyConM x >> return True
-             | otherwise           -> return True -- NEVER
+          if | GHC.isTyVarName   sname -> addTyVarM x >> return False
+             | GHC.isWiredInName sname -> addTyConM x >> return False
+             | GHC.isTyConName   sname -> addTyConM x >> return True
+             | otherwise               -> return True -- NEVER
         chkUnitTyCon _ = return False
 
 
         chkSingleTyVar (VarType x) = do
           sname <- tyVarSemNameM x
-          if (isTyVarName sname)
+          if (GHC.isTyVarName sname)
             then addTyVarM x >> return True
             else addTyConM x >> return False
         chkSingleTyVar _ = return False
@@ -152,8 +134,7 @@               (VarType c) -> addTyConM c >> return True
               _           -> chkOnlyApp f
             else return False
-        chkOnlyApp x@(InfixTypeApp lhs op rhs) = do
-          lift . lift $ addOccurence_ TypeOperators x
+        chkOnlyApp (InfixTypeApp lhs op rhs) = do
           addTyConM . mkNormalName $ (op ^. operatorName)
           lOK <- chkSingleTyVar lhs
           rOK <- chkSingleTyVar rhs
@@ -167,15 +148,36 @@ 
         tyVarSemNameM x = MaybeT . return . semanticsName $ x ^. simpleName
 
-rmTypeMisc :: CheckNode Type
-rmTypeMisc = rmTParens >=> rmTKinded
+rmTypeMisc :: Type -> Type
+rmTypeMisc (KindedType t _) = t
+rmTypeMisc (ParenType x)    = x
+rmTypeMisc x                = x
 
-rmTKinded :: CheckNode Type
-rmTKinded kt@(KindedType t _) = addOccurence_ KindSignatures kt >> return t
-rmTKinded x                   = return x
+-- Decides whether a type argument of a type class constructor need FlexibleInstances
+tyArgNeedsFI :: GHC.Class -> GHC.Type -> Bool
+tyArgNeedsFI cls arg = not . hasOnlyDistinctTyVars $ tyArg
+  where [tyArg] = GHC.filterOutInvisibleTypes (GHC.classTyCon cls) [arg]
 
--- removes Parentheses from the AST
--- the structure is reserved
-rmTParens :: CheckNode Type
-rmTParens (ParenType x) = return x
-rmTParens x             = return x
+-- | Checks whether a GHC.Type is an application, and has only (distinct) type variable arguments
+-- Logic from TcValidity.tcInstHeadTyAppAllTyVars
+hasOnlyDistinctTyVars :: GHC.Type -> Bool
+hasOnlyDistinctTyVars ty
+  | Just (tc, tys) <- GHC.tcSplitTyConApp_maybe (dropCasts ty)
+  , tys'           <- GHC.filterOutInvisibleTypes tc tys
+  , tyVars         <- mapMaybe GHC.tcGetTyVar_maybe tys'
+  = tyVars `equalLength` tys' && hasNoDups tyVars
+  | otherwise = False
+
+
+-- | A local helper function from TcValidity
+dropCasts :: GHC.Type -> GHC.Type
+dropCasts (GHC.CastTy ty _)     = dropCasts ty
+dropCasts (GHC.AppTy t1 t2)     = GHC.mkAppTy (dropCasts t1) (dropCasts t2)
+dropCasts (GHC.FunTy t1 t2)     = GHC.mkFunTy (dropCasts t1) (dropCasts t2)
+dropCasts (GHC.TyConApp tc tys) = GHC.mkTyConApp tc (map dropCasts tys)
+dropCasts (GHC.ForAllTy b ty)   = GHC.ForAllTy (dropCastsB b) (dropCasts ty)
+dropCasts ty                    = ty
+
+-- | A local helper function from TcValidity
+dropCastsB :: GHC.TyVarBinder -> GHC.TyVarBinder
+dropCastsB b = b
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/FunctionalDependenciesChecker.hs view
@@ -0,0 +1,7 @@+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.FunctionalDependenciesChecker where
+
+import Language.Haskell.Tools.Refactor
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+
+chkFunDeps :: CheckNode FunDepList
+chkFunDeps = addOccurence FunctionalDependencies
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/GADTsChecker.hs view
@@ -0,0 +1,46 @@+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.GADTsChecker where
+
+import Data.Maybe (catMaybes, fromMaybe)
+import Control.Reference ((^.), (&))
+import Control.Monad.Trans.Maybe (MaybeT(..))
+
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.Refactor
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+
+
+-- | Checks a GADT-style constructor if GADTSyntax is turned on.
+-- Sometimes GADTSyntax is sufficient and GADTs is not even needed.
+chkGADTsGadtConDecl :: CheckNode GadtConDecl
+chkGADTsGadtConDecl = conditional chkGADTsGadtConDecl' GADTSyntax
+
+-- | Checks a data constructor declaration if GADTs or ExistentialQuantification is turned on.
+-- This function is responsible for checking ExistentialQuantification as well.
+-- (there is no separate checker for that extension)
+chkConDeclForExistentials :: CheckNode ConDecl
+chkConDeclForExistentials = conditionalAny chkConDeclForExistentials' [GADTs, ExistentialQuantification]
+
+-- If all data constructors are vanilla Haskell 98 data constructors, then only GADTSyntax is needed.
+chkGADTsGadtConDecl' :: CheckNode GadtConDecl
+chkGADTsGadtConDecl' conDecl = do
+  let conNames = conDecl ^. (gadtConNames & annListElems)
+  mres <- mapM (runMaybeT . isVanillaDataConNameM) conNames
+  if and . catMaybes $ mres
+    then addOccurence GADTSyntax conDecl
+    else do addOccurence GADTSyntax conDecl
+            addRelation (GADTs `lOr` ExistentialQuantification) conDecl
+
+-- Extracts the name from a ConDecl, and checks whether it is a vanilla
+-- data constructor.
+chkConDeclForExistentials' :: CheckNode ConDecl
+chkConDeclForExistentials' conDecl = liftM (fromMaybe conDecl) . runMaybeT $
+  case conDecl ^. element of
+    UConDecl _ _ n _         -> chkName n
+    URecordDecl _ _ n _      -> chkName n
+    UInfixConDecl _ _ _ op _ -> chkName (op ^. operatorName)
+  where chkName :: HasNameInfo' n => n -> MaybeT ExtMonad ConDecl
+        chkName n = do
+          isVanilla <- isVanillaDataConNameM n
+          if isVanilla
+            then return conDecl
+            else lift . addRelation (GADTs `lOr` ExistentialQuantification) $ conDecl
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/KindSignaturesChecker.hs view
@@ -0,0 +1,8 @@+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.KindSignaturesChecker where
+
+import Language.Haskell.Tools.Refactor
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+
+chkKindSignaturesKind :: CheckNode Kind
+chkKindSignaturesKind = conditional chkKind KindSignatures
+  where chkKind = addOccurence KindSignatures
Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/LambdaCaseChecker.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
-
 module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.LambdaCaseChecker where
 
 import Language.Haskell.Tools.Refactor as Refact
Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/MagicHashChecker.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
-             
 module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.MagicHashChecker where
 
 import Language.Haskell.Tools.Refactor
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/MultiParamTypeClassesChecker.hs view
@@ -0,0 +1,42 @@+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.MultiParamTypeClassesChecker where
+
+import Control.Reference ((^.))
+
+import Language.Haskell.Tools.Refactor
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+
+chkMultiParamTypeClassesDecl :: CheckNode Decl
+chkMultiParamTypeClassesDecl = conditional chkMultiParamTypeClassesDecl' MultiParamTypeClasses
+
+
+-- | Decides whether a class or instance declaration needs MultiParamTypeClasses
+-- Also handles the NullaryTypeClasses case
+chkMultiParamTypeClassesDecl' :: CheckNode Decl
+chkMultiParamTypeClassesDecl' cd@(ClassDecl _ dh _ _)
+  | n <- length . collectTyVars $ dh
+  , n /= 1 = addOccurence MultiParamTypeClasses dh >> return cd
+chkMultiParamTypeClassesDecl' i@(InstanceDecl rule _)
+  | isMultiParamNeeded (rule ^. irHead)
+  = addOccurence MultiParamTypeClasses rule >> return i
+chkMultiParamTypeClassesDecl' d = return d
+
+
+collectTyVars :: DeclHead -> [TyVar]
+collectTyVars (ParenDeclHead dh)        = collectTyVars dh
+collectTyVars (DeclHeadApp   dh tv)     = tv : collectTyVars dh
+collectTyVars (InfixDeclHead lhs _ rhs) = [lhs,rhs]
+collectTyVars _ = []
+
+
+-- | Decides whether an instance declaration needs MultiParamTypeClasses
+-- Also handles the NullaryTypeClasses case
+isMultiParamNeeded :: InstanceHead -> Bool
+isMultiParamNeeded InstanceHead{}         = True
+isMultiParamNeeded InfixInstanceHead{}    = True
+isMultiParamNeeded (ParenInstanceHead ih) = isMultiParamNeeded ih
+isMultiParamNeeded (AppInstanceHead f _)  = isMultiParamNeeded' f
+  -- one level deeper
+  where isMultiParamNeeded' InstanceHead{}         = False
+        isMultiParamNeeded' InfixInstanceHead{}    = True
+        isMultiParamNeeded' (ParenInstanceHead ih) = isMultiParamNeeded' ih
+        isMultiParamNeeded' (AppInstanceHead _ _)  = True
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/MultiWayIfChecker.hs view
@@ -0,0 +1,11 @@+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.MultiWayIfChecker where
+
+import Language.Haskell.Tools.Refactor
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+
+chkMultiWayIfExpr :: CheckNode Expr
+chkMultiWayIfExpr = conditional chkMultiWayIfExpr' MultiWayIf
+
+chkMultiWayIfExpr' :: CheckNode Expr
+chkMultiWayIfExpr' e@(MultiIf _) = addOccurence MultiWayIf e
+chkMultiWayIfExpr' x = return x
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/OverloadedStringsChecker.hs view
@@ -0,0 +1,19 @@+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.OverloadedStringsChecker where
+
+import Type as GHC (eqType)
+import TysWiredIn as GHC (stringTy)
+
+import Control.Reference ((^.))
+
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.Refactor
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+
+chkOverloadedStringsLiteral :: CheckNode Literal
+chkOverloadedStringsLiteral = conditional chkLit OverloadedStrings
+  where chkLit :: CheckNode Literal
+        chkLit lit
+          | UStringLit _ <- lit ^. element
+          , not . GHC.eqType GHC.stringTy $ semanticsLiteralType lit
+          = addOccurence OverloadedStrings lit
+          | otherwise = return lit
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/ParallelListCompChecker.hs view
@@ -0,0 +1,10 @@+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.ParallelListCompChecker where
+
+import Language.Haskell.Tools.AST  (annLength)
+import Language.Haskell.Tools.Refactor
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+
+chkParallelListComp :: CheckNode Expr
+chkParallelListComp e@(ListComp _ body)
+  | annLength body > 1 = addOccurence ParallelListComp e
+chkParallelListComp e = return e
Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/PatternSynonymsChecker.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
-
 module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.PatternSynonymsChecker where
 
 import Language.Haskell.Tools.Refactor (PatternSignature, PatternSynonym)
Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/RecordWildCardsChecker.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
-
 module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.RecordWildCardsChecker where
 
 import Language.Haskell.Tools.Refactor
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/RecursiveDoChecker.hs view
@@ -0,0 +1,12 @@+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.RecursiveDoChecker where
+
+import Language.Haskell.Tools.Refactor
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+
+chkRecursiveDoExpr :: CheckNode Expr
+chkRecursiveDoExpr e@MDo{} = addOccurence RecursiveDo e
+chkRecursiveDoExpr e = return e
+
+chkRecursiveDoStmt :: CheckNode Stmt
+chkRecursiveDoStmt s@RecStmt{} = addOccurence RecursiveDo s
+chkRecursiveDoStmt s = return s
Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/TemplateHaskellChecker.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
-
 module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.TemplateHaskellChecker where
 
 import Language.Haskell.Tools.Refactor
Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/TupleSectionsChecker.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
-
 module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.TupleSectionsChecker where
 
 import Language.Haskell.Tools.Refactor
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/TypeFamiliesChecker.hs view
@@ -0,0 +1,100 @@+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.TypeFamiliesChecker where
+
+import TyCon          as GHC (TyCon())
+import PrelNames      as GHC
+import Unique         as GHC (hasKey)
+import qualified Type as GHC (expandTypeSynonyms)
+
+import Control.Reference ((^.))
+import Control.Monad.Trans.Maybe (MaybeT(..))
+
+import Data.List (zipWith)
+import Data.Maybe (catMaybes)
+import Data.Generics.Uniplate.Data()
+import Data.Generics.Uniplate.Operations
+import qualified Data.Map.Strict as SMap
+
+import Language.Haskell.Tools.Refactor
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+
+
+-- | Checks whether any name's corresponding type in the module contains a type equality.
+globalChkNamesForTypeEq :: CheckNode Module
+globalChkNamesForTypeEq = conditionalAny globalChkNamesForTypeEq' [TypeFamilies, GADTs]
+
+-- | Checks an operator for syntactic evidence of a ~ b type equality if TypeFamilies or GADTs is turned on.
+chkOperatorForTypeEq :: CheckNode Operator
+chkOperatorForTypeEq = conditionalAny chkOperatorForTypeEq' [TypeFamilies, GADTs]
+
+
+-- | Checks a declaration if TypeFamilies is turned on.
+chkTypeFamiliesDecl :: CheckNode Decl
+chkTypeFamiliesDecl = conditional chkTypeFamiliesDecl' TypeFamilies
+
+-- | Checks a class element if TypeFamilies is turned on.
+chkTypeFamiliesClassElement :: CheckNode ClassElement
+chkTypeFamiliesClassElement = conditional chkTypeFamiliesClassElement' TypeFamilies
+
+-- | Checks an instance body if TypeFamilies is turned on.
+chkTypeFamiliesInstBodyDecl :: CheckNode InstBodyDecl
+chkTypeFamiliesInstBodyDecl = conditional chkTypeFamiliesInstBodyDecl' TypeFamilies
+
+
+
+chkTypeFamiliesDecl' :: CheckNode Decl
+chkTypeFamiliesDecl' d@TypeFamily{}       = addOccurence TypeFamilies d
+chkTypeFamiliesDecl' d@DataFamily{}       = addOccurence TypeFamilies d
+chkTypeFamiliesDecl' d@ClosedTypeFamily{} = addOccurence TypeFamilies d
+chkTypeFamiliesDecl' d@TypeInstance{}     = addOccurence TypeFamilies d
+chkTypeFamiliesDecl' d@DataInstance{}     = addOccurence TypeFamilies d
+chkTypeFamiliesDecl' d@GadtDataInstance{} = addOccurence TypeFamilies d
+chkTypeFamiliesDecl' d                    = return d
+
+chkTypeFamiliesClassElement' :: CheckNode ClassElement
+chkTypeFamiliesClassElement' ce@ClassElemTypeFam{} = addOccurence TypeFamilies ce
+chkTypeFamiliesClassElement' ce@ClassElemDataFam{} = addOccurence TypeFamilies ce
+chkTypeFamiliesClassElement' ce@ClsDefaultType{}   = addOccurence TypeFamilies ce
+chkTypeFamiliesClassElement' ce                    = return ce
+
+chkTypeFamiliesInstBodyDecl' :: CheckNode InstBodyDecl
+chkTypeFamiliesInstBodyDecl' b@InstanceTypeFamilyDef{}     = addOccurence TypeFamilies b
+chkTypeFamiliesInstBodyDecl' b@InstanceDataFamilyDef{}     = addOccurence TypeFamilies b
+chkTypeFamiliesInstBodyDecl' b@InstanceDataFamilyGADTDef{} = addOccurence TypeFamilies b
+chkTypeFamiliesInstBodyDecl' b                             = return b
+
+
+chkOperatorForTypeEq' :: CheckNode Operator
+chkOperatorForTypeEq' op
+  | Just name <- semanticsName (op ^. operatorName)
+  , name == eqTyConName
+  = addRelation (TypeFamilies `lOr` GADTs) op
+  | otherwise = return op
+
+chkNameForTyEqn :: CheckNode Name
+chkNameForTyEqn name = do
+  mty <- runMaybeT . lookupTypeFromId $ name
+  case mty of
+    Just ty -> do
+      let ty'    = GHC.expandTypeSynonyms ty
+          tycons = universeBi ty' :: [GHC.TyCon]
+      if any isEqTyCon tycons then addRelation (TypeFamilies `lOr` GADTs) name
+                              else return name
+    Nothing -> return name
+
+  --traceShow (showName name ++ " -- " ++ showOutputable ty') $
+
+  where isEqTyCon tc = tc `hasKey` eqTyConKey
+                    || tc `hasKey` heqTyConKey
+                    || tc `hasKey` eqPrimTyConKey
+                    || tc `hasKey` eqReprPrimTyConKey
+                    || tc `hasKey` eqPhantPrimTyConKey
+
+globalChkNamesForTypeEq' :: CheckNode Module
+globalChkNamesForTypeEq' m = do
+  let origNames   = universeBi (m ^. modDecl) :: [Name]
+      pairedNames = catMaybes . zipWith zf (map semanticsName origNames) $ origNames
+      uniqueNames = SMap.elems . SMap.fromList . reverse $ pairedNames
+  mapM_ chkNameForTyEqn uniqueNames
+  return m
+  where zf (Just x) y = Just (x,y)
+        zf _ _        = Nothing
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/TypeOperatorsChecker.hs view
@@ -0,0 +1,65 @@+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.TypeOperatorsChecker where
+
+import qualified Name    as GHC (nameOccName)
+import qualified OccName as GHC (isTcOcc, isSymOcc)
+
+import Data.Generics.Uniplate.Data()
+import Data.Generics.Uniplate.Operations
+
+import Control.Monad.Trans.Maybe (MaybeT(..))
+
+import Language.Haskell.Tools.Refactor
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+
+-- | Checks a Type whether it contains any DeclHeads that amy need TypeOperators
+chkTypeOperatorsType :: CheckNode Type
+chkTypeOperatorsType = conditional chkTypeOperatorsType' TypeOperators
+
+-- | Checks an Assertion whether it contains any DeclHeads that amy need TypeOperators
+chkTypeOperatorsAssertion :: CheckNode Assertion
+chkTypeOperatorsAssertion = conditional chkTypeOperatorsAssertion' TypeOperators
+
+-- | Checks an InstanceHEad whether it contains any DeclHeads that amy need TypeOperators
+chkTypeOperatorsInstHead :: CheckNode InstanceHead
+chkTypeOperatorsInstHead = conditional chkTypeOperatorsInstHead' TypeOperators
+
+-- | Checks a Decl whether it contains any DeclHeads that amy need TypeOperators
+-- We check Decls to avoid getting multiple occurences of the same DeclHead
+-- (e.g. we would check it with and without parentheses)
+chkTypeOperatorsDecl :: CheckNode Decl
+chkTypeOperatorsDecl = conditional chkTypeOperatorsDecl' TypeOperators
+
+
+
+chkTypeOperatorsType' :: CheckNode Type
+chkTypeOperatorsType' t@InfixTypeApp{} = addOccurence TypeOperators t
+chkTypeOperatorsType' t = return t
+
+chkTypeOperatorsAssertion' :: CheckNode Assertion
+chkTypeOperatorsAssertion' a@InfixAssert{} = addOccurence TypeOperators a
+chkTypeOperatorsAssertion' a = return a
+
+chkTypeOperatorsInstHead' :: CheckNode InstanceHead
+chkTypeOperatorsInstHead' ih@InfixInstanceHead{} = addOccurence TypeOperators ih
+chkTypeOperatorsInstHead' ih = return ih
+
+chkTypeOperatorsDecl' :: CheckNode Decl
+chkTypeOperatorsDecl' d = do
+  let dhs = universeBi d :: [DeclHead]
+  anyNeedsTO <- liftM or $ mapM isOperatorM dhs
+  if anyNeedsTO then addOccurence TypeOperators d
+                else return d
+
+-- OccName: [Type and class operator definitions]
+  -- We are not just looking for a *syntactically-infix* declaration,
+  -- but one that uses an operator OccName.
+isOperatorM :: DeclHead -> ExtMonad Bool
+isOperatorM dh = do
+  mSemName <- runMaybeT . declHeadSemName $ dh
+  case mSemName of
+    Just semName
+      | occ <- GHC.nameOccName semName
+      , GHC.isTcOcc occ && GHC.isSymOcc occ
+      -> return True
+      | otherwise -> return False
+    Nothing -> return True
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/TypeSynonymInstancesChecker.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE FlexibleContexts, MonoLocalBinds #-}
+
+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.TypeSynonymInstancesChecker
+  ( chkTypeSynonymInstancesDecl, chkInstancesDeclWith, chkInstanceRuleWith, collectTyArgs) where
+
+import Language.Haskell.Tools.Refactor
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad hiding (StandaloneDeriving)
+
+
+{-# ANN module "HLint: ignore Redundant bracket" #-}
+
+-- TODO: write "deriving instance ..." tests (should work)
+
+-- | We need to check declarations because we want to avoid checking type family instances
+chkTypeSynonymInstancesDecl :: CheckNode Decl
+chkTypeSynonymInstancesDecl = conditional (chkInstancesDeclWith $ chkInstanceRuleWith chkInstanceHead) TypeSynonymInstances
+
+-- | Checks an instance rule in declaration
+-- We need to check declarations because we want to avoid checking type family instances
+chkInstancesDeclWith :: CheckNode InstanceRule -> CheckNode Decl
+chkInstancesDeclWith chkRule d@(StandaloneDeriving _ _ rule) = chkRule rule >> return d
+chkInstancesDeclWith chkRule d@(InstanceDecl rule _)         = chkRule rule >> return d
+chkInstancesDeclWith _ d = return d
+
+-- | Checks and instance head in an instance rule
+chkInstanceRuleWith :: CheckNode InstanceHead -> CheckNode InstanceRule
+chkInstanceRuleWith chkHead r@(InstanceRule _ _ ihead) = chkHead ihead >> return r
+chkInstanceRuleWith _ r = return r
+
+
+-- | Checks every single type argument in an instance declaration whether it is a synonym
+chkInstanceHead :: CheckNode InstanceHead
+chkInstanceHead ih = do
+  let types = collectTyArgs ih
+  mapM_ chkTypeArg types >> return ih
+
+-- | Checks a type argument of class whether it is a synonym
+chkTypeArg :: Type -> ExtMonad Type
+chkTypeArg ty =
+  maybeTM (return ty) (const . addOccurence TypeSynonymInstances $ ty) (semanticsTypeSynRhs ty)
+
+-- | Collects the type arguments in an instance declaration
+-- Type arguments are the the types that the class is being instantiated with
+collectTyArgs :: InstanceHead -> [Type]
+collectTyArgs (InstanceHead _)        = []
+collectTyArgs (InfixInstanceHead t _) = [t]
+collectTyArgs (ParenInstanceHead ih)  = collectTyArgs ih
+collectTyArgs (AppInstanceHead ih t)  = t : collectTyArgs ih
Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/UnboxedTuplesChecker.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
-
 module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.UnboxedTuplesChecker where
 
 import Language.Haskell.Tools.Refactor
Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/ViewPatternsChecker.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
-
 module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.ViewPatternsChecker where
 
 import Language.Haskell.Tools.Refactor
Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/ExtMap.hs view
@@ -1,20 +1,83 @@-{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveAnyClass, DeriveGeneric, StandaloneDeriving #-}
 
-module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMap where
+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMap
+  ( module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMap
+  , module Language.Haskell.TH.LanguageExtensions
+  , Formula(..)
+  ) where
 
-import Language.Haskell.TH.LanguageExtensions (Extension)
+import GHC.Generics
+import Control.DeepSeq
+
 import SrcLoc (SrcSpan)
 
+import Data.List
+import Data.Monoid hiding (All)
+import Data.Function (on)
+import qualified Data.Map.Lazy   as LMap
 import qualified Data.Map.Strict as SMap (Map)
 
+import SAT.MiniSat
 
-infix 6 :||:
-infix 7 :&&:
+import Language.Haskell.TH.LanguageExtensions (Extension(..))
+import Language.Haskell.Tools.Refactor.Utils.Extensions (expandExtension)
 
-data LogicalRelation a = LVar a
-                       | Not (LogicalRelation a)
-                       | LogicalRelation a :&&: LogicalRelation a
-                       | LogicalRelation a :||: LogicalRelation a
-  deriving (Eq, Show, Functor, Ord)
+{-# ANN module "HLint: ignore Redundant lambda" #-}
 
+
+deriving instance Ord  Extension
+deriving instance Read Extension
+
+instance NFData Extension where
+  rnf x = seq x ()
+
+deriving instance Generic a => Generic (Formula a)
+deriving instance (Generic a, NFData a) => NFData (Formula a)
+
+type LogicalRelation a = Formula a
+
 type ExtMap = SMap.Map (LogicalRelation Extension) [SrcSpan]
+
+lVar :: a -> LogicalRelation a
+lVar = Var
+
+lNot :: a -> LogicalRelation a
+lNot = Not . Var
+
+lAnd :: a -> a -> LogicalRelation a
+lAnd x y = Var x :&&: Var y
+
+lOr :: a -> a -> LogicalRelation a
+lOr x y = Var x :||: Var y
+
+lImplies :: a -> a -> LogicalRelation a
+lImplies x y = Var x :->: Var y
+
+lAll :: [LogicalRelation a] -> LogicalRelation a
+lAll = All
+
+complexity :: Extension -> Int
+complexity = length . expandExtension
+
+determineExtensions :: SMap.Map (LogicalRelation Extension) v -> [Extension]
+{- NOTE:
+ We calculate all the possible extension set that satisfy the logical relation,
+ then for each extension we remove all the extensions implied by it, (mergeImplied)
+ finally we select the minimal extension set.
+
+ An extension set is minimal if:
+  - it contains the least amount of extensions
+  - it contains extension with minimal complexity
+  - it is lexicographically the first one (based on the Ord instance of Extension)
+-}
+determineExtensions x = minimal . map toExts $ solution
+  where solution = solve_all . All . LMap.keys $ x
+        toExts   = mergeImplied . map fst . filter snd . LMap.toList
+        minimal  = minimumBy ((compare `on` length) <> (compare `on` (sum . map complexity)) <> (compare `on` sort))
+
+rmImplied :: Extension -> [Extension] -> [Extension]
+rmImplied e = flip (\\) implied
+  where implied = delete e $ expandExtension e
+
+mergeImplied :: [Extension] -> [Extension]
+mergeImplied exts = foldl (flip rmImplied) exts exts
Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/ExtMonad.hs view
@@ -1,20 +1,22 @@-{-# LANGUAGE ConstraintKinds, FlexibleContexts, RankNTypes, StandaloneDeriving, TypeFamilies, TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleContexts, MonoLocalBinds, RankNTypes #-}
 
+
 module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
   ( module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
   , module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMap
+  , module Language.Haskell.Tools.Refactor.Utils.Maybe
   , module Language.Haskell.TH.LanguageExtensions
   , module Control.Monad.State
   , module Control.Monad.Reader
   ) where
 
 import Language.Haskell.Tools.Refactor
+import Language.Haskell.Tools.Refactor.Utils.Maybe
 import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMap
 
 import GHC (SrcSpan(..), Ghc(..), runGhc)
 import GHC.Paths ( libdir )
 import Language.Haskell.TH.LanguageExtensions
-import SrcLoc (SrcSpan)
 
 import Control.Monad.Reader
 import Control.Monad.State
@@ -24,19 +26,15 @@ {-# ANN module "HLint: ignore Use mappend" #-}
 {-# ANN module "HLint: ignore Use import/export shortcut" #-}
 
-deriving instance Ord  Extension
-deriving instance Read Extension
 
-
--- how could I hide the tyvar a?
--- type Asd a = forall m . (MonadReader [Extension] m, MonadState ExtMap m, GhcMonad m) => m a
-
-
-type ExtMonad        = ReaderT [Extension] (StateT ExtMap Ghc)
+type ExtMonad = ReaderT [Extension] (StateT ExtMap Ghc)
 
-type CheckNode elem = elem -> ExtMonad elem
+type CheckNode  elem  = elem -> ExtMonad elem
 type CheckUNode uelem = Ann uelem IdDom SrcTemplateStage -> ExtMonad (Ann uelem IdDom SrcTemplateStage)
 
+class Checkable node where
+  check :: CheckNode node
+
 addOccurence' :: (Ord k, HasRange a) =>
                  k -> a -> SMap.Map k [SrcSpan] -> SMap.Map k [SrcSpan]
 addOccurence' key node = SMap.insertWith (++) key [getRange node]
@@ -44,12 +42,20 @@ -- TODO: add isTurnedOn check
 addOccurence_ :: (MonadState ExtMap m, HasRange node) =>
                   Extension -> node -> m ()
-addOccurence_ extension element = modify $ addOccurence' (LVar extension) element
+addOccurence_ extension element = modify $ addOccurence' (lVar extension) element
 
 addOccurence :: (MonadState ExtMap m, HasRange node) =>
                  Extension -> node -> m node
 addOccurence ext node = addOccurence_ ext node >> return node
 
+addRelation_ :: (MonadState ExtMap m, HasRange node) =>
+                 LogicalRelation Extension -> node -> m ()
+addRelation_ rel element = modify $ addOccurence' rel element
+
+addRelation :: (MonadState ExtMap m, HasRange node) =>
+                LogicalRelation Extension -> node -> m node
+addRelation rel node = addRelation_ rel node >> return node
+
 isTurnedOn :: Extension -> ExtMonad Bool
 isTurnedOn ext = do
   defaults <- ask
@@ -79,7 +85,6 @@ 
 conditionalAdd :: HasRange node => Extension -> node -> ExtMonad node
 conditionalAdd ext = conditional (addOccurence ext) ext
-
 
 runExtMonadIO :: ExtMonad a -> IO a
 runExtMonadIO = runGhc (Just libdir) . runExtMonadGHC
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Instances/AppSelector.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE DataKinds, TypeFamilies #-}
+
+
+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Instances.AppSelector where
+
+import Data.Generics.ClassyPlate
+import Language.Haskell.Tools.Refactor
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+
+type family HasChecker node where
+  -- Module-level checks
+  HasChecker Module           = 'True
+
+  -- Node-level checks
+  HasChecker Decl             = 'True
+  HasChecker Pattern          = 'True
+  HasChecker Expr             = 'True
+  HasChecker Type             = 'True
+  HasChecker PatternField     = 'True
+  HasChecker FieldUpdate      = 'True
+  HasChecker PatternSynonym   = 'True
+  HasChecker PatternSignature = 'True
+  HasChecker Literal          = 'True
+  HasChecker NamePart         = 'True
+  HasChecker Kind             = 'True
+  HasChecker Splice           = 'True
+  HasChecker QuasiQuote       = 'True
+  HasChecker Bracket          = 'True
+  HasChecker FunDepList       = 'True
+  HasChecker ClassElement     = 'True
+  HasChecker Stmt             = 'True
+  HasChecker Cmd              = 'True
+  HasChecker InstBodyDecl     = 'True
+  HasChecker IESpec           = 'True
+  HasChecker Operator         = 'True
+  HasChecker GadtConDecl      = 'True
+  HasChecker ConDecl          = 'True
+  HasChecker Assertion        = 'True
+  HasChecker InstanceHead     = 'True
+  HasChecker _                = 'False
+
+type instance AppSelector Checkable node = HasChecker node
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Instances/Checkable.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE FlexibleInstances #-}
+
+
+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Instances.Checkable where
+
+import Language.Haskell.Tools.Refactor
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+
+-- | Global checks
+instance Checkable Module where
+  check = globalChkNamesForTypeEq
+
+instance Checkable Decl where
+  check = chkFlexibleInstancesDecl
+      >=> chkDerivings
+      >=> chkTypeFamiliesDecl
+      >=> chkMultiParamTypeClassesDecl
+      >=> chkConstraintKindsDecl
+      >=> chkConstrainedClassMethodsDecl
+      >=> chkTypeSynonymInstancesDecl
+      >=> chkTypeOperatorsDecl'
+
+instance Checkable Pattern where
+  check = chkBangPatterns
+      >=> chkViewPatterns
+      >=> chkUnboxedTuplesPat
+
+instance Checkable Expr where
+  check = chkTupleSections
+      >=> chkUnboxedTuplesExpr
+      >=> chkLambdaCase
+      >=> chkRecursiveDoExpr
+      >=> chkArrowsExpr
+      >=> chkParallelListComp
+      >=> chkMultiWayIfExpr
+
+instance Checkable Type where
+  check = chkUnboxedTuplesType
+      >=> chkExplicitForAllType
+      >=> chkTypeOperatorsType
+
+instance Checkable PatternField where
+  check = chkRecordWildCardsPatField
+
+instance Checkable FieldUpdate where
+  check = chkRecordWildCardsFieldUpdate
+
+instance Checkable PatternSynonym where
+  check = chkPatternSynonymsSyn
+
+instance Checkable PatternSignature where
+  check = chkPatternSynonymsTypeSig
+
+instance Checkable Literal where
+  check = chkMagicHashLiteral
+      >=> chkOverloadedStringsLiteral
+
+instance Checkable NamePart where
+  check = chkMagicHashNamePart
+      >=> chkTemplateHaskellhNamePart
+
+instance Checkable Kind where
+  check = chkMagicHashKind
+      >=> chkKindSignaturesKind
+
+instance Checkable Splice where
+  check = chkTemplateHaskellSplice
+
+instance Checkable QuasiQuote where
+  check = chkTemplateHaskellQuasiQuote
+
+instance Checkable Bracket where
+  check = chkTemplateHaskellBracket
+
+instance Checkable FunDepList where
+  check = chkFunDeps
+
+instance Checkable ClassElement where
+  check = chkDefaultSigs
+      >=> chkTypeFamiliesClassElement
+
+instance Checkable Stmt where
+  check = chkRecursiveDoStmt
+
+instance Checkable Cmd where
+  check = chkArrowsCmd
+
+instance Checkable InstBodyDecl where
+  check = chkTypeFamiliesInstBodyDecl
+
+instance Checkable IESpec where
+  check = chkExplicitNamespacesIESpec
+
+instance Checkable Operator where
+  check = chkOperatorForTypeEq
+
+instance Checkable GadtConDecl where
+  check = chkGADTsGadtConDecl
+      >=> chkExplicitForAllGadtConDecl
+
+instance Checkable ConDecl where
+  check = chkConDeclForExistentials
+      >=> chkExplicitForAllConDecl
+
+instance Checkable Assertion where
+  check = chkTypeOperatorsAssertion
+
+instance Checkable InstanceHead where
+  check = chkTypeOperatorsInstHead
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/SupportedExtensions.hs view
@@ -0,0 +1,37 @@+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.SupportedExtensions where
+
+import Language.Haskell.TH.LanguageExtensions (Extension(..))
+
+isSupported :: Extension -> Bool
+isSupported = flip elem fullyHandledExtensions
+
+fullyHandledExtensions :: [Extension]
+fullyHandledExtensions = syntacticExtensions
+                      ++ derivingExtensions
+                      ++ typeClassExtensions
+                      ++ typeSystemExtensions
+
+syntacticExtensions :: [Extension]
+syntacticExtensions = [ RecordWildCards, TemplateHaskell, BangPatterns
+                      , PatternSynonyms, TupleSections, LambdaCase, QuasiQuotes
+                      , ViewPatterns, MagicHash, UnboxedTuples
+                      , FunctionalDependencies, DefaultSignatures
+                      , RecursiveDo, Arrows, ParallelListComp
+                      , KindSignatures, ExplicitNamespaces
+                      , GADTSyntax, ExplicitForAll, MultiWayIf
+                      , TypeOperators ]
+
+derivingExtensions :: [Extension]
+derivingExtensions = [ DeriveDataTypeable, DeriveGeneric, DeriveFunctor
+                     , DeriveFoldable, DeriveTraversable, DeriveLift
+                     , DeriveAnyClass, GeneralizedNewtypeDeriving
+                     , StandaloneDeriving, DerivingStrategies ]
+
+typeClassExtensions :: [Extension]
+typeClassExtensions = [ MultiParamTypeClasses, ConstrainedClassMethods
+                      , FlexibleInstances, TypeSynonymInstances
+                      ]
+
+typeSystemExtensions :: [Extension]
+typeSystemExtensions = [ TypeFamilies, GADTs, ExistentialQuantification
+                       , ConstraintKinds ]
Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/TraverseAST.hs view
@@ -1,592 +1,18 @@-{-# LANGUAGE FlexibleContexts, RankNTypes, TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts, MonoLocalBinds, RankNTypes, TypeApplications #-}
 
+
 module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.TraverseAST
   ( module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.TraverseAST
   , module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
   ) where
 
-import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers
-import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
-
-import Language.Haskell.Tools.AST
-import Language.Haskell.Tools.Refactor as Refact
-
-import Control.Reference ((!~), (&), (&+&))
-
-{-
-   NOTE: We need Decl level checking for deriving clausese
-         in order to gain extra information from the newtype and data keywords.
-
-         We need Decl level checking for instance heads, in order to distinguish
-         class instances from data and type family instances.
--}
-chkDecl :: CheckNode Decl
-chkDecl = chkFlexibleInstances >=> chkDerivings
-
-chkPattern :: CheckNode Pattern
-chkPattern = chkBangPatterns
-         >=> chkViewPatterns
-         >=> chkUnboxedTuplesPat
-
-chkExpr :: CheckNode Expr
-chkExpr = chkTupleSections
-      >=> chkUnboxedTuplesExpr
-      >=> chkLambdaCase
-
-chkType :: CheckNode Type
-chkType = chkUnboxedTuplesType
-
-chkPatternField :: CheckNode PatternField
-chkPatternField = chkRecordWildCardsPatField
-
-chkFieldUpdate :: CheckNode FieldUpdate
-chkFieldUpdate = chkRecordWildCardsFieldUpdate
-
-chkPatternSynonym :: CheckNode PatternSynonym
-chkPatternSynonym = chkPatternSynonymsSyn
-
-chkPatternSignature :: CheckNode PatternSignature
-chkPatternSignature = chkPatternSynonymsTypeSig
-
-chkLiteral :: CheckNode Literal
-chkLiteral = chkMagicHashLiteral
-
-chkNamePart :: CheckNode NamePart
-chkNamePart = chkMagicHashNamePart
-          >=> chkTemplateHaskellhNamePart
+import Data.Generics.ClassyPlate
 
-chkKind :: CheckNode Kind
-chkKind = chkMagicHashKind
+import Language.Haskell.Tools.Refactor
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Instances.Checkable()
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Instances.AppSelector()
 
 
 traverseModule :: CheckNode UnnamedModule
-traverseModule = (modDecl & annList !~ traverseDecl)
-             >=> (modHead & annJust !~ traverseModuleHead)
-             -- more
-
-traverseModuleHead :: CheckNode ModuleHead
-traverseModuleHead = mhExports & annJust !~ traverseExportSpecs
-                    -- more
-
-traverseExportSpecs :: CheckNode ExportSpecs
-traverseExportSpecs = espExports & annList !~ traverseExportSpec
-
-traverseExportSpec :: CheckNode ExportSpec
-traverseExportSpec = exportDecl !~ traverseIESpec
-
-traverseIESpec :: CheckNode IESpec
-traverseIESpec = (ieName !~ traverseName)
-             >=> (ieSubspec & annJust !~ traverseSubSpec)
-
-traverseSubSpec :: CheckNode SubSpec
-traverseSubSpec = essList & annList !~ traverseName
-
-traverseDecl :: CheckNode Decl
-traverseDecl = chkDecl
-               >=> (declValBind !~ traverseValueBind)
-               >=> (declBody & annJust !~ traverseClassBody)
-               >=> (declSplice !~ traverseSplice)
-               >=> (innerType !~ traverseType)
-               >=> (declTypeSig !~ traverseTypeSignature)
-               >=> (declTypeFamily !~ traverseTypeFamily) --
-               >=> (declSpec & annJust !~ traverseTypeFamilySpec)
-               >=> (declSafety & annJust !~ traverseSafety)
-               >=> (declRoles & annList !~ traverseRole)
-               >=> (declPragma !~ traverseTopLevelPragma)
-               >=> (declPatTypeSig !~ traversePatternSignature)
-               >=> (declPatSyn !~ traversePatternSynonym)
-               >=> (declOverlap & annJust !~ traverseOverlapPragma)
-               >=> (declKind & annJust !~ traverseKindContraint)
-               >=> (innerInstanceRule !~ traverseInstanceRule)
-               >=> (declInstDecl & annJust !~ traverseInstBody)
-               >=> (declHead !~ traverseDeclHead)
-               >=> (declGadt & annList !~ traverseGadtConDecl)
-               >=> (declFunDeps & annJust !~ traverseFunDeps)
-               >=> (declForeignType !~ traverseType)
-               >=> (declFixity !~ traverseFixitySignature)
-               >=> (declDeriving & annList !~ traverseDeriving)
-               >=> (declDecl & annList !~ traverseTypeEqn)
-               >=> (declCtx & annJust !~ traverseContext)
-               >=> (declCons & annList !~ traverseConDecl)
-               >=> (declCallConv !~ traverseCallConv)
-               >=> (declName !~ traverseName)
-               >=> (declRoleType !~ traverseQualifiedName)
-
-  where innerType = (declTypes & annList)
-                &+& declType
-                &+& declAssignedType
-
-        innerInstanceRule = declInstance &+& declInstRule
-
-traverseTypeFamily :: CheckNode TypeFamily
-traverseTypeFamily = (tfHead !~ traverseDeclHead)
-                 >=> (tfSpec & annJust !~ traverseTypeFamilySpec)
-                 >=> (tfKind & annJust !~ traverseKindContraint)
-
--- tfTypeVar is from 0.9
-traverseTypeFamilySpec :: CheckNode TypeFamilySpec
-traverseTypeFamilySpec = (tfSpecKind !~ traverseKindContraint)
-                     -- >=> (tfTypeVar !~ traverseTyVar)
-                     >=> (tfInjectivity !~ traverseInjectivityAnn)
-
-traverseInjectivityAnn :: CheckNode InjectivityAnn
-traverseInjectivityAnn = (injAnnRes !~ traverseTyVar)
-                     >=> (injAnnDeps & annList !~ traverseName)
-
--- DONE
-traverseSafety :: CheckNode Safety
-traverseSafety = return
-
--- DONE
-traverseRole :: CheckNode Role
-traverseRole = return
-
-traverseTopLevelPragma :: CheckNode TopLevelPragma
-traverseTopLevelPragma = (pragmaRule & annList !~ traverseRule)
-                     >=> (pragmaObjects & annList !~ traverseName)
-                     >=> (annotationSubject !~ traverseAnnotationSubject)
-                     >=> (pragmaInline !~ traverseInlinePragma)
-                     >=> (specializePragma !~ traverseSpecializePragma)
-
--- no references for this
-traverseSpecializePragma :: CheckUNode USpecializePragma
-traverseSpecializePragma = return {- (specializeDef !~ traverseName)
-                       >=> (specializeType & annList !~ traverseType) -}
-
-traverseAnnotationSubject :: CheckNode AnnotationSubject
-traverseAnnotationSubject = annotateName !~ traverseName
-
-traverseRule :: CheckNode Rule
-traverseRule = (ruleBounded & annList !~ traverseRuleVar)
-           >=> (innerExpr !~ traverseExpr)
-           -- some more
-
-  where innerExpr = ruleLhs &+& ruleRhs
-
-traverseRuleVar :: CheckNode RuleVar
-traverseRuleVar = (ruleVarName !~ traverseName)
-              >=> (ruleVarType !~ traverseType)
-
-traversePatternSignature :: CheckNode PatternSignature
-traversePatternSignature = chkPatternSignature
-                       >=> (patSigName & annList !~ traverseName)
-                       >=> (patSigType !~ traverseType)
-
--- DONE
-traverseOverlapPragma :: CheckNode OverlapPragma
-traverseOverlapPragma = return
-
--- weird structure of nodes (Maybe (Ann AnnListG dom stage))
-traverseInstanceRule :: CheckNode InstanceRule
-traverseInstanceRule = (irVars & annJust & element & annList !~ traverseTyVar)
-                   >=> (irCtx & annJust !~ traverseContext)
-                   >=> (irHead !~ traverseInstanceHead)
-
-traverseInstanceHead :: CheckNode InstanceHead
-traverseInstanceHead = (ihConName !~ traverseName)
-                   >=> (ihOperator !~ traverseOperator)
-                   >=> (innerType !~ traverseType)
-                   >=> (innerIHead !~ traverseInstanceHead)
-
-  where innerType = ihLeftOp &+& ihType
-        innerIHead = ihHead &+& ihFun
-
-traverseDeclHead :: CheckNode DeclHead
-traverseDeclHead = (dhName !~ traverseName)
-               >=> (dhOperator !~ traverseOperator)
-               >=> (innerDHead !~ traverseDeclHead)
-               >=> (innerTyVar !~ traverseTyVar)
-
-  where innerDHead = dhBody &+& dhAppFun
-        innerTyVar = dhAppOperand &+& dhLeft &+& dhRight
-
-traverseGadtConDecl :: CheckNode GadtConDecl
-traverseGadtConDecl = (gadtConNames & annList !~ traverseName)
-                  >=> (gadtConTypeArgs & annList !~ traverseTyVar)
-                  >=> (gadtConTypeCtx & annJust !~ traverseContext)
-                  >=> (gadtConType !~ traverseGadtConType)
-
-traverseGadtConType :: CheckNode GadtConType
-traverseGadtConType = (innerType !~ traverseType)
-                  >=> (gadtConRecordFields & annList !~ traverseFieldDecl)
-
-  where innerType = gadtConNormalType &+& gadtConResultType
-
-traverseFieldDecl :: CheckNode FieldDecl
-traverseFieldDecl = (fieldNames & annList !~ traverseName)
-                >=> (fieldType !~ traverseType)
-
-traverseFunDeps :: CheckNode FunDeps
-traverseFunDeps = funDeps & annList !~ traverseFunDep
-
-traverseFunDep :: CheckNode FunDep
-traverseFunDep = innerName !~ traverseName
-  where innerName = (funDepLhs & annList) &+& (funDepRhs & annList)
-
-traverseDeriving :: CheckNode Deriving
-traverseDeriving = innerIHead !~ traverseInstanceHead
-  where innerIHead = oneDerived &+& (allDerived & annList)
-
-traverseConDecl :: CheckNode ConDecl
-traverseConDecl = (conTypeArgs & annList !~ traverseTyVar)
-              >=> (conTypeCtx & annJust !~ traverseContext)
-              >=> (conDeclName !~ traverseName)
-              >=> (innerType !~ traverseType)
-              >=> (conDeclFields & annList !~ traverseFieldDecl)
-
-  where innerType = (conDeclArgs & annList)
-                &+& conDeclLhs
-                &+& conDeclRhs
-
--- DONE
-traverseCallConv :: CheckNode CallConv
-traverseCallConv = return
-
-traverseMinimalFormula :: CheckNode MinimalFormula
-traverseMinimalFormula = (minimalName !~ traverseName)
-                     >=> (innerFormula !~ traverseMinimalFormula)
-
-  where innerFormula = minimalInner
-                   &+& (minimalOrs & annList)
-                   &+& (minimalAnds & annList)
-
--- there is no wrapper type for InlinePragma
--- no references generated
-traverseInlinePragma :: CheckUNode UInlinePragma
-traverseInlinePragma = return {- nnerName !~ traverseName
-  where innerName = inlineDef &+& noInlineDef &+& inlinableDef -}
-
-
-
-
-traversePatternSynonym :: CheckNode PatternSynonym
-traversePatternSynonym = chkPatternSynonym
-                         >=> (patRhs !~ traverseInnerRhs)
-                         >=> (patLhs !~ traverseInnerLhs)
-
-  where traverseInnerRhs = (patRhsPat !~ traversePattern)
-          >=> (patRhsOpposite & annJust & patOpposite & annList !~ traverseMatch)
-
-        traverseInnerLhs = (innerName !~ traverseName)
-                           >=> (patSynOp !~ traverseOperator)
-
-        innerName = patName &+& (patArgs & annList) &+& patSynLhs &+& patSynRhs
-
-
-
-traverseMatch :: CheckNode Match
-traverseMatch = (matchLhs !~ traverseMatchLhs)
-                >=> (matchRhs !~ traverseRhs)
-                >=> (matchBinds & annJust !~ traverseLocalBinds)
-
-traverseMatchLhs :: CheckNode MatchLhs
-traverseMatchLhs = (matchLhsName !~ traverseName)
-                   >=> (matchLhsOperator !~ traverseOperator)
-                   >=> (innerPattern !~ traversePattern)
-
-  where innerPattern = matchLhsArgs & annList
-                       &+& matchLhsLhs
-                       &+& matchLhsRhs
-
-traverseRhs :: CheckNode Rhs
-traverseRhs = (rhsExpr !~ traverseExpr)
-              >=> (rhsGuards & annList !~ traverseGuardedRhs)
-
-traverseGuardedRhs :: CheckNode GuardedRhs
-traverseGuardedRhs = (guardStmts & annList !~ traverseRhsGuard)
-                     >=> (guardExpr !~ traverseExpr)
-
-traverseRhsGuard :: CheckNode RhsGuard
-traverseRhsGuard = (guardPat !~ traversePattern)
-                   >=> (guardRhs &+& guardCheck !~ traverseExpr)
-                   >=> (guardBinds & annList !~ traverseLocalBind)
-
-traverseLocalBinds :: CheckNode LocalBinds
-traverseLocalBinds = localBinds & annList !~ traverseLocalBind
-
-traverseLocalBind :: CheckNode LocalBind
-traverseLocalBind = (localVal !~ traverseValueBind)
-                    >=> (localSig !~ traverseTypeSignature)
-                    >=> (localFixity !~ traverseFixitySignature)
-                    -- >=> (localInline !~ ...)
-
-
-traverseInstBody :: CheckNode InstBody
-traverseInstBody = instBodyDecls & annList !~ traverseInstBodyDecl
-
-traverseInstBodyDecl :: CheckNode InstBodyDecl
-traverseInstBodyDecl = (instBodyDeclFunbind !~ traverseValueBind)
-                       >=> (instBodyTypeSig !~ traverseTypeSignature)
-                       >=> (instBodyTypeEqn !~ traverseTypeEqn)
-                       >=> (specializeInstanceType !~ traverseType)
-                       -- and many more ...
-
-traverseTypeEqn :: CheckNode TypeEqn
-traverseTypeEqn = teLhs &+& teRhs !~ traverseType
-
-traverseClassBody :: CheckNode ClassBody
-traverseClassBody = cbElements & annList !~ traverseClassElem
-
-traverseClassElem :: CheckNode ClassElement
-traverseClassElem = (ceTypeSig !~ traverseTypeSignature)
-                    >=> (clsFixity !~ traverseFixitySignature)
-                    >=> (ceBind !~ traverseValueBind)
-                    >=> (ceName !~ traverseName)
-                    >=> (ceKind &+& ceType !~ traverseType)
-
-                    -- some more, but are not important
-
-
-traverseValueBind :: CheckNode ValueBind
-traverseValueBind = (valBindPat !~ traversePattern)
-                    >=> (valBindRhs !~ traverseRhs)
-                    >=> (valBindLocals & annJust !~ traverseLocalBinds)
-                    >=> (funBindMatches & annList !~ traverseMatch)
-
-
-traversePattern :: CheckNode Pattern
-traversePattern = chkPattern
-                  >=> (innerPattern !~ traversePattern)
-                  >=> (innerLiteral !~ traverseLiteral)
-                  >=> (patternOperator !~ traverseOperator)
-                  >=> (patternFields & annList !~ traversePatternField)
-                  >=> (patternName !~ traverseName)
-                  >=> (patternExpr !~ traverseExpr)
-                  >=> (patternType !~ traverseType)
-                  >=> (patternSplice !~ traverseSplice)
-                  >=> (patQQ !~ traverseQuasiQuote)
-
-  where
-  innerPattern = patternLhs
-                 &+& patternRhs
-                 &+& patternInner
-                 &+& (patternElems & annList)
-                 &+& (patternArgs & annList)
-
-  innerLiteral = patternLiteral &+& patternLit
-
-traversePatternField :: CheckNode PatternField
-traversePatternField = chkPatternField
-                       >=> (fieldPatternName !~ traverseName)
-                       >=> (fieldPattern !~ traversePattern)
-
--- TODO: TemplateHaskell?
-traverseExpr :: CheckNode Expr
-traverseExpr = chkExpr
-              >=> (innerExpressions !~ traverseExpr)
-              >=> (innerPatterns !~ traversePattern)
-              >=> (exprFunBind & annList !~ traverseLocalBind)
-              >=> (exprIfAlts & annList !~ traverseGuardedCaseRhs traverseExpr)
-              >=> (exprAlts & annList !~ traverseAlt traverseExpr)
-              >=> (exprOperator !~ traverseOperator)
-              >=> (exprLit !~ traverseLiteral)
-              >=> (innerNames !~ traverseName)
-              >=> (exprStmts & annList !~ traverseStmt traverseExpr)
-              >=> (tupleSectionElems & annList !~ traverseTupSecElem)
-              >=> (exprRecFields & annList !~ traverseFieldUpdate)
-              >=> (compBody & annList !~ traverseListCompBody)
-              >=> (innerTypes !~ traverseType)
-              >=> (exprSplice !~ traverseSplice)
-              >=> (exprBracket !~ traverseBracket)
-              >=> (exprQQ !~ traverseQuasiQuote)
-
- where innerExpressions = (tupleElems & annList)
-                         &+& (listElems & annList)
-                         &+& innerExpr
-                         &+& exprCond
-                         &+& exprThen
-                         &+& exprElse
-                         &+& exprRhs
-                         &+& exprLhs
-                         &+& exprInner
-                         &+& exprFun
-                         &+& exprCase
-                         &+& exprArg
-                         &+& enumToFix
-                         &+& (enumTo & annJust)
-                         &+& (enumThen & annJust)
-                         &+& Refact.enumFrom
-                         &+& compExpr
-
-       innerPatterns = (exprBindings & annList) &+& procPattern
-       innerNames    = exprName &+& exprRecName &+& quotedName
-       innerTypes    = exprSig &+& exprType
-
--- These types are needed to generalize AST traversal for polymorphic nodes.
--- These nodes are polymorphic in their inner nodes, which can be any "UNodes"
--- (UType. UExpr, UDecl etc ...)
-type AltG uexpr dom            = Ann (UAlt' uexpr) dom SrcTemplateStage
-type StmtG uexpr dom           = Ann (UStmt' uexpr) dom SrcTemplateStage
-type CaseRhsG uexpr dom        = Ann (UCaseRhs' uexpr) dom SrcTemplateStage
-type GuardedCaseRhsG uexpr dom = Ann (UGuardedCaseRhs' uexpr) dom SrcTemplateStage
-
-type PromotedG t dom = Ann (UPromoted t) dom  SrcTemplateStage
-
-traverseAlt :: CheckUNode uexpr -> CheckNode (AltG uexpr IdDom)
-traverseAlt f = (altPattern !~ traversePattern)
-               >=> (altRhs !~ traverseCaseRhs f)
-               >=> (altBinds & annJust !~ traverseLocalBinds)
-
-traverseCaseRhs :: CheckUNode uexpr -> CheckNode (CaseRhsG uexpr IdDom)
-traverseCaseRhs f = (rhsCaseExpr !~ f)
-                   >=> (rhsCaseGuards & annList !~ traverseGuardedCaseRhs f)
-
-traverseGuardedCaseRhs :: CheckUNode uexpr -> CheckNode (GuardedCaseRhsG uexpr IdDom)
-traverseGuardedCaseRhs f = (caseGuardStmts & annList !~ traverseRhsGuard)
-                          >=> (caseGuardExpr !~ f)
-
-traverseStmt :: CheckUNode uexpr -> CheckNode (StmtG uexpr IdDom)
-traverseStmt f = (stmtPattern !~ traversePattern)
-                >=> (stmtExpr !~ f)
-                >=> (stmtBinds & annList !~ traverseLocalBind)
-                >=> (cmdStmtBinds & annList !~ traverseStmt f)
-
-traversePromoted :: CheckUNode t -> CheckNode (PromotedG t IdDom)
-traversePromoted f = (promotedConName !~ traverseName)
-                 >=> (promotedElements & annList !~ f)
-
-traverseTupSecElem :: CheckNode TupSecElem
-traverseTupSecElem = tupSecExpr !~ traverseExpr
-
-traverseFieldUpdate :: CheckNode FieldUpdate
-traverseFieldUpdate = chkFieldUpdate
-                      >=> (fieldName &+& fieldUpdateName !~ traverseName)
-                      >=> (fieldValue !~ traverseExpr)
-
-traverseListCompBody :: CheckNode ListCompBody
-traverseListCompBody = compStmts & annList !~ traverseCompStmt
-
-traverseCompStmt :: CheckNode CompStmt
-traverseCompStmt = (compStmt !~ traverseStmt traverseExpr)
-                  >=> (innerExpressions !~ traverseExpr)
-
- where innerExpressions = thenExpr
-                          &+& (byExpr & annJust)
-                          &+& (usingExpr & annJust)
-
-traverseCmd :: CheckNode Cmd
-traverseCmd = return
-{-
-
-References are not generated for UCmd
-
-traverseCmd = (innerExpressions !~ traverseExpr)
-             >=> (innerCmds !~ traverseCmd)
-             >=> (cmdStmtBinds & annList !~ traversePattern)
-             >=> (cmdBinds & annList !~ traverseLocalBind)
-             >=> (cmdAlts & annList !~ traverseAlt traverseCmd)
-             >=> (cmdStmts & annList !~ traverseStmt traverseCmd)
- where innerExpressions = cmdLhs &+& cmdRhs &+& cmdExpr &+& cmdApplied
-
-       innerCmds = (cmdInnerCmds & annList)
-                   &+& cmdInnerCmd
-                   &+& cmdLeftCmd
-                   &+& cmdRightCmd
-                   &+& cmdInner
-                   &+& cmdThen
-                   &+& cmdElse
--}
-
-traverseSplice :: CheckNode Splice
-traverseSplice = chkTemplateHaskellSplice
-                 >=> (spliceId !~ traverseName)
-                 >=> (spliceExpr !~ traverseExpr)
-
-traverseBracket :: CheckNode Bracket
-traverseBracket = chkTemplateHaskellBracket
-                  >=> (bracketExpr !~ traverseExpr)
-                  >=> (bracketPattern !~ traversePattern)
-                  >=> (bracketType !~ traverseType)
-                  >=> (bracketDecl & annList !~ traverseDecl)
-
-traverseQuasiQuote :: CheckNode QuasiQuote
-traverseQuasiQuote = chkTemplateHaskellQuasiQuote
-                     >=> (qqExprName !~ traverseName)
-
-traverseType :: CheckNode Type
-traverseType = chkType
-              >=> (typeBounded & annList !~ traverseTyVar)
-              >=> (innerType !~ traverseType)
-              >=> (innerName !~ traverseName)
-              >=> (typeCtx !~ traverseContext)
-              >=> (typeOperator !~ traverseOperator)
-              >=> (typeKind !~ traverseKind)
-              >=> (tpPromoted !~ traversePromoted traverseType)
-              >=> (tsSplice !~ traverseSplice)
-              >=> (typeQQ !~ traverseQuasiQuote)
-
- where innerType = typeType
-                   &+& typeParam
-                   &+& typeResult
-                   &+& (typeElements & annList)
-                   &+& typeElement
-                   &+& typeCon
-                   &+& typeArg
-                   &+& typeInner
-                   &+& typeLeft
-                   &+& typeRight
-
-       innerName = typeName &+& typeWildcardName
-
-traverseTyVar :: CheckNode TyVar
-traverseTyVar = (tyVarName !~ traverseName)
-               >=> (tyVarKind & annJust !~ traverseKindContraint)
-
-traverseKindContraint :: CheckNode KindConstraint
-traverseKindContraint = kindConstr !~ traverseKind
-
-traverseKind :: CheckNode Kind
-traverseKind = chkKind
-           >=> (innerKind !~ traverseKind)
-           >=> (kindVar !~ traverseName)
-           >=> (kindAppOp !~ traverseOperator)
-           >=> (kindPromoted !~ traversePromoted traverseKind)
-
-  where innerKind = kindLeft
-                &+& kindRight
-                &+& kindParen
-                &+& kindAppFun
-                &+& kindAppArg
-                &+& kindLhs
-                &+& kindRhs
-                &+& kindElem
-                &+& (kindElems & annList)
-
-traverseContext :: CheckNode Context
-traverseContext = contextAssertion !~ traverseAssertion
-
-traverseAssertion :: CheckNode Assertion
-traverseAssertion = (innerType !~ traverseType)
-                   >=> (innerName !~ traverseName)
-                   >=> (assertOp !~ traverseOperator)
-                   >=> (innerAsserts & annList !~ traverseAssertion)
-
- where innerType = (assertTypes & annList)
-                   &+& assertLhs
-                   &+& assertRhs
-                   &+& assertImplType
-
-       innerName = assertClsName &+& assertImplVar
-
-traverseName :: CheckNode Name
-traverseName = simpleName !~ traverseQualifiedName
-
-traverseQualifiedName :: CheckNode QualifiedName
-traverseQualifiedName = unqualifiedName !~ traverseNamePart
-                   >=> qualifiers & annList !~ traverseNamePart
-
-traverseNamePart :: CheckNode NamePart
-traverseNamePart = chkNamePart
-
-traverseLiteral :: CheckNode Literal
-traverseLiteral = chkLiteral
-
-traverseOperator :: CheckNode Operator
-traverseOperator = operatorName !~ traverseQualifiedName
-
-traverseTypeSignature :: CheckNode TypeSignature
-traverseTypeSignature = (tsName & annList !~ traverseName)
-                    >=> (tsType !~ traverseType)
-
-traverseFixitySignature :: CheckNode FixitySignature
-traverseFixitySignature = fixityOperators & annList !~ traverseOperator
+traverseModule = topDownM @Checkable check
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Utils/Debug.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE FlexibleInstances #-}
+
+
+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Utils.Debug
+  ( module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Utils.Debug
+  , module Debug.Trace
+  ) where
+
+import Data.Maybe (isJust)
+import Control.Monad.Trans.Maybe
+import Control.Reference ((^.), (&))
+
+import Debug.Trace
+import qualified Outputable as GHC
+
+import Language.Haskell.Tools.Refactor
+
+
+debugM :: (Monad m, Show a) => m a -> m a
+debugM m = do
+  x <- m
+  traceShow x m
+
+debug :: Show a => a -> a
+debug x = traceShow x x
+
+-- | Displays True iff the wrapped value is a Just
+debugMaybeT :: Monad m => MaybeT m a -> MaybeT m a
+debugMaybeT m = MaybeT $ do
+  x <- runMaybeT m
+  traceShow (isJust x) (return x)
+
+showOutputable :: GHC.Outputable a => a -> String
+showOutputable = GHC.showSDocUnsafe . GHC.ppr
+
+showName :: Name -> String
+showName = (^. simpleName & unqualifiedName & simpleNameStr)
+
+showOp :: Operator -> String
+showOp = (^. operatorName & unqualifiedName & simpleNameStr)
− Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Utils/SupportedExtensions.hs 
@@ -1,28 +0,0 @@-module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Utils.SupportedExtensions where
-
-import Language.Haskell.TH.LanguageExtensions (Extension(..))
-
-unregularExts :: String -> String
-unregularExts "CPP" = "Cpp"
-unregularExts "NamedFieldPuns" = "RecordPuns"
-unregularExts "GeneralisedNewtypeDeriving" = "GeneralizedNewtypeDeriving"
-unregularExts e = e
-
-isSupported :: Extension -> Bool
-isSupported = flip elem fullyHandledExtensions
-
-fullyHandledExtensions :: [Extension]
-fullyHandledExtensions = syntacticExtensions
-                      ++ derivingExtensions
-                      -- ++ [FlexibleInstances]
-
-syntacticExtensions :: [Extension]
-syntacticExtensions = [ RecordWildCards, TemplateHaskell, BangPatterns
-                      , PatternSynonyms, TupleSections, LambdaCase, QuasiQuotes
-                      , ViewPatterns, MagicHash, UnboxedTuples]
-
-derivingExtensions :: [Extension]
-derivingExtensions = [ DeriveDataTypeable, DeriveGeneric, DeriveFunctor
-                     , DeriveFoldable, DeriveTraversable, DeriveLift
-                     , DeriveAnyClass, GeneralizedNewtypeDeriving
-                     , StandaloneDeriving, DerivingStrategies ]
− Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Utils/TypeLookup.hs 
@@ -1,82 +0,0 @@-{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
-
-module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Utils.TypeLookup where
-
-
-import Language.Haskell.Tools.AST (simpleName)
-import Language.Haskell.Tools.Refactor
-import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
-
-import Control.Monad.Trans.Maybe (MaybeT(..))
-import Control.Reference ((^.))
-
-import qualified GHC
-import qualified TyCoRep as GHC (Type(..), TyThing(..))
-
-
-chkSynonym :: CheckNode Type
-chkSynonym t = do
-  mtycon <- runMaybeT . lookupType $ t
-  case mtycon of
-    Nothing    -> return t
-    Just tycon -> chkSynonym' tycon
-  where chkSynonym' x = case lookupSynDef x of
-                          Nothing -> return t
-                          Just _  -> addOccurence TypeSynonymInstances t
-
-lookupSynDefM :: Type -> MaybeT ExtMonad GHC.TyCon
-lookupSynDefM t = do
-  tything <- lookupType t
-  liftMaybe $ lookupSynDef tything
-  where liftMaybe = MaybeT . return
-
--- NOTE: Returns Nothing if it is not a type synonym
---       (or has some weird structure I didn't think of)
-lookupSynDef :: GHC.TyThing -> Maybe GHC.TyCon
-lookupSynDef syn = do
-  tycon <- tyconFromTyThing syn
-  rhs   <- GHC.synTyConRhs_maybe tycon
-  tyconFromGHCType rhs
-
-tyconFromTyThing :: GHC.TyThing -> Maybe GHC.TyCon
-tyconFromTyThing (GHC.ATyCon tycon) = Just tycon
-tyconFromTyThing _ = Nothing
-
--- won't bother
-tyconFromGHCType :: GHC.Type -> Maybe GHC.TyCon
-tyconFromGHCType (GHC.AppTy t1 _) = tyconFromGHCType t1
-tyconFromGHCType (GHC.TyConApp tycon _) = Just tycon
-tyconFromGHCType _ = Nothing
-
-
--- NOTE: Return false if the type is certainly not a newtype
---       Returns true if it is a newtype or it could not have been looked up
-isNewtype :: Type -> ExtMonad Bool
-isNewtype t = do
-  tycon <- runMaybeT . lookupType $ t
-  return $! maybe True isNewtypeTyCon tycon
-
-
-
-lookupType :: Type -> MaybeT ExtMonad GHC.TyThing
-lookupType t = do
-  name  <- liftMaybe . nameFromType $ t
-  sname <- liftMaybe . getSemName   $ name
-  MaybeT . GHC.lookupName $ sname
-    where liftMaybe = MaybeT . return
-
--- NOTE: gives just name if the type being scrutinised can be newtype
---       else it gives nothing
-nameFromType :: Type -> Maybe Name
-nameFromType (TypeApp f _)    = nameFromType f
-nameFromType (ParenType x)    = nameFromType x
-nameFromType (KindedType t _) = nameFromType t
-nameFromType (VarType x)      = Just x
-nameFromType _                = Nothing
-
-isNewtypeTyCon :: GHC.TyThing -> Bool
-isNewtypeTyCon (GHC.ATyCon tycon) = GHC.isNewTyCon tycon
-isNewtypeTyCon _ = False
-
-getSemName :: Name -> Maybe GHC.Name
-getSemName x = semanticsName (x ^. simpleName)
Language/Haskell/Tools/Refactor/Builtin/ExtractBinding.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE ConstraintKinds, FlexibleContexts, MultiWayIf, RankNTypes, ScopedTypeVariables, TypeApplications, TypeFamilies, ViewPatterns #-}
+{-# LANGUAGE FlexibleContexts, MonoLocalBinds, MultiWayIf, RankNTypes, ScopedTypeVariables, TypeApplications, ViewPatterns #-}
+
 module Language.Haskell.Tools.Refactor.Builtin.ExtractBinding
   (extractBinding', tryItOut, extractBindingRefactoring) where
Language/Haskell/Tools/Refactor/Builtin/FloatOut.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE ConstraintKinds, FlexibleContexts, LambdaCase, ScopedTypeVariables, TypeApplications, TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts, LambdaCase, MonoLocalBinds, ScopedTypeVariables, TypeApplications #-}
+
 module Language.Haskell.Tools.Refactor.Builtin.FloatOut
   (floatOut, floatOutRefactoring) where
 
@@ -43,13 +44,13 @@                               Extracted binds -> put Inserted >> (return $ annListElems .- (++ binds) $ locs)
                               Inserted -> return locs
   where selected = locs ^? annList & filtered (isInside sp)
-        floated = normalizeElements $ selected ++ (locs ^? annList & filtered (nameIsSelected . (^? elementName)))
-          where nameIsSelected [n] = n `elem` concatMap (^? elementName) selected
+        floated = normalizeElements $ selected ++ (locs ^? annList & filtered (nameIsSelected . map semanticsName . (^? elementName)))
+          where nameIsSelected [n] = n `elem` concatMap (map semanticsName . (^? elementName)) selected
                 nameIsSelected _ = False
 
         filteredLocs = filterList (\e -> not (getRange e `elem` floatedElemRanges)) locs
           where floatedElemRanges = map getRange floated
-        hasSharedSig = any (\e -> not $ null ((filteredLocs ^? annList & elementName) `intersect` (e ^? elementName))) selected
+        hasSharedSig = any (\e -> not $ null (map semanticsName (filteredLocs ^? annList & elementName) `intersect` map semanticsName (e ^? elementName))) selected
         conflicts = map checkConflict selected
 
         nameConflicts = concat $ map fst conflicts
Language/Haskell/Tools/Refactor/Builtin/GenerateExports.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE ConstraintKinds, FlexibleContexts, LambdaCase, TupleSections, TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts, LambdaCase, MonoLocalBinds, TupleSections #-}
+
 module Language.Haskell.Tools.Refactor.Builtin.GenerateExports
   (generateExports, generateExportsRefactoring) where
Language/Haskell/Tools/Refactor/Builtin/GenerateTypeSignature.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE ConstraintKinds, FlexibleContexts, RankNTypes, ScopedTypeVariables, TupleSections, TypeApplications, TypeFamilies, ViewPatterns #-}
+{-# LANGUAGE FlexibleContexts, GADTs, RankNTypes, ScopedTypeVariables, TupleSections, TypeApplications, ViewPatterns #-}
+
 module Language.Haskell.Tools.Refactor.Builtin.GenerateTypeSignature
   ( generateTypeSignature, generateTypeSignature', tryItOut
   , generateTypeSignatureRefactoring) where
+ Language/Haskell/Tools/Refactor/Builtin/GetMatches.hs view
@@ -0,0 +1,45 @@+module Language.Haskell.Tools.Refactor.Builtin.GetMatches where
+
+import Language.Haskell.Tools.Refactor
+
+import Control.Monad.Writer
+import Control.Reference
+import Data.Aeson
+
+import Outputable as GHC
+import SrcLoc as GHC
+import Id as GHC
+import Type as GHC
+import TyCon as GHC
+import DataCon as GHC
+
+getMatchesQuery :: QueryChoice
+getMatchesQuery = LocationQuery "GetMatches" getMatches
+
+getMatches :: RealSrcSpan -> ModuleDom -> [ModuleDom] -> QueryMonad Value
+getMatches sp (_,mod) _
+  = case selectedName of [n] -> do ctors <- getCtors $ idType $ semanticsId n
+                                   return $ toJSON ctors
+                         []  -> queryError "No name is selected."
+                         _   -> queryError "Multiple names are selected."
+  where
+    selectedName :: [QualifiedName]
+    selectedName = mod ^? nodesContaining sp
+
+getCtors :: GHC.Type -> QueryMonad [(String, [String])]
+-- | TODO: unpack forall, context types
+-- | TODO: care for infix constructors
+getCtors t | Just (tc, _) <- splitTyConApp_maybe t
+  = maybe (queryError (noSuccessMsg t)) (return . map formatCtor) (tyConDataCons_maybe tc)
+getCtors t = queryError (noSuccessMsg t)
+
+noSuccessMsg :: GHC.Type -> String
+noSuccessMsg t = "Cannot find the constructors of type " ++ showSDocUnsafe (ppr t)
+
+formatCtor :: DataCon -> (String, [String])
+formatCtor dc = (showSDocUnsafe $ ppr $ dataConName dc, createArgNames (dataConOrigArgTys dc))
+
+-- | TODO: Check for names in scope
+-- | TODO: Create names based on the type
+createArgNames :: [GHC.Type] -> [String]
+createArgNames tys = map (\i -> "p" ++ show i) [1..length tys]
Language/Haskell/Tools/Refactor/Builtin/InlineBinding.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE ConstraintKinds, FlexibleContexts, LambdaCase, MultiWayIf, RankNTypes, ScopedTypeVariables, TypeApplications, TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts, LambdaCase, MonoLocalBinds, MultiWayIf, RankNTypes, ScopedTypeVariables, TypeApplications #-}
+
 -- | Defines the inline binding refactoring that removes a value binding and replaces all occurences
 -- with an expression equivalent to the body of the binding.
 module Language.Haskell.Tools.Refactor.Builtin.InlineBinding
Language/Haskell/Tools/Refactor/Builtin/OrganizeExtensions.hs view
@@ -1,5 +1,6 @@-{-# LANGUAGE ConstraintKinds, FlexibleContexts, RankNTypes, TupleSections, TypeFamilies, LambdaCase #-}
+{-# LANGUAGE FlexibleContexts, LambdaCase, MonoLocalBinds, RankNTypes, TupleSections #-}
 
+
 module Language.Haskell.Tools.Refactor.Builtin.OrganizeExtensions
   ( module Language.Haskell.Tools.Refactor.Builtin.OrganizeExtensions
   , module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
@@ -7,18 +8,19 @@ 
 import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
 import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.TraverseAST
-import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Utils.SupportedExtensions (unregularExts, isSupported, fullyHandledExtensions)
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.SupportedExtensions (isSupported)
 
 import Language.Haskell.Tools.Refactor hiding (LambdaCase)
-import Language.Haskell.Tools.Refactor.Utils.Extensions (expandExtension)
+import Language.Haskell.Tools.Refactor.Utils.Extensions
 
 import GHC (Ghc(..))
 
 import Control.Reference
 import Data.Char (isAlpha)
 import Data.Function (on)
+import Data.Maybe (mapMaybe)
 import Data.List
-import qualified Data.Map.Strict as SMap (keys, empty)
+import qualified Data.Map.Strict as SMap (empty)
 
 -- NOTE: When working on the entire AST, we should build a monad,
 --       that will will avoid unnecessary checks.
@@ -42,61 +44,55 @@ organizeExtensions :: LocalRefactoring
 organizeExtensions moduleAST = do
   exts <- liftGhc $ reduceExtensions moduleAST
-  let isRedundant e = extName `notElem` foundExts && extName `elem` handledExts
-        where extName = unregularExts (e ^. langExt)
-      handledExts = map show fullyHandledExtensions
-      foundExts = map show exts
+  let langExts = mkLanguagePragma . map show $ exts
+      ghcOpts  = moduleAST ^? filePragmas & annList & opStr & stringNodeStr
+      ghcOpts' = map (mkOptionsGHC . unwords . filter (isPrefixOf "-") . words) ghcOpts
 
-  -- remove unused extensions (only those that are fully handled)
-  filePragmas & annList & lpPragmas !~ filterListSt (not . isRedundant)
-        -- remove empty {-# LANGUAGE #-} pragmas
+      newPragmas = mkFilePragmas $ langExts:ghcOpts'
+
+  (filePragmas != newPragmas)
+    -- remove empty {-# LANGUAGE #-} pragmas
     >=> filePragmas !~ filterListSt (\case LanguagePragma (AnnList []) -> False; _ -> True)
     $ moduleAST
 
 -- | Reduces default extension list (keeps unsupported extensions)
 reduceExtensions :: UnnamedModule -> Ghc [Extension]
-reduceExtensions = \moduleAST -> do
-  let expanded = expandDefaults moduleAST
+reduceExtensions moduleAST = do
+  let defaults = map replaceDeprecated . collectDefaultExtensions $ moduleAST
+      expanded = expandExtensions defaults
       (xs, ys) = partition isSupported expanded
-  xs' <- flip execStateT SMap.empty . flip runReaderT xs . traverseModule $ moduleAST
-  return . sortBy (compare `on` show) . mergeInduced . nub $ (calcExts xs' ++ ys)
-
-  where isLVar (LVar _) = True
-        isLVar _        = False
-
-        calcExts :: ExtMap -> [Extension]
-        calcExts logRels
-          | ks <- SMap.keys logRels
-          , all isLVar ks
-          = map (\(LVar x) -> x) . SMap.keys $ logRels
-          | otherwise     = []
-
-        rmInduced :: Extension -> [Extension] -> [Extension]
-        rmInduced e = flip (\\) induced
-          where induced = delete e $ expandExtension e
-
-        mergeInduced :: [Extension] -> [Extension]
-        mergeInduced exts = foldl (flip rmInduced) exts exts
-
+  -- we can't say anything about generated code
+  if TemplateHaskell `notElem` expanded
+    then do
+      xs' <- flip execStateT SMap.empty . flip runReaderT xs . traverseModule $ moduleAST
+      -- Merging is needed because there might be unsopported extensions
+      -- that are implied by supported extensions (TypeFamilies -> MonoLocalBinds)
+      return . sortBy (compare `on` show) . nub . mergeImplied $ (determineExtensions xs' ++ ys)
+    else
+      return . mergeImplied $ defaults
 
 -- | Collects extensions induced by the source code (with location info)
 collectExtensions :: UnnamedModule -> Ghc ExtMap
-collectExtensions moduleAST = do
-  let expanded = expandDefaults moduleAST
-  flip execStateT SMap.empty . flip runReaderT expanded . traverseModule $ moduleAST
+collectExtensions = collectExtensionsWith traverseModule
 
--- | Collects default extension list, and expands each extension
-expandDefaults :: UnnamedModule -> [Extension]
-expandDefaults = nub . concatMap expandExtension . collectDefaultExtensions
+collectExtensionsWith :: CheckNode UnnamedModule -> UnnamedModule -> Ghc ExtMap
+collectExtensionsWith trvModule moduleAST = do
+  let expanded = expandExtensions . collectDefaultExtensions $ moduleAST
+  flip execStateT SMap.empty . flip runReaderT expanded . trvModule $ moduleAST
 
+
+-- | Expands every extension in a list, while not producing any duplicates.
+expandExtensions :: [Extension] -> [Extension]
+expandExtensions = nub . concatMap expandExtension
+
 -- | Collects extensions enabled by default
 collectDefaultExtensions :: UnnamedModule -> [Extension]
-collectDefaultExtensions = map toExt . getExtensions
+collectDefaultExtensions = mapMaybe toExt . getExtensions
   where
   getExtensions :: UnnamedModule -> [String]
   getExtensions = flip (^?) (filePragmas & annList & lpPragmas & annList & langExt)
 
-toExt :: String -> Extension
-toExt str = case map fst . reads . unregularExts . takeWhile isAlpha $ str of
-              e:_ -> e
-              []  -> error $ "Extension '" ++ takeWhile isAlpha str ++ "' is not known."
+toExt :: String -> Maybe Extension
+toExt str = case map fst . reads . canonExt . takeWhile isAlpha $ str of
+              e:_ -> Just e
+              []  -> fail $ "Extension '" ++ takeWhile isAlpha str ++ "' is not known."
Language/Haskell/Tools/Refactor/Builtin/OrganizeImports.hs view
@@ -1,10 +1,5 @@-{-# LANGUAGE ConstraintKinds
-           , FlexibleContexts
-           , LambdaCase
-           , ScopedTypeVariables
-           , TupleSections
-           , TypeApplications
-           , TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts, LambdaCase, MonoLocalBinds, ScopedTypeVariables, TupleSections, TypeApplications #-}
+
 module Language.Haskell.Tools.Refactor.Builtin.OrganizeImports
   ( organizeImports, projectOrganizeImports
   , organizeImportsRefactoring, projectOrganizeImportsRefactoring
@@ -26,6 +21,7 @@ import SrcLoc (SrcSpan(..), noSrcSpan)
 import TyCon (TyCon(..), tyConFamInst_maybe)
 import Unique (getUnique)
+import CoreSyn as GHC (isOrphan)
 
 import Control.Applicative ((<$>), Alternative(..))
 import Control.Monad
@@ -64,9 +60,9 @@        if noNarrowingImports
          then -- we don't know what definitions the generated code will use
               return $ modImports .- sortImports $ mod
-         else modImports !~ narrowImports noNarrowingSubspecs exportedModules (addFromString dfs usedNames) exportedNames prelInstances prelFamInsts . sortImports $ mod
-  where prelInstances = semanticsPrelOrphanInsts mod
-        prelFamInsts = semanticsPrelFamInsts mod
+         else do (prelInstances, prelFamInsts) <- liftGhc $ getInstances preludeAccessible
+                 modImports !~ fmap sortImports . narrowImports noNarrowingSubspecs exportedModules (addFromString dfs usedNames) exportedNames prelInstances prelFamInsts $ mod
+  where preludeAccessible = semanticsPrelTransMods mod
         addFromString dfs = if xopt OverloadedStrings dfs then (GHC.fromStringName :) else id
         usedNames = map getName $ (catMaybes $ map semanticsName
                         -- obviously we don't want the names in the imports to be considered, but both from
@@ -123,9 +119,9 @@ -- | Modify an import to only import  names that are used.
 narrowImports :: Bool -> [String] -> [GHC.Name] -> [(GHC.Name, Bool)] -> [ClsInst] -> [FamInst] -> ImportDeclList -> LocalRefactor ImportDeclList
 narrowImports noNarrowSubspecs exportedModules usedNames exportedNames prelInsts prelFamInsts imps
-  = (annListElems & traversal !~ narrowImport noNarrowSubspecs exportedModules usedNames exportedNames)
-      =<< filterListIndexedSt (\i _ -> impsNeeded !! i) imps
-  where impsNeeded = neededImports exportedModules (usedNames ++ map fst exportedNames) prelInsts prelFamInsts (imps ^. annListElems)
+  = do impsNeeded <- liftGhc $ neededImports exportedModules (usedNames ++ map fst exportedNames) prelInsts prelFamInsts (imps ^. annListElems)
+       (annListElems & traversal !~ narrowImport noNarrowSubspecs exportedModules usedNames exportedNames)
+          =<< filterListIndexedSt (\i _ -> impsNeeded !! i) imps
 
 -- | Reduces the number of definitions used from an import
 narrowImport :: Bool -> [String] -> [GHC.Name] -> [(GHC.Name, Bool)] -> ImportDecl -> LocalRefactor ImportDecl
@@ -187,22 +183,24 @@         createIESpec (n, True)  = mkIESpec (mkUnqualName' (GHC.getName n)) (Just mkSubAll)
 
 -- | Check each import if it is actually needed
-neededImports :: [String] -> [GHC.Name] -> [ClsInst] -> [FamInst] -> [ImportDecl] -> [Bool]
-neededImports exportedModules usedNames prelInsts prelFamInsts imps = neededImports' usedNames [] imps
-  where neededImports' _ _ [] = []
+neededImports :: [String] -> [GHC.Name] -> [ClsInst] -> [FamInst] -> [ImportDecl] -> GHC.Ghc [Bool]
+neededImports exportedModules usedNames prelInsts prelFamInsts imps = do
+     impsWithInsts <- mapM (\i -> (i,) <$> getInstances (semanticsTransMods i)) imps  
+     return $ neededImports' usedNames [] prelInsts prelFamInsts impsWithInsts
+  where neededImports' _ _ _ _ [] = []
         -- keep the import if any definition is needed from it
-        neededImports' usedNames kept (imp : rest)
+        neededImports' usedNames kept keptInsts keptFamInsts ((imp, (clsInsts, famInsts)) : rest)
           | not (null actuallyImported)
                || (imp ^. importModule & moduleNameString) `elem` exportedModules
                || maybe False (`elem` exportedModules) (imp ^? importAs & annJust & importRename & moduleNameString)
-            = True : neededImports' usedNames (imp : kept) rest
+            = True : neededImports' usedNames (imp : kept) (clsInsts ++ keptInsts) (famInsts ++ keptFamInsts) rest
           where actuallyImported = semanticsImported imp `intersect` usedNames
-        neededImports' usedNames kept (imp : rest)
-            = needed : neededImports' usedNames (if needed then imp : kept else kept) rest
-          where needed = any (`notElem` otherClsInstances) (map is_dfun $ semanticsOrphanInsts imp)
-                           || any (`notElem` otherFamInstances) (map fi_axiom $ semanticsFamInsts imp)
-                otherClsInstances = map is_dfun (concatMap semanticsOrphanInsts kept ++ prelInsts)
-                otherFamInstances = map fi_axiom (concatMap semanticsFamInsts kept ++ prelFamInsts)
+        -- check if instances are needed from the import
+        neededImports' usedNames kept keptInsts keptFamInsts ((imp, (clsInsts, famInsts)) : rest)
+            = needed : if needed then neededImports' usedNames (imp : kept) (clsInsts ++ keptInsts) (famInsts ++ keptFamInsts) rest
+                                 else neededImports' usedNames kept keptInsts keptFamInsts rest
+          where needed = any (`notElem` map is_dfun keptInsts) (map is_dfun $ filter (isOrphan . is_orphan) clsInsts)
+                           || any (`notElem` map fi_axiom keptFamInsts) (map fi_axiom famInsts)
 
 -- | Narrows the import specification (explicitly imported elements)
 narrowImportSpecs :: Bool -> [GHC.Name] -> [(GHC.Name, Bool)] -> IESpecList -> LocalRefactor IESpecList
Language/Haskell/Tools/Refactor/Builtin/RenameDefinition.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE ConstraintKinds, FlexibleContexts, MultiWayIf, ScopedTypeVariables, TupleSections, TypeApplications, TypeFamilies, ViewPatterns #-}
+{-# LANGUAGE FlexibleContexts, MonoLocalBinds, MultiWayIf, ScopedTypeVariables, TupleSections, TypeApplications, ViewPatterns #-}
+
 module Language.Haskell.Tools.Refactor.Builtin.RenameDefinition
   (renameDefinition, renameDefinition', renameDefinitionRefactoring) where
+ examples/CPP/A.hs view
@@ -0,0 +1,3 @@+module CPP.A where
+
+a = ()
+ examples/CPP/B.hs view
@@ -0,0 +1,3 @@+module CPP.B where
+
+b = ()
examples/CPP/BetweenImports.hs view
@@ -1,10 +1,9 @@ {-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleContexts #-}
 module CPP.BetweenImports where
 
-import Data.List
+import CPP.A(a)
 #if !(MIN_VERSION_text(1,2,1))
 #endif
-import Data.Maybe
+import CPP.B(b)
 
-x = Just
+x = a
examples/CPP/BetweenImports_res.hs view
@@ -1,10 +1,9 @@ {-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleContexts #-}
 module CPP.BetweenImports where
 
-import Data.Maybe (Maybe(..))
+import CPP.A(a)
 #if !(MIN_VERSION_text(1,2,1))
 #endif
 
 
-x = Just
+x = a
+ examples/CPP/C.hs view
@@ -0,0 +1,3 @@+module CPP.C where
+ 
+c = ()
− examples/CPP/ConditionalCode.hs 
@@ -1,8 +0,0 @@-{-# LANGUAGE CPP #-}
-module CPP.ConditionalCode where
-
-#if __GLASGOW_HASKELL__ >= 800
-version = "GHC 8"
-#else
-version = "not GHC 8"
-#endif
examples/CPP/ConditionalImport.hs view
@@ -1,10 +1,10 @@ {-# LANGUAGE CPP #-}
 module CPP.ConditionalImport where
 
-import Data.List
+import CPP.A(a)
 #ifndef USE_DATA_LIST
-import Control.Monad (Monad(..))
+import CPP.B(b)
 #endif
-import Data.List
+import CPP.A(a)
 
-a = Nothing >> Nothing
+x = b
examples/CPP/ConditionalImportBegin.hs view
@@ -2,9 +2,9 @@ module CPP.ConditionalImportBegin where
 
 #ifndef USE_DATA_LIST
-import Control.Monad ((>>))
+import CPP.A(a)
 #endif
-import Data.List
-import Data.List
+import CPP.B(b)
+import CPP.B(b)
 
-a = Nothing >> Nothing
+x = a
examples/CPP/ConditionalImportBegin_res.hs view
@@ -2,8 +2,8 @@ module CPP.ConditionalImportBegin where
 
 #ifndef USE_DATA_LIST
-import Control.Monad ((>>))
+import CPP.A(a)
 #endif
 
 
-a = Nothing >> Nothing
+x = a
examples/CPP/ConditionalImportEnd.hs view
@@ -1,10 +1,10 @@ {-# LANGUAGE CPP #-}
 module CPP.ConditionalImportEnd where
 
-import Data.List
-import Data.List
+import CPP.B(b)
+import CPP.B(b)
 #ifndef USE_DATA_LIST
-import Control.Monad ((>>))
+import CPP.A(a)
 #endif
 
-a = Nothing >> Nothing
+x = a
examples/CPP/ConditionalImportEnd_res.hs view
@@ -3,7 +3,7 @@ 
 
 #ifndef USE_DATA_LIST
-import Control.Monad ((>>))
+import CPP.A(a)
 #endif
 
-a = Nothing >> Nothing
+x = a
examples/CPP/ConditionalImportHalfRemoved.hs view
@@ -1,10 +1,10 @@ {-# LANGUAGE CPP #-}
 module CPP.ConditionalImportHalfRemoved where
 
-import Data.List
+import CPP.A(a)
 #ifndef USE_DATA_LIST
-import Control.Monad ((>>))
+import CPP.B(b)
 #endif
-import Control.Applicative ((<$>))
+import CPP.C(c)
 
-a = id <$> (Nothing >> Nothing)
+x = (b,c)
examples/CPP/ConditionalImportHalfRemoved_res.hs view
@@ -3,8 +3,8 @@ 
 
 #ifndef USE_DATA_LIST
-import Control.Monad ((>>))
+import CPP.B(b)
 #endif
-import Control.Applicative ((<$>))
+import CPP.C(c)
 
-a = id <$> (Nothing >> Nothing)
+x = (b,c)
examples/CPP/ConditionalImportMulti.hs view
@@ -1,11 +1,11 @@ {-# LANGUAGE CPP #-}
 module CPP.ConditionalImportMulti where
 
-import Data.List
+import CPP.A
 #ifndef USE_DATA_LIST
-import Control.Applicative ((<$>))
-import Control.Monad ((>>))
+import CPP.B(b)
+import CPP.C(c)
 #endif
-import Data.List
+import CPP.A
 
-a = id <$> (Nothing >> Nothing)
+x = (b,c)
examples/CPP/ConditionalImportMulti_res.hs view
@@ -3,9 +3,9 @@ 
 
 #ifndef USE_DATA_LIST
-import Control.Applicative ((<$>))
-import Control.Monad ((>>))
+import CPP.B(b)
+import CPP.C(c)
 #endif
 
 
-a = id <$> (Nothing >> Nothing)
+x = (b,c)
examples/CPP/ConditionalImportOrder.hs view
@@ -1,13 +1,10 @@ {-# LANGUAGE CPP #-}
 module CPP.ConditionalImportOrder where
 
-import Data.List (intersperse)
+import CPP.C(c)
 #ifndef USE_DATA_LIST
-import Control.Monad (Monad(..))
+import CPP.B(b)
 #endif
-import Control.Applicative ((<$>))
-
-a = Nothing >> Nothing
+import CPP.A(a)
 
-b = id <$> Nothing
-c = intersperse "," ["a","b"]
+x = (a,b,c)
examples/CPP/ConditionalImportOrder_res.hs view
@@ -1,13 +1,10 @@ {-# LANGUAGE CPP #-}
 module CPP.ConditionalImportOrder where
 
-import Data.List (intersperse)
+import CPP.C(c)
 #ifndef USE_DATA_LIST
-import Control.Monad (Monad(..))
+import CPP.B(b)
 #endif
-import Control.Applicative ((<$>))
-
-a = Nothing >> Nothing
+import CPP.A(a)
 
-b = id <$> Nothing
-c = intersperse "," ["a","b"]
+x = (a,b,c)
examples/CPP/ConditionalImport_res.hs view
@@ -3,8 +3,8 @@ 
 
 #ifndef USE_DATA_LIST
-import Control.Monad (Monad(..))
+import CPP.B(b)
 #endif
 
 
-a = Nothing >> Nothing
+x = b
− examples/CPP/JustEnabled.hs 
@@ -1,2 +0,0 @@-{-# LANGUAGE CPP #-}
-module CPP.JustEnabled where
− examples/CppHs/Language/Preprocessor/Cpphs.hs 
@@ -1,34 +0,0 @@------------------------------------------------------------------------------
--- |
--- Module      :  Language.Preprocessor.Cpphs
--- Copyright   :  2000-2006 Malcolm Wallace
--- Licence     :  LGPL
---
--- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
--- Stability   :  experimental
--- Portability :  All
---
--- Include the interface that is exported
------------------------------------------------------------------------------
-
-module Language.Preprocessor.Cpphs
-  ( runCpphs, runCpphsPass1, runCpphsPass2, runCpphsReturningSymTab
-  , cppIfdef, tokenise, WordStyle(..)
-  , macroPass, macroPassReturningSymTab
-  , CpphsOptions(..), BoolOptions(..)
-  , parseOptions, defaultCpphsOptions, defaultBoolOptions
-  , module Language.Preprocessor.Cpphs.Position
-  ) where
-
-import Language.Preprocessor.Cpphs.CppIfdef(cppIfdef)
-import Language.Preprocessor.Cpphs.MacroPass(macroPass
-                                            ,macroPassReturningSymTab)
-import Language.Preprocessor.Cpphs.RunCpphs(runCpphs
-                                           ,runCpphsPass1
-                                           ,runCpphsPass2
-                                           ,runCpphsReturningSymTab)
-import Language.Preprocessor.Cpphs.Options
-       (CpphsOptions(..), BoolOptions(..), parseOptions
-       ,defaultCpphsOptions,defaultBoolOptions)
-import Language.Preprocessor.Cpphs.Position
-import Language.Preprocessor.Cpphs.Tokenise
− examples/CppHs/Language/Preprocessor/Cpphs/CppIfdef.hs 
@@ -1,416 +0,0 @@------------------------------------------------------------------------------
--- |
--- Module      :  CppIfdef
--- Copyright   :  1999-2004 Malcolm Wallace
--- Licence     :  LGPL
--- 
--- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
--- Stability   :  experimental
--- Portability :  All
-
--- Perform a cpp.first-pass, gathering \#define's and evaluating \#ifdef's.
--- and \#include's.
------------------------------------------------------------------------------
-
-module Language.Preprocessor.Cpphs.CppIfdef
-  ( cppIfdef    -- :: FilePath -> [(String,String)] -> [String] -> Options
-                --      -> String -> IO [(Posn,String)]
-  ) where
-
-
-import Text.Parse
-import Language.Preprocessor.Cpphs.SymTab
-import Language.Preprocessor.Cpphs.Position  (Posn,newfile,newline,newlines
-                                             ,cppline,cpp2hask,newpos)
-import Language.Preprocessor.Cpphs.ReadFirst (readFirst)
-import Language.Preprocessor.Cpphs.Tokenise  (linesCpp,reslash)
-import Language.Preprocessor.Cpphs.Options   (BoolOptions(..))
-import Language.Preprocessor.Cpphs.HashDefine(HashDefine(..),parseHashDefine
-                                             ,expandMacro)
-import Language.Preprocessor.Cpphs.MacroPass (preDefine,defineMacro)
-import Data.Char        (isDigit,isSpace,isAlphaNum)
-import Data.List        (intercalate,isPrefixOf)
-import Numeric          (readHex,readOct,readDec)
-import System.IO.Unsafe (unsafeInterleaveIO)
-import System.IO        (hPutStrLn,stderr)
-import Control.Monad    (when)
-
--- | Run a first pass of cpp, evaluating \#ifdef's and processing \#include's,
---   whilst taking account of \#define's and \#undef's as we encounter them.
-cppIfdef :: FilePath            -- ^ File for error reports
-        -> [(String,String)]    -- ^ Pre-defined symbols and their values
-        -> [String]             -- ^ Search path for \#includes
-        -> BoolOptions          -- ^ Options controlling output style
-        -> String               -- ^ The input file content
-        -> IO [(Posn,String)]   -- ^ The file after processing (in lines)
-cppIfdef fp syms search options =
-    cpp posn defs search options (Keep []) . initial . linesCpp
-  where
-    posn = newfile fp
-    defs = preDefine options syms
-    initial = if literate options then id else (cppline posn:)
--- Previous versions had a very simple symbol table  mapping strings
--- to strings.  Now the #ifdef pass uses a more elaborate table, in
--- particular to deal with parameterised macros in conditionals.
-
-
--- | Internal state for whether lines are being kept or dropped.
---   In @Drop n b ps@, @n@ is the depth of nesting, @b@ is whether
---   we have already succeeded in keeping some lines in a chain of
---   @elif@'s, and @ps@ is the stack of positions of open @#if@ contexts,
---   used for error messages in case EOF is reached too soon.
-data KeepState = Keep [Posn] | Drop Int Bool [Posn]
-
--- | Return just the list of lines that the real cpp would decide to keep.
-cpp :: Posn -> SymTab HashDefine -> [String] -> BoolOptions -> KeepState
-       -> [String] -> IO [(Posn,String)]
-
-cpp _ _ _ _ (Keep ps) [] | not (null ps) = do
-    hPutStrLn stderr $ "Unmatched #if: positions of open context are:\n"++
-                       unlines (map show ps)
-    return []
-cpp _ _ _ _ _ [] = return []
-
-cpp p syms path options (Keep ps) (l@('#':x):xs) =
-    let ws = words x
-        cmd = if null ws then "" else head ws
-        line = tail ws
-        sym  = head (tail ws)
-        rest = tail (tail ws)
-        def = defineMacro options (sym++" "++ maybe "1" id (un rest))
-        un v = if null v then Nothing else Just (unwords v)
-        keepIf b = if b then Keep (p:ps) else Drop 1 False (p:ps)
-        skipn syms' retain ud xs' =
-            let n = 1 + length (filter (=='\n') l) in
-            (if macros options && retain then emitOne  (p,reslash l)
-                                         else emitMany (replicate n (p,""))) $
-            cpp (newlines n p) syms' path options ud xs'
-    in case cmd of
-        "define" -> skipn (insertST def syms) True (Keep ps) xs
-        "undef"  -> skipn (deleteST sym syms) True (Keep ps) xs
-        "ifndef" -> skipn syms False (keepIf (not (definedST sym syms))) xs
-        "ifdef"  -> skipn syms False (keepIf      (definedST sym syms)) xs
-        "if"     -> do b <- gatherDefined p syms (unwords line)
-                       skipn syms False (keepIf b) xs
-        "else"   -> skipn syms False (Drop 1 False ps) xs
-        "elif"   -> skipn syms False (Drop 1 True ps) xs
-        "endif"  | null ps ->
-                    do hPutStrLn stderr $ "Unmatched #endif at "++show p
-                       return []
-        "endif"  -> skipn syms False (Keep (tail ps)) xs
-        "pragma" -> skipn syms True  (Keep ps) xs
-        ('!':_)  -> skipn syms False (Keep ps) xs       -- \#!runhs scripts
-        "include"-> do (inc,content) <- readFirst (file syms (unwords line))
-                                                  p path
-                                                  (warnings options)
-                       cpp p syms path options (Keep ps)
-                             (("#line 1 "++show inc): linesCpp content
-                                                    ++ cppline (newline p): xs)
-        "warning"-> if warnings options then
-                      do hPutStrLn stderr (l++"\nin "++show p)
-                         skipn syms False (Keep ps) xs
-                    else skipn syms False (Keep ps) xs
-        "error"  -> error (l++"\nin "++show p)
-        "line"   | all isDigit sym
-                 -> (if locations options && hashline options then emitOne (p,l)
-                     else if locations options then emitOne (p,cpp2hask l)
-                     else id) $
-                    cpp (newpos (read sym) (un rest) p)
-                        syms path options (Keep ps) xs
-        n | all isDigit n && not (null n)
-                 -> (if locations options && hashline options then emitOne (p,l)
-                     else if locations options then emitOne (p,cpp2hask l)
-                     else id) $
-                    cpp (newpos (read n) (un (tail ws)) p)
-                        syms path options (Keep ps) xs
-          | otherwise
-                 -> do when (warnings options) $
-                           hPutStrLn stderr ("Warning: unknown directive #"++n
-                                             ++"\nin "++show p)
-                       emitOne (p,l) $
-                               cpp (newline p) syms path options (Keep ps) xs
-
-cpp p syms path options (Drop n b ps) (('#':x):xs) =
-    let ws = words x
-        cmd = if null ws then "" else head ws
-        delse    | n==1 && b = Drop 1 b ps
-                 | n==1      = Keep ps
-                 | otherwise = Drop n b ps
-        dend     | n==1      = Keep (tail ps)
-                 | otherwise = Drop (n-1) b (tail ps)
-        delif v  | n==1 && not b && v
-                             = Keep ps
-                 | otherwise = Drop n b ps
-        skipn ud xs' =
-                 let n' = 1 + length (filter (=='\n') x) in
-                 emitMany (replicate n' (p,"")) $
-                    cpp (newlines n' p) syms path options ud xs'
-    in
-    if      cmd == "ifndef" ||
-            cmd == "if"     ||
-            cmd == "ifdef" then    skipn (Drop (n+1) b (p:ps)) xs
-    else if cmd == "elif"  then do v <- gatherDefined p syms (unwords (tail ws))
-                                   skipn (delif v) xs
-    else if cmd == "else"  then    skipn  delse xs
-    else if cmd == "endif" then
-            if null ps then do hPutStrLn stderr $ "Unmatched #endif at "++show p
-                               return []
-                       else skipn  dend  xs
-    else skipn (Drop n b ps) xs
-        -- define, undef, include, error, warning, pragma, line
-
-cpp p syms path options (Keep ps) (x:xs) =
-    let p' = newline p in seq p' $
-    emitOne (p,x)  $  cpp p' syms path options (Keep ps) xs
-cpp p syms path options d@(Drop _ _ _) (_:xs) =
-    let p' = newline p in seq p' $
-    emitOne (p,"") $  cpp p' syms path options d xs
-
-
--- | Auxiliary IO functions
-emitOne  ::  a  -> IO [a] -> IO [a]
-emitMany :: [a] -> IO [a] -> IO [a]
-emitOne  x  io = do ys <- unsafeInterleaveIO io
-                    return (x:ys)
-emitMany xs io = do ys <- unsafeInterleaveIO io
-                    return (xs++ys)
-
-
-----
-gatherDefined :: Posn -> SymTab HashDefine -> String -> IO Bool
-gatherDefined p st inp =
-  case runParser (preExpand st) inp of
-    (Left msg, _) -> error ("Cannot expand #if directive in file "++show p
-                           ++":\n    "++msg)
-    (Right s, xs) -> do
---      hPutStrLn stderr $ "Expanded #if at "++show p++" is:\n  "++s
-        when (any (not . isSpace) xs) $
-             hPutStrLn stderr ("Warning: trailing characters after #if"
-                              ++" macro expansion in file "++show p++": "++xs)
-
-        case runParser parseBoolExp s of
-          (Left msg, _) -> error ("Cannot parse #if directive in file "++show p
-                                 ++":\n    "++msg)
-          (Right b, xs) -> do when (any (not . isSpace) xs && notComment xs) $
-                                   hPutStrLn stderr
-                                     ("Warning: trailing characters after #if"
-                                      ++" directive in file "++show p++": "++xs)
-                              return b
-
-notComment = not . ("//"`isPrefixOf`) . dropWhile isSpace
-
-
--- | The preprocessor must expand all macros (recursively) before evaluating
---   the conditional.
-preExpand :: SymTab HashDefine -> TextParser String
-preExpand st =
-  do  eof
-      return ""
-  <|>
-  do  a <- many1 (satisfy notIdent)
-      commit $ pure (a++) `apply` preExpand st
-  <|>
-  do  b <- expandSymOrCall st
-      commit $ pure (b++) `apply` preExpand st
-
--- | Expansion of symbols.
-expandSymOrCall :: SymTab HashDefine -> TextParser String
-expandSymOrCall st =
-  do sym <- parseSym
-     if sym=="defined" then do arg <- skip parseSym; convert sym [arg]
-                            <|>
-                            do arg <- skip $ parenthesis (do x <- skip parseSym;
-                                                             skip (return x))
-                               convert sym [arg]
-                            <|> convert sym []
-      else
-      ( do  args <- parenthesis (commit $ fragment `sepBy` skip (isWord ","))
-            args' <- flip mapM args $ \arg->
-                         case runParser (preExpand st) arg of
-                             (Left msg, _) -> fail msg
-                             (Right s, _)  -> return s
-            convert sym args'
-        <|> convert sym []
-      )
-  where
-    fragment = many1 (satisfy (`notElem`",)"))
-    convert "defined" [arg] =
-      case lookupST arg st of
-        Nothing | all isDigit arg    -> return arg 
-        Nothing                      -> return "0"
-        Just (a@AntiDefined{})       -> return "0"
-        Just (a@SymbolReplacement{}) -> return "1"
-        Just (a@MacroExpansion{})    -> return "1"
-    convert sym args =
-      case lookupST sym st of
-        Nothing  -> if null args then return sym
-                    else return "0"
-                 -- else fail (disp sym args++" is not a defined macro")
-        Just (a@SymbolReplacement{}) -> do reparse (replacement a)
-                                           return ""
-        Just (a@MacroExpansion{})    -> do reparse (expandMacro a args False)
-                                           return ""
-        Just (a@AntiDefined{})       ->
-                    if null args then return sym
-                    else return "0"
-                 -- else fail (disp sym args++" explicitly undefined with -U")
-    disp sym args = let len = length args
-                        chars = map (:[]) ['a'..'z']
-                    in sym ++ if null args then ""
-                              else "("++intercalate "," (take len chars)++")"
-
-parseBoolExp :: TextParser Bool
-parseBoolExp =
-  do  a <- parseExp1
-      bs <- many (do skip (isWord "||")
-                     commit $ skip parseBoolExp)
-      return $ foldr (||) a bs
-
-parseExp1 :: TextParser Bool
-parseExp1 =
-  do  a <- parseExp0
-      bs <- many (do skip (isWord "&&")
-                     commit $ skip parseExp1)
-      return $ foldr (&&) a bs
-
-parseExp0 :: TextParser Bool
-parseExp0 =
-  do  skip (isWord "!")
-      a <- commit $ parseExp0
-      return (not a)
-  <|>
-  do  val1 <- parseArithExp1
-      op   <- parseCmpOp
-      val2 <- parseArithExp1
-      return (val1 `op` val2)
-  <|>
-  do  sym <- parseArithExp1
-      case sym of
-        0 -> return False
-        _ -> return True
-  <|>
-  do  parenthesis (commit parseBoolExp)
-
-parseArithExp1 :: TextParser Integer
-parseArithExp1 =
-  do  val1 <- parseArithExp0
-      ( do op   <- parseArithOp1
-           val2 <- parseArithExp1
-           return (val1 `op` val2)
-        <|> return val1 )
-  <|>
-  do  parenthesis parseArithExp1
-
-parseArithExp0 :: TextParser Integer
-parseArithExp0 =
-  do  val1 <- parseNumber
-      ( do op   <- parseArithOp0
-           val2 <- parseArithExp0
-           return (val1 `op` val2)
-        <|> return val1 )
-  <|>
-  do  parenthesis parseArithExp0
-
-parseNumber :: TextParser Integer
-parseNumber = fmap safeRead $ skip parseSym
-  where
-    safeRead s =
-      case s of
-        '0':'x':s' -> number readHex s'
-        '0':'o':s' -> number readOct s'
-        _          -> number readDec s
-    number rd s =
-      case rd s of
-        []        -> 0 :: Integer
-        ((n,_):_) -> n :: Integer
-
-parseCmpOp :: TextParser (Integer -> Integer -> Bool)
-parseCmpOp =
-  do  skip (isWord ">=")
-      return (>=)
-  <|>
-  do  skip (isWord ">")
-      return (>)
-  <|>
-  do  skip (isWord "<=")
-      return (<=)
-  <|>
-  do  skip (isWord "<")
-      return (<)
-  <|>
-  do  skip (isWord "==")
-      return (==)
-  <|>
-  do  skip (isWord "!=")
-      return (/=)
-
-parseArithOp1 :: TextParser (Integer -> Integer -> Integer)
-parseArithOp1 =
-  do  skip (isWord "+")
-      return (+)
-  <|>
-  do  skip (isWord "-")
-      return (-)
-
-parseArithOp0 :: TextParser (Integer -> Integer -> Integer)
-parseArithOp0 =
-  do  skip (isWord "*")
-      return (*)
-  <|>
-  do  skip (isWord "/")
-      return (div)
-  <|>
-  do  skip (isWord "%")
-      return (rem)
-
--- | Return the expansion of the symbol (if there is one).
-parseSymOrCall :: SymTab HashDefine -> TextParser String
-parseSymOrCall st =
-  do  sym <- skip parseSym
-      args <- parenthesis (commit $ parseSymOrCall st `sepBy` skip (isWord ","))
-      return $ convert sym args
-  <|>
-  do  sym <- skip parseSym
-      return $ convert sym []
-  where
-    convert sym args =
-      case lookupST sym st of
-        Nothing  -> sym
-        Just (a@SymbolReplacement{}) -> recursivelyExpand st (replacement a)
-        Just (a@MacroExpansion{})    -> recursivelyExpand st (expandMacro a args False)
-        Just (a@AntiDefined{})       -> name a
-
-recursivelyExpand :: SymTab HashDefine -> String -> String
-recursivelyExpand st inp =
-  case runParser (parseSymOrCall st) inp of
-    (Left msg, _) -> inp
-    (Right s,  _) -> s
-
-parseSym :: TextParser String
-parseSym = many1 (satisfy (\c-> isAlphaNum c || c`elem`"'`_"))
-           `onFail`
-           do xs <- allAsString
-              fail $ "Expected an identifier, got \""++xs++"\""
-
-notIdent :: Char -> Bool
-notIdent c = not (isAlphaNum c || c`elem`"'`_")
-
-skip :: TextParser a -> TextParser a
-skip p = many (satisfy isSpace) >> p
-
--- | The standard "parens" parser does not work for us here.  Define our own.
-parenthesis :: TextParser a -> TextParser a
-parenthesis p = do isWord "("
-                   x <- p
-                   isWord ")"
-                   return x
-
--- | Determine filename in \#include
-file :: SymTab HashDefine -> String -> String
-file st name =
-    case name of
-      ('"':ns) -> init ns
-      ('<':ns) -> init ns
-      _ -> let ex = recursivelyExpand st name in
-           if ex == name then name else file st ex
-
− examples/CppHs/Language/Preprocessor/Cpphs/HashDefine.hs 
@@ -1,129 +0,0 @@------------------------------------------------------------------------------
--- |
--- Module      :  HashDefine
--- Copyright   :  2004 Malcolm Wallace
--- Licence     :  LGPL
---
--- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
--- Stability   :  experimental
--- Portability :  All
---
--- What structures are declared in a \#define.
------------------------------------------------------------------------------
- 
-module Language.Preprocessor.Cpphs.HashDefine
-  ( HashDefine(..)
-  , ArgOrText(..)
-  , expandMacro
-  , parseHashDefine
-  , simplifyHashDefines
-  ) where
-
-import Data.Char (isSpace)
-import Data.List (intercalate)
-
-data HashDefine
-        = LineDrop
-                { name :: String }
-        | Pragma
-                { name :: String }
-        | AntiDefined
-                { name          :: String
-                , linebreaks    :: Int
-                }
-        | SymbolReplacement
-                { name          :: String
-                , replacement   :: String
-                , linebreaks    :: Int
-                }
-        | MacroExpansion
-                { name          :: String
-                , arguments     :: [String]
-                , expansion     :: [(ArgOrText,String)]
-                , linebreaks    :: Int
-                }
-    deriving (Eq,Show)
-
--- | 'smart' constructor to avoid warnings from ghc (undefined fields)
-symbolReplacement :: HashDefine
-symbolReplacement =
-    SymbolReplacement
-         { name=undefined, replacement=undefined, linebreaks=undefined }
-
--- | Macro expansion text is divided into sections, each of which is classified
---   as one of three kinds: a formal argument (Arg), plain text (Text),
---   or a stringised formal argument (Str).
-data ArgOrText = Arg | Text | Str deriving (Eq,Show)
-
--- | Expand an instance of a macro.
---   Precondition: got a match on the macro name.
-expandMacro :: HashDefine -> [String] -> Bool -> String
-expandMacro macro parameters layout =
-    let env = zip (arguments macro) parameters
-        replace (Arg,s)  = maybe ("")      id (lookup s env)
-        replace (Str,s)  = maybe (str "") str (lookup s env)
-        replace (Text,s) = if layout then s else filter (/='\n') s
-        str s = '"':s++"\""
-        checkArity | length (arguments macro) == 1 && length parameters <= 1
-                   || length (arguments macro) == length parameters = id
-                   | otherwise = error ("macro "++name macro++" expected "++
-                                        show (length (arguments macro))++
-                                        " arguments, but was given "++
-                                        show (length parameters))
-    in
-    checkArity $ concatMap replace (expansion macro)
-
--- | Parse a \#define, or \#undef, ignoring other \# directives
-parseHashDefine :: Bool -> [String] -> Maybe HashDefine
-parseHashDefine ansi def = (command . skip) def
-  where
-    skip xss@(x:xs) | all isSpace x = skip xs
-                    | otherwise     = xss
-    skip    []      = []
-    command ("line":xs)   = Just (LineDrop ("#line"++concat xs))
-    command ("pragma":xs) = Just (Pragma ("#pragma"++concat xs))
-    command ("define":xs) = Just (((define . skip) xs) { linebreaks=count def })
-    command ("undef":xs)  = Just (((undef  . skip) xs))
-    command _             = Nothing
-    undef  (sym:_)   = AntiDefined { name=sym, linebreaks=0 }
-    define (sym:xs)  = case {-skip-} xs of
-                           ("(":ys) -> (macroHead sym [] . skip) ys
-                           ys   -> symbolReplacement
-                                     { name=sym
-                                     , replacement = concatMap snd
-                                             (classifyRhs [] (chop (skip ys))) }
-    macroHead sym args (",":xs) = (macroHead sym args . skip) xs
-    macroHead sym args (")":xs) = MacroExpansion
-                                    { name =sym , arguments = reverse args
-                                    , expansion = classifyRhs args (skip xs)
-                                    , linebreaks = undefined }
-    macroHead sym args (var:xs) = (macroHead sym (var:args) . skip) xs
-    macroHead sym args []       = error ("incomplete macro definition:\n"
-                                        ++"  #define "++sym++"("
-                                        ++intercalate "," args)
-    classifyRhs args ("#":x:xs)
-                          | ansi &&
-                            x `elem` args    = (Str,x): classifyRhs args xs
-    classifyRhs args ("##":xs)
-                          | ansi             = classifyRhs args xs
-    classifyRhs args (s:"##":s':xs)
-                          | ansi && all isSpace s && all isSpace s'
-                                             = classifyRhs args xs
-    classifyRhs args (word:xs)
-                          | word `elem` args = (Arg,word): classifyRhs args xs
-                          | otherwise        = (Text,word): classifyRhs args xs
-    classifyRhs _    []                      = []
-    count = length . filter (=='\n') . concat
-    chop  = reverse . dropWhile (all isSpace) . reverse
-
--- | Pretty-print hash defines to a simpler format, as key-value pairs.
-simplifyHashDefines :: [HashDefine] -> [(String,String)]
-simplifyHashDefines = concatMap simp
-  where
-    simp hd@LineDrop{}    = []
-    simp hd@Pragma{}      = []
-    simp hd@AntiDefined{} = []
-    simp hd@SymbolReplacement{} = [(name hd, replacement hd)]
-    simp hd@MacroExpansion{}    = [(name hd++"("++intercalate "," (arguments hd)
-                                           ++")"
-                                   ,concatMap snd (expansion hd))]
− examples/CppHs/Language/Preprocessor/Cpphs/MacroPass.hs 
@@ -1,184 +0,0 @@------------------------------------------------------------------------------
--- |
--- Module      :  MacroPass
--- Copyright   :  2004 Malcolm Wallace
--- Licence     :  LGPL
---
--- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
--- Stability   :  experimental
--- Portability :  All
---
--- Perform a cpp.second-pass, accumulating \#define's and \#undef's,
--- whilst doing symbol replacement and macro expansion.
------------------------------------------------------------------------------
-
-module Language.Preprocessor.Cpphs.MacroPass
-  ( macroPass
-  , preDefine
-  , defineMacro
-  , macroPassReturningSymTab
-  ) where
-
-import Language.Preprocessor.Cpphs.HashDefine (HashDefine(..), expandMacro
-                                              , simplifyHashDefines)
-import Language.Preprocessor.Cpphs.Tokenise   (tokenise, WordStyle(..)
-                                              , parseMacroCall)
-import Language.Preprocessor.Cpphs.SymTab     (SymTab, lookupST, insertST
-                                              , emptyST, flattenST)
-import Language.Preprocessor.Cpphs.Position   (Posn, newfile, filename, lineno)
-import Language.Preprocessor.Cpphs.Options    (BoolOptions(..))
-import System.IO.Unsafe (unsafeInterleaveIO)
-import Control.Monad    ((=<<))
-import System.Time       (getClockTime, toCalendarTime, formatCalendarTime)
-import System.Locale     (defaultTimeLocale)
-
-noPos :: Posn
-noPos = newfile "preDefined"
-
--- | Walk through the document, replacing calls of macros with the expanded RHS.
-macroPass :: [(String,String)]  -- ^ Pre-defined symbols and their values
-          -> BoolOptions        -- ^ Options that alter processing style
-          -> [(Posn,String)]    -- ^ The input file content
-          -> IO String          -- ^ The file after processing
-macroPass syms options =
-    fmap (safetail              -- to remove extra "\n" inserted below
-         . concat
-         . onlyRights)
-    . macroProcess (pragma options) (layout options) (lang options)
-                   (preDefine options syms)
-    . tokenise (stripEol options) (stripC89 options)
-               (ansi options) (lang options)
-    . ((noPos,""):)     -- ensure recognition of "\n#" at start of file
-  where
-    safetail [] = []
-    safetail (_:xs) = xs
-
--- | auxiliary
-onlyRights :: [Either a b] -> [b]
-onlyRights = concatMap (\x->case x of Right t-> [t]; Left _-> [];)
-
--- | Walk through the document, replacing calls of macros with the expanded RHS.
---   Additionally returns the active symbol table after processing.
-macroPassReturningSymTab
-          :: [(String,String)]  -- ^ Pre-defined symbols and their values
-          -> BoolOptions        -- ^ Options that alter processing style
-          -> [(Posn,String)]    -- ^ The input file content
-          -> IO (String,[(String,String)])
-                                -- ^ The file and symbol table after processing
-macroPassReturningSymTab syms options =
-    fmap (mapFst (safetail              -- to remove extra "\n" inserted below
-                 . concat)
-         . walk)
-    . macroProcess (pragma options) (layout options) (lang options)
-                   (preDefine options syms)
-    . tokenise (stripEol options) (stripC89 options)
-               (ansi options) (lang options)
-    . ((noPos,""):)     -- ensure recognition of "\n#" at start of file
-  where
-    safetail [] = []
-    safetail (_:xs) = xs
-    walk (Right x: rest) = let (xs,   foo) = walk rest
-                           in  (x:xs, foo)
-    walk (Left  x: [])   =     ( [] , simplifyHashDefines (flattenST x) )
-    walk (Left  x: rest) = walk rest
-    mapFst f (a,b) = (f a, b)
-
-
--- | Turn command-line definitions (from @-D@) into 'HashDefine's.
-preDefine :: BoolOptions -> [(String,String)] -> SymTab HashDefine
-preDefine options defines =
-    foldr (insertST . defineMacro options . (\ (s,d)-> s++" "++d))
-          emptyST defines
-
--- | Turn a string representing a macro definition into a 'HashDefine'.
-defineMacro :: BoolOptions -> String -> (String,HashDefine)
-defineMacro opts s =
-    let (Cmd (Just hd):_) = tokenise True True (ansi opts) (lang opts)
-                                     [(noPos,"\n#define "++s++"\n")]
-    in (name hd, hd)
-
-
--- | Trundle through the document, one word at a time, using the WordStyle
---   classification introduced by 'tokenise' to decide whether to expand a
---   word or macro.  Encountering a \#define or \#undef causes that symbol to
---   be overwritten in the symbol table.  Any other remaining cpp directives
---   are discarded and replaced with blanks, except for \#line markers.
---   All valid identifiers are checked for the presence of a definition
---   of that name in the symbol table, and if so, expanded appropriately.
---   (Bool arguments are: keep pragmas?  retain layout?  haskell language?)
---   The result lazily intersperses output text with symbol tables.  Lines
---   are emitted as they are encountered.  A symbol table is emitted after
---   each change to the defined symbols, and always at the end of processing.
-macroProcess :: Bool -> Bool -> Bool -> SymTab HashDefine -> [WordStyle]
-             -> IO [Either (SymTab HashDefine) String]
-macroProcess _ _ _ st        []          = return [Left st]
-macroProcess p y l st (Other x: ws)      = emit x    $ macroProcess p y l st ws
-macroProcess p y l st (Cmd Nothing: ws)  = emit "\n" $ macroProcess p y l st ws
-macroProcess p y l st (Cmd (Just (LineDrop x)): ws)
-                                         = emit "\n" $
-                                           emit x    $ macroProcess p y l st ws
-macroProcess pragma y l st (Cmd (Just (Pragma x)): ws)
-               | pragma    = emit "\n" $ emit x $ macroProcess pragma y l st ws
-               | otherwise = emit "\n" $          macroProcess pragma y l st ws
-macroProcess p layout lang st (Cmd (Just hd): ws) =
-    let n = 1 + linebreaks hd
-        newST = insertST (name hd, hd) st
-    in
-    emit (replicate n '\n') $
-    emitSymTab newST $
-    macroProcess p layout lang newST ws
-macroProcess pr layout lang st (Ident p x: ws) =
-    case x of
-      "__FILE__" -> emit (show (filename p))$ macroProcess pr layout lang st ws
-      "__LINE__" -> emit (show (lineno p))  $ macroProcess pr layout lang st ws
-      "__DATE__" -> do w <- return .
-                            formatCalendarTime defaultTimeLocale "\"%d %b %Y\""
-                            =<< toCalendarTime =<< getClockTime
-                       emit w $ macroProcess pr layout lang st ws
-      "__TIME__" -> do w <- return .
-                            formatCalendarTime defaultTimeLocale "\"%H:%M:%S\""
-                            =<< toCalendarTime =<< getClockTime
-                       emit w $ macroProcess pr layout lang st ws
-      _ ->
-        case lookupST x st of
-            Nothing -> emit x $ macroProcess pr layout lang st ws
-            Just hd ->
-                case hd of
-                    AntiDefined {name=n} -> emit n $
-                                            macroProcess pr layout lang st ws
-                    SymbolReplacement {replacement=r} ->
-                        let r' = if layout then r else filter (/='\n') r in
-                        -- one-level expansion only:
-                        -- emit r' $ macroProcess layout st ws
-                        -- multi-level expansion:
-                        macroProcess pr layout lang st
-                                     (tokenise True True False lang [(p,r')]
-                                      ++ ws)
-                    MacroExpansion {} ->
-                        case parseMacroCall p ws of
-                            Nothing -> emit x $
-                                       macroProcess pr layout lang st ws
-                            Just (args,ws') ->
-                                if length args /= length (arguments hd) then
-                                     emit x $ macroProcess pr layout lang st ws
-                                else do args' <- mapM (fmap (concat.onlyRights)
-                                                       . macroProcess pr layout
-                                                                        lang st)
-                                                      args
-                                        -- one-level expansion only:
-                                        -- emit (expandMacro hd args' layout) $
-                                        --         macroProcess layout st ws'
-                                        -- multi-level expansion:
-                                        macroProcess pr layout lang st
-                                            (tokenise True True False lang
-                                               [(p,expandMacro hd args' layout)]
-                                            ++ ws')
-
--- | Useful helper function.
-emit :: a -> IO [Either b a] -> IO [Either b a]
-emit x io = do xs <- unsafeInterleaveIO io
-               return (Right x:xs)
--- | Useful helper function.
-emitSymTab :: b -> IO [Either b a] -> IO [Either b a]
-emitSymTab x io = do xs <- unsafeInterleaveIO io
-                     return (Left x:xs)
− examples/CppHs/Language/Preprocessor/Cpphs/Options.hs 
@@ -1,156 +0,0 @@------------------------------------------------------------------------------
--- |
--- Module      :  Options
--- Copyright   :  2006 Malcolm Wallace
--- Licence     :  LGPL
---
--- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
--- Stability   :  experimental
--- Portability :  All
---
--- This module deals with Cpphs options and parsing them
------------------------------------------------------------------------------
-
-module Language.Preprocessor.Cpphs.Options
-  ( CpphsOptions(..)
-  , BoolOptions(..)
-  , parseOptions
-  , defaultCpphsOptions
-  , defaultBoolOptions
-  , trailing
-  ) where
-
-import Data.Maybe
-import Data.List (isPrefixOf)
-
--- | Cpphs options structure.
-data CpphsOptions = CpphsOptions 
-    { infiles   :: [FilePath]
-    , outfiles  :: [FilePath]
-    , defines   :: [(String,String)]
-    , includes  :: [String]
-    , preInclude:: [FilePath]   -- ^ Files to \#include before anything else
-    , boolopts  :: BoolOptions
-    } deriving (Show)
-
--- | Default options.
-defaultCpphsOptions :: CpphsOptions
-defaultCpphsOptions = CpphsOptions { infiles = [], outfiles = []
-                                   , defines = [], includes = []
-                                   , preInclude = []
-                                   , boolopts = defaultBoolOptions }
-
--- | Options representable as Booleans.
-data BoolOptions = BoolOptions
-    { macros    :: Bool  -- ^ Leave \#define and \#undef in output of ifdef?
-    , locations :: Bool  -- ^ Place \#line droppings in output?
-    , hashline  :: Bool  -- ^ Write \#line or {-\# LINE \#-} ?
-    , pragma    :: Bool  -- ^ Keep \#pragma in final output?
-    , stripEol  :: Bool  -- ^ Remove C eol (\/\/) comments everywhere?
-    , stripC89  :: Bool  -- ^ Remove C inline (\/**\/) comments everywhere?
-    , lang      :: Bool  -- ^ Lex input as Haskell code?
-    , ansi      :: Bool  -- ^ Permit stringise \# and catenate \#\# operators?
-    , layout    :: Bool  -- ^ Retain newlines in macro expansions?
-    , literate  :: Bool  -- ^ Remove literate markup?
-    , warnings  :: Bool  -- ^ Issue warnings?
-    } deriving (Show)
-
--- | Default settings of boolean options.
-defaultBoolOptions :: BoolOptions
-defaultBoolOptions = BoolOptions { macros   = True,   locations = True
-                                 , hashline = True,   pragma    = False
-                                 , stripEol = False,  stripC89  = False
-                                 , lang     = True,   ansi      = False
-                                 , layout   = False,  literate  = False
-                                 , warnings = True }
-
--- | Raw command-line options.  This is an internal intermediate data
---   structure, used during option parsing only.
-data RawOption
-    = NoMacro
-    | NoLine
-    | LinePragma
-    | Pragma
-    | Text
-    | Strip
-    | StripEol
-    | Ansi
-    | Layout
-    | Unlit
-    | SuppressWarnings
-    | Macro (String,String)
-    | Path String
-    | PreInclude FilePath
-    | IgnoredForCompatibility
-      deriving (Eq, Show)
-
-flags :: [(String, RawOption)]
-flags = [ ("--nomacro", NoMacro)
-        , ("--noline",  NoLine)
-        , ("--linepragma", LinePragma)
-        , ("--pragma",  Pragma)
-        , ("--text",    Text)
-        , ("--strip",   Strip)
-        , ("--strip-eol",  StripEol)
-        , ("--hashes",  Ansi)
-        , ("--layout",  Layout)
-        , ("--unlit",   Unlit)
-        , ("--nowarn",  SuppressWarnings)
-        ]
-
--- | Parse a single raw command-line option.  Parse failure is indicated by
---   result Nothing.
-rawOption :: String -> Maybe RawOption
-rawOption x | isJust a = a
-    where a = lookup x flags
-rawOption ('-':'D':xs) = Just $ Macro (s, if null d then "1" else tail d)
-    where (s,d) = break (=='=') xs
-rawOption ('-':'U':xs) = Just $ IgnoredForCompatibility
-rawOption ('-':'I':xs) = Just $ Path $ trailing "/\\" xs
-rawOption xs | "--include="`isPrefixOf`xs
-            = Just $ PreInclude (drop 10 xs)
-rawOption _ = Nothing
-
--- | Trim trailing elements of the second list that match any from
---   the first list.  Typically used to remove trailing forward\/back
---   slashes from a directory path.
-trailing :: (Eq a) => [a] -> [a] -> [a]
-trailing xs = reverse . dropWhile (`elem`xs) . reverse
-
--- | Convert a list of RawOption to a BoolOptions structure.
-boolOpts :: [RawOption] -> BoolOptions
-boolOpts opts =
-  BoolOptions
-    { macros    = not (NoMacro `elem` opts)
-    , locations = not (NoLine  `elem` opts)
-    , hashline  = not (LinePragma `elem` opts)
-    , pragma    =      Pragma  `elem` opts
-    , stripEol  =      StripEol`elem` opts
-    , stripC89  =      StripEol`elem` opts || Strip `elem` opts
-    , lang      = not (Text    `elem` opts)
-    , ansi      =      Ansi    `elem` opts
-    , layout    =      Layout  `elem` opts
-    , literate  =      Unlit   `elem` opts
-    , warnings  = not (SuppressWarnings `elem` opts)
-    }
-
--- | Parse all command-line options.
-parseOptions :: [String] -> Either String CpphsOptions
-parseOptions xs = f ([], [], []) xs
-  where
-    f (opts, ins, outs) (('-':'O':x):xs) = f (opts, ins, x:outs) xs
-    f (opts, ins, outs) (x@('-':_):xs) = case rawOption x of
-                                           Nothing -> Left x
-                                           Just a  -> f (a:opts, ins, outs) xs
-    f (opts, ins, outs) (x:xs) = f (opts, normalise x:ins, outs) xs
-    f (opts, ins, outs) []     =
-        Right CpphsOptions { infiles  = reverse ins
-                           , outfiles = reverse outs
-                           , defines  = [ x | Macro x <- reverse opts ]
-                           , includes = [ x | Path x  <- reverse opts ]
-                           , preInclude=[ x | PreInclude x <- reverse opts ]
-                           , boolopts = boolOpts opts
-                           }
-    normalise ('/':'/':filepath) = normalise ('/':filepath)
-    normalise (x:filepath)       = x:normalise filepath
-    normalise []                 = []
− examples/CppHs/Language/Preprocessor/Cpphs/Position.hs 
@@ -1,106 +0,0 @@------------------------------------------------------------------------------
--- |
--- Module      :  Position
--- Copyright   :  2000-2004 Malcolm Wallace
--- Licence     :  LGPL
---
--- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
--- Stability   :  experimental
--- Portability :  All
---
--- Simple file position information, with recursive inclusion points.
------------------------------------------------------------------------------
-
-module Language.Preprocessor.Cpphs.Position
-  ( Posn(..)
-  , newfile
-  , addcol, newline, tab, newlines, newpos
-  , cppline, haskline, cpp2hask
-  , filename, lineno, directory
-  , cleanPath
-  ) where
-
-import Data.List (isPrefixOf)
-
--- | Source positions contain a filename, line, column, and an
---   inclusion point, which is itself another source position,
---   recursively.
-data Posn = Pn String !Int !Int (Maybe Posn)
-        deriving (Eq)
-
-instance Show Posn where
-      showsPrec _ (Pn f l c i) = showString f .
-                                 showString "  at line " . shows l .
-                                 showString " col " . shows c .
-                                 ( case i of
-                                    Nothing -> id
-                                    Just p  -> showString "\n    used by  " .
-                                               shows p )
-
--- | Constructor.  Argument is filename.
-newfile :: String -> Posn
-newfile name = Pn (cleanPath name) 1 1 Nothing
-
--- | Increment column number by given quantity.
-addcol :: Int -> Posn -> Posn
-addcol n (Pn f r c i) = Pn f r (c+n) i
-
--- | Increment row number, reset column to 1.
-newline :: Posn -> Posn
---newline (Pn f r _ i) = Pn f (r+1) 1 i
-newline (Pn f r _ i) = let r' = r+1 in r' `seq` Pn f r' 1 i
-
--- | Increment column number, tab stops are every 8 chars.
-tab     :: Posn -> Posn
-tab     (Pn f r c i) = Pn f r (((c`div`8)+1)*8) i
-
--- | Increment row number by given quantity.
-newlines :: Int -> Posn -> Posn
-newlines n (Pn f r _ i) = Pn f (r+n) 1 i
-
--- | Update position with a new row, and possible filename.
-newpos :: Int -> Maybe String -> Posn -> Posn
-newpos r Nothing  (Pn f _ c i) = Pn f r c i
-newpos r (Just ('"':f)) (Pn _ _ c i) = Pn (init f) r c i
-newpos r (Just f)       (Pn _ _ c i) = Pn f r c i
-
--- | Project the line number.
-lineno    :: Posn -> Int
--- | Project the filename.
-filename  :: Posn -> String
--- | Project the directory of the filename.
-directory :: Posn -> FilePath
-
-lineno    (Pn _ r _ _) = r
-filename  (Pn f _ _ _) = f
-directory (Pn f _ _ _) = dirname f
-
-
--- | cpp-style printing of file position
-cppline :: Posn -> String
-cppline (Pn f r _ _) = "#line "++show r++" "++show f
-
--- | haskell-style printing of file position
-haskline :: Posn -> String
-haskline (Pn f r _ _) = "{-# LINE "++show r++" "++show f++" #-}"
-
--- | Conversion from a cpp-style "#line" to haskell-style pragma.
-cpp2hask :: String -> String
-cpp2hask line | "#line" `isPrefixOf` line = "{-# LINE "
-                                            ++unwords (tail (words line))
-                                            ++" #-}"
-              | otherwise = line
-
--- | Strip non-directory suffix from file name (analogous to the shell
---   command of the same name).
-dirname :: String -> String
-dirname  = reverse . safetail . dropWhile (not.(`elem`"\\/")) . reverse
-  where safetail [] = []
-        safetail (_:x) = x
-
--- | Sigh.  Mixing Windows filepaths with unix is bad.  Make sure there is a
---   canonical path separator.
-cleanPath :: FilePath -> FilePath
-cleanPath [] = []
-cleanPath ('\\':cs) = '/': cleanPath cs
-cleanPath (c:cs)    = c:   cleanPath cs
− examples/CppHs/Language/Preprocessor/Cpphs/ReadFirst.hs 
@@ -1,55 +0,0 @@------------------------------------------------------------------------------
--- |
--- Module      :  ReadFirst
--- Copyright   :  2004 Malcolm Wallace
--- Licence     :  LGPL
--- 
--- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
--- Stability   :  experimental
--- Portability :  All
---
--- Read the first file that matches in a list of search paths.
------------------------------------------------------------------------------
-
-module Language.Preprocessor.Cpphs.ReadFirst
-  ( readFirst
-  ) where
-
-import System.IO        (hPutStrLn, stderr)
-import System.Directory (doesFileExist)
-import Data.List      (intersperse)
-import Control.Monad     (when)
-import Language.Preprocessor.Cpphs.Position  (Posn,directory,cleanPath)
-
--- | Attempt to read the given file from any location within the search path.
---   The first location found is returned, together with the file content.
---   (The directory of the calling file is always searched first, then
---    the current directory, finally any specified search path.)
-readFirst :: String             -- ^ filename
-        -> Posn                 -- ^ inclusion point
-        -> [String]             -- ^ search path
-        -> Bool                 -- ^ report warnings?
-        -> IO ( FilePath
-              , String
-              )                 -- ^ discovered filepath, and file contents
-
-readFirst name demand path warn =
-    case name of
-       '/':nm -> try nm   [""]
-       _      -> try name (cons dd (".":path))
-  where
-    dd = directory demand
-    cons x xs = if null x then xs else x:xs
-    try name [] = do
-        when warn $
-          hPutStrLn stderr ("Warning: Can't find file \""++name
-                           ++"\" in directories\n\t"
-                           ++concat (intersperse "\n\t" (cons dd (".":path)))
-                           ++"\n  Asked for by: "++show demand)
-        return ("missing file: "++name,"")
-    try name (p:ps) = do
-        let file = cleanPath p++'/':cleanPath name
-        ok <- doesFileExist file
-        if not ok then try name ps
-          else do content <- readFile file
-                  return (file,content)
− examples/CppHs/Language/Preprocessor/Cpphs/RunCpphs.hs 
@@ -1,82 +0,0 @@-{-
--- The main program for cpphs, a simple C pre-processor written in Haskell.
-
--- Copyright (c) 2004 Malcolm Wallace
--- This file is LGPL (relicensed from the GPL by Malcolm Wallace, October 2011).
--}
-module Language.Preprocessor.Cpphs.RunCpphs ( runCpphs
-                                            , runCpphsPass1
-                                            , runCpphsPass2
-                                            , runCpphsReturningSymTab
-                                            ) where
-
-import Language.Preprocessor.Cpphs.CppIfdef (cppIfdef)
-import Language.Preprocessor.Cpphs.MacroPass(macroPass,macroPassReturningSymTab)
-import Language.Preprocessor.Cpphs.Options  (CpphsOptions(..), BoolOptions(..)
-                                            ,trailing)
-import Language.Preprocessor.Cpphs.Tokenise (deWordStyle, tokenise)
-import Language.Preprocessor.Cpphs.Position (cleanPath, Posn)
-import Language.Preprocessor.Unlit as Unlit (unlit)
-
-
-runCpphs :: CpphsOptions -> FilePath -> String -> IO String
-runCpphs options filename input = do
-  pass1 <- runCpphsPass1 options filename input
-  runCpphsPass2 (boolopts options) (defines options) filename pass1
-
-runCpphsPass1 :: CpphsOptions -> FilePath -> String -> IO [(Posn,String)]
-runCpphsPass1 options' filename input = do
-  let options= options'{ includes= map (trailing "\\/") (includes options') }
-  let bools  = boolopts options
-      preInc = case preInclude options of
-                 [] -> ""
-                 is -> concatMap (\f->"#include \""++f++"\"\n") is 
-                       ++ "#line 1 \""++cleanPath filename++"\"\n"
-
-  pass1 <- cppIfdef filename (defines options) (includes options) bools
-                    (preInc++input)
-  return pass1
-
-runCpphsPass2 :: BoolOptions -> [(String,String)] -> FilePath -> [(Posn,String)] -> IO String
-runCpphsPass2 bools defines filename pass1 = do
-  pass2 <- macroPass defines bools pass1
-  let result= if not (macros bools)
-              then if   stripC89 bools || stripEol bools
-                   then concatMap deWordStyle $
-                        tokenise (stripEol bools) (stripC89 bools)
-                                 (ansi bools) (lang bools) pass1
-                   else unlines (map snd pass1)
-              else pass2
-      pass3 = if literate bools then Unlit.unlit filename else id
-  return (pass3 result)
-
-runCpphsReturningSymTab :: CpphsOptions -> FilePath -> String
-             -> IO (String,[(String,String)])
-runCpphsReturningSymTab options' filename input = do
-  let options= options'{ includes= map (trailing "\\/") (includes options') }
-  let bools  = boolopts options
-      preInc = case preInclude options of
-                 [] -> ""
-                 is -> concatMap (\f->"#include \""++f++"\"\n") is 
-                       ++ "#line 1 \""++cleanPath filename++"\"\n"
-  (pass2,syms) <-
-      if macros bools then do
-          pass1 <- cppIfdef filename (defines options) (includes options)
-                            bools (preInc++input)
-          macroPassReturningSymTab (defines options) bools pass1
-      else do
-          pass1 <- cppIfdef filename (defines options) (includes options)
-                            bools{macros=True} (preInc++input)
-          (_,syms) <- macroPassReturningSymTab (defines options) bools pass1
-          pass1 <- cppIfdef filename (defines options) (includes options)
-                            bools (preInc++input)
-          let result = if   stripC89 bools || stripEol bools
-                       then concatMap deWordStyle $
-                            tokenise (stripEol bools) (stripC89 bools)
-                                     (ansi bools) (lang bools) pass1
-                       else init $ unlines (map snd pass1)
-          return (result,syms)
-
-  let pass3 = if literate bools then Unlit.unlit filename else id
-  return (pass3 pass2, syms)
-
− examples/CppHs/Language/Preprocessor/Cpphs/SymTab.hs 
@@ -1,92 +0,0 @@------------------------------------------------------------------------------
--- |
--- Module      :  SymTab
--- Copyright   :  2000-2004 Malcolm Wallace
--- Licence     :  LGPL
--- 
--- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
--- Stability   :  Stable
--- Portability :  All
---
--- Symbol Table, based on index trees using a hash on the key.
---   Keys are always Strings.  Stored values can be any type.
------------------------------------------------------------------------------
-
-module Language.Preprocessor.Cpphs.SymTab
-  ( SymTab
-  , emptyST
-  , insertST
-  , deleteST
-  , lookupST
-  , definedST
-  , flattenST
-  , IndTree
-  ) where
-
--- | Symbol Table.  Stored values are polymorphic, but the keys are
---   always strings.
-type SymTab v = IndTree [(String,v)]
-
-emptyST   :: SymTab v
-insertST  :: (String,v) -> SymTab v -> SymTab v
-deleteST  :: String -> SymTab v -> SymTab v
-lookupST  :: String -> SymTab v -> Maybe v
-definedST :: String -> SymTab v -> Bool
-flattenST :: SymTab v -> [v]
-
-emptyST           = itgen maxHash []
-insertST (s,v) ss = itiap (hash s) ((s,v):)    ss id
-deleteST  s    ss = itiap (hash s) (filter ((/=s).fst)) ss id
-lookupST  s    ss = let vs = filter ((==s).fst) ((itind (hash s)) ss)
-                    in if null vs then Nothing
-                       else (Just . snd . head) vs
-definedST s    ss = let vs = filter ((==s).fst) ((itind (hash s)) ss)
-                    in (not . null) vs
-flattenST      ss = itfold (map snd) (++) ss
-
-
-----
--- | Index Trees (storing indexes at nodes).
-
-data IndTree t = Leaf t | Fork Int (IndTree t) (IndTree t)
-     deriving Show
-
-itgen :: Int -> a -> IndTree a
-itgen 1 x = Leaf x
-itgen n x =
-  let n' = n `div` 2
-  in Fork n' (itgen n' x) (itgen (n-n') x)
-
-itiap :: --Eval a =>
-         Int -> (a->a) -> IndTree a -> (IndTree a -> b) -> b
-itiap _ f (Leaf x)       k = let fx = f x in {-seq fx-} (k (Leaf fx))
-itiap i f (Fork n lt rt) k =
-  if i<n then
-       itiap i f lt $ \lt' -> k (Fork n lt' rt)
-  else itiap (i-n) f rt $ \rt' -> k (Fork n lt rt')
-
-itind :: Int -> IndTree a -> a
-itind _ (Leaf x) = x
-itind i (Fork n lt rt) = if i<n then itind i lt else itind (i-n) rt
-
-itfold :: (a->b) -> (b->b->b) -> IndTree a -> b
-itfold leaf _fork (Leaf x) = leaf x
-itfold leaf  fork (Fork _ l r) = fork (itfold leaf fork l) (itfold leaf fork r)
-
-----
--- Hash values
-
-maxHash :: Int -- should be prime
-maxHash = 101
-
-class Hashable a where
-    hashWithMax :: Int -> a -> Int
-    hash        :: a -> Int
-    hash = hashWithMax maxHash
-
-instance Enum a => Hashable [a] where
-    hashWithMax m = h 0
-        where h a []     = a
-              h a (c:cs) = h ((17*(fromEnum c)+19*a)`rem`m) cs
-
-----
− examples/CppHs/Language/Preprocessor/Cpphs/Tokenise.hs 
@@ -1,281 +0,0 @@------------------------------------------------------------------------------
--- |
--- Module      :  Tokenise
--- Copyright   :  2004 Malcolm Wallace
--- Licence     :  LGPL
---
--- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
--- Stability   :  experimental
--- Portability :  All
---
--- The purpose of this module is to lex a source file (language
--- unspecified) into tokens such that cpp can recognise a replaceable
--- symbol or macro-use, and do the right thing.
------------------------------------------------------------------------------
-
-module Language.Preprocessor.Cpphs.Tokenise
-  ( linesCpp
-  , reslash
-  , tokenise
-  , WordStyle(..)
-  , deWordStyle
-  , parseMacroCall
-  ) where
-
-import Data.Char
-import Language.Preprocessor.Cpphs.HashDefine
-import Language.Preprocessor.Cpphs.Position
-
--- | A Mode value describes whether to tokenise a la Haskell, or a la Cpp.
---   The main difference is that in Cpp mode we should recognise line
---   continuation characters.
-data Mode = Haskell | Cpp
-
--- | linesCpp is, broadly speaking, Prelude.lines, except that
---   on a line beginning with a \#, line continuation characters are
---   recognised.  In a line continuation, the newline character is
---   preserved, but the backslash is not.
-linesCpp :: String -> [String]
-linesCpp  []                 = []
-linesCpp (x:xs) | x=='#'     = tok Cpp     ['#'] xs
-                | otherwise  = tok Haskell [] (x:xs)
-  where
-    tok Cpp   acc ('\\':'\n':ys)   = tok Cpp ('\n':acc) ys
-    tok _     acc ('\n':'#':ys)    = reverse acc: tok Cpp ['#'] ys
-    tok _     acc ('\n':ys)        = reverse acc: tok Haskell [] ys
-    tok _     acc []               = reverse acc: []
-    tok mode  acc (y:ys)           = tok mode (y:acc) ys
-
--- | Put back the line-continuation characters.
-reslash :: String -> String
-reslash ('\n':xs) = '\\':'\n':reslash xs
-reslash (x:xs)    = x: reslash xs
-reslash   []      = []
-
-----
--- | Submodes are required to deal correctly with nesting of lexical
---   structures.
-data SubMode = Any | Pred (Char->Bool) (Posn->String->WordStyle)
-             | String Char | LineComment | NestComment Int
-             | CComment | CLineComment
-
--- | Each token is classified as one of Ident, Other, or Cmd:
---   * Ident is a word that could potentially match a macro name.
---   * Cmd is a complete cpp directive (\#define etc).
---   * Other is anything else.
-data WordStyle = Ident Posn String | Other String | Cmd (Maybe HashDefine)
-  deriving (Eq,Show)
-other :: Posn -> String -> WordStyle
-other _ s = Other s
-
-deWordStyle :: WordStyle -> String
-deWordStyle (Ident _ i) = i
-deWordStyle (Other i)   = i
-deWordStyle (Cmd _)     = "\n"
-
--- | tokenise is, broadly-speaking, Prelude.words, except that:
---    * the input is already divided into lines
---    * each word-like "token" is categorised as one of {Ident,Other,Cmd}
---    * \#define's are parsed and returned out-of-band using the Cmd variant
---    * All whitespace is preserved intact as tokens.
---    * C-comments are converted to white-space (depending on first param)
---    * Parens and commas are tokens in their own right.
---    * Any cpp line continuations are respected.
---   No errors can be raised.
---   The inverse of tokenise is (concatMap deWordStyle).
-tokenise :: Bool -> Bool -> Bool -> Bool -> [(Posn,String)] -> [WordStyle]
-tokenise _        _             _    _     [] = []
-tokenise stripEol stripComments ansi lang ((pos,str):pos_strs) =
-    (if lang then haskell else plaintext) Any [] pos pos_strs str
- where
-    -- rules to lex Haskell
-  haskell :: SubMode -> String -> Posn -> [(Posn,String)]
-             -> String -> [WordStyle]
-  haskell Any acc p ls ('\n':'#':xs)      = emit acc $  -- emit "\n" $
-                                            cpp Any haskell [] [] p ls xs
-    -- warning: non-maximal munch on comment
-  haskell Any acc p ls ('-':'-':xs)       = emit acc $
-                                            haskell LineComment "--" p ls xs
-  haskell Any acc p ls ('{':'-':xs)       = emit acc $
-                                            haskell (NestComment 0) "-{" p ls xs
-  haskell Any acc p ls ('/':'*':xs)
-                          | stripComments = emit acc $
-                                            haskell CComment "  " p ls xs
-  haskell Any acc p ls ('/':'/':xs)
-                          | stripEol      = emit acc $
-                                            haskell CLineComment "  " p ls xs
-  haskell Any acc p ls ('"':xs)           = emit acc $
-                                            haskell (String '"') ['"'] p ls xs
-  haskell Any acc p ls ('\'':'\'':xs)     = emit acc $ -- TH type quote
-                                            haskell Any "''" p ls xs
-  haskell Any acc p ls ('\'':xs@('\\':_)) = emit acc $ -- escaped char literal
-                                            haskell (String '\'') "'" p ls xs
-  haskell Any acc p ls ('\'':x:'\'':xs)   = emit acc $ -- character literal
-                                            emit ['\'', x, '\''] $
-                                            haskell Any [] p ls xs
-  haskell Any acc p ls ('\'':xs)          = emit acc $ -- TH name quote
-                                            haskell Any "'" p ls xs
-  haskell Any acc p ls (x:xs) | single x  = emit acc $ emit [x] $
-                                            haskell Any [] p ls xs
-  haskell Any acc p ls (x:xs) | space x   = emit acc $
-                                            haskell (Pred space other) [x]
-                                                                        p ls xs
-  haskell Any acc p ls (x:xs) | symbol x  = emit acc $
-                                            haskell (Pred symbol other) [x]
-                                                                        p ls xs
- -- haskell Any [] p ls (x:xs) | ident0 x  = id $
-  haskell Any acc p ls (x:xs) | ident0 x  = emit acc $
-                                            haskell (Pred ident1 Ident) [x]
-                                                                        p ls xs
-  haskell Any acc p ls (x:xs)             = haskell Any (x:acc) p ls xs
-
-  haskell pre@(Pred pred ws) acc p ls (x:xs)
-                        | pred x    = haskell pre (x:acc) p ls xs
-  haskell (Pred _ ws) acc p ls xs   = ws p (reverse acc):
-                                      haskell Any [] p ls xs
-  haskell (String c) acc p ls ('\\':x:xs)
-                        | x=='\\'   = haskell (String c) ('\\':'\\':acc) p ls xs
-                        | x==c      = haskell (String c) (c:'\\':acc) p ls xs
-  haskell (String c) acc p ls (x:xs)
-                        | x==c      = emit (c:acc) $ haskell Any [] p ls xs
-                        | otherwise = haskell (String c) (x:acc) p ls xs
-  haskell LineComment acc p ls xs@('\n':_) = emit acc $ haskell Any [] p ls xs
-  haskell LineComment acc p ls (x:xs)      = haskell LineComment (x:acc) p ls xs
-  haskell (NestComment n) acc p ls ('{':'-':xs)
-                                    = haskell (NestComment (n+1))
-                                                            ("-{"++acc) p ls xs
-  haskell (NestComment 0) acc p ls ('-':'}':xs)
-                                    = emit ("}-"++acc) $ haskell Any [] p ls xs
-  haskell (NestComment n) acc p ls ('-':'}':xs)
-                                    = haskell (NestComment (n-1))
-                                                            ("}-"++acc) p ls xs
-  haskell (NestComment n) acc p ls (x:xs) = haskell (NestComment n) (x:acc)
-                                                                        p ls xs
-  haskell CComment acc p ls ('*':'/':xs)  = emit ("  "++acc) $
-                                            haskell Any [] p ls xs
-  haskell CComment acc p ls (x:xs)        = haskell CComment (white x:acc) p ls xs
-  haskell CLineComment acc p ls xs@('\n':_)= emit acc $ haskell Any [] p ls xs
-  haskell CLineComment acc p ls (_:xs)    = haskell CLineComment (' ':acc)
-                                                                       p ls xs
-  haskell mode acc _ ((p,l):ls) []        = haskell mode acc p ls ('\n':l)
-  haskell _    acc _ [] []                = emit acc $ []
-
-  -- rules to lex Cpp
-  cpp :: SubMode -> (SubMode -> String -> Posn -> [(Posn,String)]
-                     -> String -> [WordStyle])
-         -> String -> [String] -> Posn -> [(Posn,String)]
-         -> String -> [WordStyle]
-  cpp mode next word line pos remaining input =
-    lexcpp mode word line remaining input
-   where
-    lexcpp Any w l ls ('/':'*':xs)   = lexcpp (NestComment 0) "" (w*/*l) ls xs
-    lexcpp Any w l ls ('/':'/':xs)   = lexcpp LineComment "  " (w*/*l) ls xs
-    lexcpp Any w l ((p,l'):ls) ('\\':[])  = cpp Any next [] ("\n":w*/*l) p ls l'
-    lexcpp Any w l ls ('\\':'\n':xs) = lexcpp Any [] ("\n":w*/*l) ls xs
-    lexcpp Any w l ls xs@('\n':_)    = Cmd (parseHashDefine ansi
-                                                           (reverse (w*/*l))):
-                                       next Any [] pos ls xs
- -- lexcpp Any w l ls ('"':xs)     = lexcpp (String '"') ['"'] (w*/*l) ls xs
- -- lexcpp Any w l ls ('\'':xs)    = lexcpp (String '\'') "'"  (w*/*l) ls xs
-    lexcpp Any w l ls ('"':xs)       = lexcpp Any [] ("\"":(w*/*l)) ls xs
-    lexcpp Any w l ls ('\'':xs)      = lexcpp Any [] ("'": (w*/*l)) ls xs
-    lexcpp Any [] l ls (x:xs)
-                    | ident0 x  = lexcpp (Pred ident1 Ident) [x] l ls xs
- -- lexcpp Any w l ls (x:xs) | ident0 x  = lexcpp (Pred ident1 Ident) [x] (w*/*l) ls xs
-    lexcpp Any w l ls (x:xs)
-                    | single x  = lexcpp Any [] ([x]:w*/*l) ls xs
-                    | space x   = lexcpp (Pred space other) [x] (w*/*l) ls xs
-                    | symbol x  = lexcpp (Pred symbol other) [x] (w*/*l) ls xs
-                    | otherwise = lexcpp Any (x:w) l ls xs
-    lexcpp pre@(Pred pred _) w l ls (x:xs)
-                    | pred x    = lexcpp pre (x:w) l ls xs
-    lexcpp (Pred _ _) w l ls xs = lexcpp Any [] (w*/*l) ls xs
-    lexcpp (String c) w l ls ('\\':x:xs)
-                    | x=='\\'   = lexcpp (String c) ('\\':'\\':w) l ls xs
-                    | x==c      = lexcpp (String c) (c:'\\':w) l ls xs
-    lexcpp (String c) w l ls (x:xs)
-                    | x==c      = lexcpp Any [] ((c:w)*/*l) ls xs
-                    | otherwise = lexcpp (String c) (x:w) l ls xs
-    lexcpp LineComment w l ((p,l'):ls) ('\\':[])
-                             = cpp LineComment next [] (('\n':w)*/*l) pos ls l'
-    lexcpp LineComment w l ls ('\\':'\n':xs)
-                                = lexcpp LineComment [] (('\n':w)*/*l) ls xs
-    lexcpp LineComment w l ls xs@('\n':_) = lexcpp Any w l ls xs
-    lexcpp LineComment w l ls (_:xs)      = lexcpp LineComment (' ':w) l ls xs
-    lexcpp (NestComment _) w l ls ('*':'/':xs)
-                                          = lexcpp Any [] (w*/*l) ls xs
-    lexcpp (NestComment n) w l ls (x:xs)  = lexcpp (NestComment n) (white x:w) l
-                                                                        ls xs
-    lexcpp mode w l ((p,l'):ls) []        = cpp mode next w l p ls ('\n':l')
-    lexcpp _    _ _ []          []        = []
-
-    -- rules to lex non-Haskell, non-cpp text
-  plaintext :: SubMode -> String -> Posn -> [(Posn,String)]
-            -> String -> [WordStyle]
-  plaintext Any acc p ls ('\n':'#':xs)  = emit acc $  -- emit "\n" $
-                                          cpp Any plaintext [] [] p ls xs
-  plaintext Any acc p ls ('/':'*':xs)
-                           | stripComments = emit acc $
-                                             plaintext CComment "  " p ls xs
-  plaintext Any acc p ls ('/':'/':xs)
-                                | stripEol = emit acc $
-                                             plaintext CLineComment "  " p ls xs
-  plaintext Any acc p ls (x:xs) | single x = emit acc $ emit [x] $
-                                             plaintext Any [] p ls xs
-  plaintext Any acc p ls (x:xs) | space x  = emit acc $
-                                             plaintext (Pred space other) [x]
-                                                                        p ls xs
-  plaintext Any acc p ls (x:xs) | ident0 x = emit acc $
-                                             plaintext (Pred ident1 Ident) [x]
-                                                                        p ls xs
-  plaintext Any acc p ls (x:xs)            = plaintext Any (x:acc) p ls xs
-  plaintext pre@(Pred pred ws) acc p ls (x:xs)
-                                | pred x   = plaintext pre (x:acc) p ls xs
-  plaintext (Pred _ ws) acc p ls xs        = ws p (reverse acc):
-                                             plaintext Any [] p ls xs
-  plaintext CComment acc p ls ('*':'/':xs) = emit ("  "++acc) $
-                                             plaintext Any [] p ls xs
-  plaintext CComment acc p ls (x:xs)       = plaintext CComment (white x:acc) p ls xs
-  plaintext CLineComment acc p ls xs@('\n':_)
-                                        = emit acc $ plaintext Any [] p ls xs
-  plaintext CLineComment acc p ls (_:xs)= plaintext CLineComment (' ':acc)
-                                                                       p ls xs
-  plaintext mode acc _ ((p,l):ls) []    = plaintext mode acc p ls ('\n':l)
-  plaintext _    acc _ [] []            = emit acc $ []
-
-  -- predicates for lexing Haskell.
-  ident0 x = isAlpha x    || x `elem` "_`"
-  ident1 x = isAlphaNum x || x `elem` "'_`"
-  symbol x = x `elem` ":!#$%&*+./<=>?@\\^|-~"
-  single x = x `elem` "(),[];{}"
-  space  x = x `elem` " \t"
-  -- conversion of comment text to whitespace
-  white '\n' = '\n'
-  white '\r' = '\r'
-  white _    = ' '
-  -- emit a token (if there is one) from the accumulator
-  emit ""  = id
-  emit xs  = (Other (reverse xs):)
-  -- add a reversed word to the accumulator
-  "" */* l = l
-  w */* l  = reverse w : l
-  -- help out broken Haskell compilers which need balanced numbers of C
-  -- comments in order to do import chasing :-)  ----->   */*
-
-
--- | Parse a possible macro call, returning argument list and remaining input
-parseMacroCall :: Posn -> [WordStyle] -> Maybe ([[WordStyle]],[WordStyle])
-parseMacroCall p = call . skip
-  where
-    skip (Other x:xs) | all isSpace x = skip xs
-    skip xss                          = xss
-    call (Other "(":xs)   = (args (0::Int) [] [] . skip) xs
-    call _                = Nothing
-    args 0 w acc (   Other ")" :xs)  = Just (reverse (addone w acc), xs)
-    args 0 w acc (   Other "," :xs)  = args 0     []   (addone w acc) (skip xs)
-    args n w acc (x@(Other "("):xs)  = args (n+1) (x:w)         acc    xs
-    args n w acc (x@(Other ")"):xs)  = args (n-1) (x:w)         acc    xs
-    args n w acc (   Ident _ v :xs)  = args n     (Ident p v:w) acc    xs
-    args n w acc (x@(Other _)  :xs)  = args n     (x:w)         acc    xs
-    args _ _ _   _                   = Nothing
-    addone w acc = reverse (skip w): acc
− examples/CppHs/Language/Preprocessor/Unlit.hs 
@@ -1,72 +0,0 @@--- | Part of this code is from "Report on the Programming Language Haskell",
---   version 1.2, appendix C.
-module Language.Preprocessor.Unlit (unlit) where
-
-import Data.Char
-import Data.List (isPrefixOf)
-
-data Classified = Program String | Blank | Comment
-                | Include Int String | Pre String
-
-classify :: [String] -> [Classified]
-classify []                = []
-classify (('\\':x):xs) | x == "begin{code}" = Blank : allProg xs
-   where allProg [] = []  -- Should give an error message,
-                          -- but I have no good position information.
-         allProg (('\\':x):xs) |  "end{code}"`isPrefixOf`x = Blank : classify xs
-         allProg (x:xs) = Program x:allProg xs
-classify (('>':x):xs)      = Program (' ':x) : classify xs
-classify (('#':x):xs)      = (case words x of
-                                (line:rest) | all isDigit line
-                                   -> Include (read line) (unwords rest)
-                                _  -> Pre x
-                             ) : classify xs
---classify (x:xs) | "{-# LINE" `isPrefixOf` x = Program x: classify xs
-classify (x:xs) | all isSpace x = Blank:classify xs
-classify (x:xs)                 = Comment:classify xs
-
-unclassify :: Classified -> String
-unclassify (Program s) = s
-unclassify (Pre s)     = '#':s
-unclassify (Include i f) = '#':' ':show i ++ ' ':f
-unclassify Blank       = ""
-unclassify Comment     = ""
-
--- | 'unlit' takes a filename (for error reports), and transforms the
---   given string, to eliminate the literate comments from the program text.
-unlit :: FilePath -> String -> String
-unlit file lhs = (unlines
-                 . map unclassify
-                 . adjacent file (0::Int) Blank
-                 . classify) (inlines lhs)
-
-adjacent :: FilePath -> Int -> Classified -> [Classified] -> [Classified]
-adjacent file 0 _             (x              :xs) = x : adjacent file 1 x xs -- force evaluation of line number
-adjacent file n y@(Program _) (x@Comment      :xs) = error (message file n "program" "comment")
-adjacent file n y@(Program _) (x@(Include i f):xs) = x: adjacent f    i     y xs
-adjacent file n y@(Program _) (x@(Pre _)      :xs) = x: adjacent file (n+1) y xs
-adjacent file n y@Comment     (x@(Program _)  :xs) = error (message file n "comment" "program")
-adjacent file n y@Comment     (x@(Include i f):xs) = x: adjacent f    i     y xs
-adjacent file n y@Comment     (x@(Pre _)      :xs) = x: adjacent file (n+1) y xs
-adjacent file n y@Blank       (x@(Include i f):xs) = x: adjacent f    i     y xs
-adjacent file n y@Blank       (x@(Pre _)      :xs) = x: adjacent file (n+1) y xs
-adjacent file n _             (x@next         :xs) = x: adjacent file (n+1) x xs
-adjacent file n _             []                   = []
-
-message :: String -> Int -> String -> String -> String
-message "\"\"" n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n"
-message []     n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n"
-message file   n p c = "In file " ++ file ++ " at line "++show n++": "++p++ " line before "++c++" line.\n"
-
-
--- Re-implementation of 'lines', for better efficiency (but decreased laziness).
--- Also, importantly, accepts non-standard DOS and Mac line ending characters.
-inlines :: String -> [String]
-inlines s = lines' s id
-  where
-  lines' []             acc = [acc []]
-  lines' ('\^M':'\n':s) acc = acc [] : lines' s id      -- DOS
-  lines' ('\^M':s)      acc = acc [] : lines' s id      -- MacOS
-  lines' ('\n':s)       acc = acc [] : lines' s id      -- Unix
-  lines' (c:s)          acc = lines' s (acc . (c:))
-
− examples/Decl/AmbiguousFields.hs 
@@ -1,9 +0,0 @@-{-# LANGUAGE DuplicateRecordFields #-}
-module Decl.AmbiguousFields where
-
-data A = A { x, y :: Int }
-data B = B { x, y :: Int }
-
-f :: A -> Int
-f = x
-
− examples/Decl/AnnPragma.hs 
@@ -1,8 +0,0 @@-module Decl.AnnPragma where
-{-# ANN module (Just "Hello") #-}
-{-# ANN f (Just "Hello") #-}
-f :: Int -> Int
-f a = a + 1
-
-{-# ANN type A (Just "Hello") #-}
-data A = A
− examples/Decl/ClassInfix.hs 
@@ -1,10 +0,0 @@-module Decl.ClassInfix where
-
-import Control.Applicative
-
-class Applicative f => MonoidApplicative f where
-   infixl 4 +<*>
-   (+<*>) :: f (a -> a) -> f a -> f a
-
-   infixl 5 ><
-   (><) :: Monoid a => f a -> f a -> f a
− examples/Decl/ClosedTypeFamily.hs 
@@ -1,9 +0,0 @@-{-# LANGUAGE TypeFamilies #-}
-module Decl.ClosedTypeFamily where
-
-type family F a where
-  F Int  = Bool
-  F Bool = Char
-  F a    = Bool
-
-type family ClosedEmpty t where
− examples/Decl/CompletePragma.hs 
@@ -1,16 +0,0 @@-{-# LANGUAGE PatternSynonyms #-}
-module Decl.CompletePragma where
-
-data Choice a = Choice Bool a
-
-pattern LeftChoice :: a -> Choice a
-pattern LeftChoice a = Choice False a
-
-pattern RightChoice :: a -> Choice a
-pattern RightChoice a = Choice True a
-
-{-# COMPLETE LeftChoice, RightChoice #-}
-
-foo :: Choice Int -> Int
-foo (LeftChoice n) = n * 2
-foo (RightChoice n) = n - 2
− examples/Decl/CtorOp.hs 
@@ -1,10 +0,0 @@-{-# LANGUAGE TypeOperators #-}
-module Decl.CtorOp where
-
-data a :+: b = a :+: b
-
-data (a :!: b) c = a c :!: b c
-
-data ((:-:) a) b = a :-: b
-
-data (:*:) a b = a :*: b
− examples/Decl/DataFamily.hs 
@@ -1,6 +0,0 @@-{-# LANGUAGE TypeFamilies #-}
-module Decl.DataFamily where
-
-data family Array :: * -> *
-
-data instance Array () = UnitArray Int deriving Show
− examples/Decl/DataInstanceGADT.hs 
@@ -1,6 +0,0 @@-{-# LANGUAGE GADTs, KindSignatures, TypeFamilies #-}
-module Decl.DataInstanceGADT where
-
-data family GadtFam (a :: *) (b :: *)
-data instance GadtFam c d where
-  MkGadtFam1 :: x -> y -> GadtFam y x
− examples/Decl/DataType.hs 
@@ -1,5 +0,0 @@-module Decl.DataType where
-
-data EmptyData
-
-data A = B Int | C
− examples/Decl/DataTypeDerivings.hs 
@@ -1,5 +0,0 @@-module Decl.DataTypeDerivings where
-
-data A = A deriving (Eq, Show)
-data B = B deriving (Eq)
-data C = C deriving Eq
− examples/Decl/DefaultDecl.hs 
@@ -1,3 +0,0 @@-module Decl.DefaultDecl where
-
-default ()
− examples/Decl/FunBind.hs 
@@ -1,4 +0,0 @@-module Decl.FunBind where
-
-f 0 = 1
-f x = x
− examples/Decl/FunFixity.hs 
@@ -1,5 +0,0 @@-module Decl.FunFixity where
-
-infixl `snoc`
-snoc :: [a] -> a -> [a]
-snoc xs x = xs ++ [x]
− examples/Decl/FunGuards.hs 
@@ -1,5 +0,0 @@-module Decl.FunGuards where
-
-f 0 = 1
-f x | even x = 0
-    | otherwise = 2
− examples/Decl/FunctionalDeps.hs 
@@ -1,6 +0,0 @@-{-# LANGUAGE FunctionalDependencies, MultiParamTypeClasses #-}
-module Decl.FunctionalDeps where
-
-class C a b | a -> b, b -> a where
-  trf :: a -> b
-
− examples/Decl/GADT.hs 
@@ -1,9 +0,0 @@-{-# LANGUAGE GADTs, KindSignatures, DeriveDataTypeable #-}
-module Decl.GADT where
-
-import Data.Typeable
-
-data DMap k f where
-    Tip :: DMap k f
-    Bin :: !Int -> !(k v) -> f v -> !(DMap k f) -> !(DMap k f) -> DMap k f
-    deriving Typeable
− examples/Decl/GadtConWithCtx.hs 
@@ -1,5 +0,0 @@-{-# LANGUAGE GADTs #-}
-module Decl.GadtConWithCtx where
-
-data Concurrently m a where
-  Concurrently :: Monad m => { runConcurrently :: m a } -> Concurrently m a
− examples/Decl/InfixAssertion.hs 
@@ -1,9 +0,0 @@-{-# LANGUAGE DataKinds, TypeOperators, KindSignatures, TypeFamilies #-}
-module Decl.InfixAssertion where
-
-import GHC.TypeLits
-
-data Proxy (n :: Nat) = Proxy
-
-divSNat :: (1 <= b) => Proxy b -> Proxy b
-divSNat n = n
− examples/Decl/InfixInstances.hs 
@@ -1,8 +0,0 @@-{-# LANGUAGE TypeOperators, TypeFamilies #-}
-module Decl.InfixInstances where
-
-data Zipper h i a = Zipper
-data (:@) a i
-infixl 8 :>
-type family (:>) h p
-type instance h :> (a :@ i) = Zipper h i a
− examples/Decl/InfixPatSyn.hs 
@@ -1,10 +0,0 @@-{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
-module Decl.InfixPatSyn where
-
-pattern x :. xs <- (uncons -> Just (x,xs)) where
-  x:.xs = cons x xs
-infixr 5 :.
-
-cons x xs = x:xs
-uncons (x:xs) = Just (x,xs)
-uncons [] = Nothing
− examples/Decl/InjectiveTypeFamily.hs 
@@ -1,6 +0,0 @@-{-# LANGUAGE TypeFamilies, TypeFamilyDependencies #-}
-module Decl.InjectiveTypeFamily where
-
-type family Array a = r | r -> a
-
-type instance Array () = Int
− examples/Decl/InlinePragma.hs 
@@ -1,5 +0,0 @@-module Decl.InlinePragma where
-
-comp :: (b -> c) -> (a -> b) -> a -> c
-{-# INLINE CONLIKE [~1] comp #-}
-comp f g = \x -> f (g x)
− examples/Decl/InstanceFamily.hs 
@@ -1,10 +0,0 @@-{-# LANGUAGE TypeOperators, TypeFamilies #-}
-module Decl.InstanceFamily where
-
-import GHC.Generics
-
-class HasTrie a where
-  data (:->:) a :: * -> *
-
-instance (HasTrie (f x)) => HasTrie (M1 i t f x) where
-  data (M1 i t f x :->: b) = M1Trie (f x :->: b)
− examples/Decl/InstanceOverlaps.hs 
@@ -1,11 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}
-module Decl.InstanceOverlaps where
-
-data A a = A a
-
-instance {-# OVERLAPPING #-} Show (A String) where
-  show (A a) = a
-instance {-# OVERLAPS #-} Show a => Show (A [a]) where
-  show (A a) = show a
-instance {-# OVERLAPPABLE #-} Show (A a) where
-  show (A _) = "A"
− examples/Decl/InstanceSpec.hs 
@@ -1,7 +0,0 @@-module Decl.InstanceSpec where
-
-data Foo a = Foo a
-
-instance (Eq a) => Eq (Foo a) where 
-   {-# SPECIALIZE instance Eq (Foo Char) #-}
-   Foo a == Foo b = a == b
− examples/Decl/LocalBindingInDo.hs 
@@ -1,7 +0,0 @@-module Decl.LocalBindingInDo where
-
-x :: Maybe ()
-x = do let y = f a
-             where a = ()
-       return y
-    where f = id
− examples/Decl/LocalBindings.hs 
@@ -1,9 +0,0 @@-module Decl.LocalBindings where
-
-f x = g x
-  where g :: Int -> Int
-        g = id
-        
-f' x | even x = g x
-  where g :: Int -> Int
-        g = id
− examples/Decl/LocalFixity.hs 
@@ -1,6 +0,0 @@-module Decl.LocalFixity where
-
-x = 1 `f` 2
-  where f :: Int -> Int -> Int
-        f a b = a + b 
-        infixl 6 `f`
− examples/Decl/MinimalPragma.hs 
@@ -1,23 +0,0 @@-module Decl.MinimalPragma where
-
-class A x where
-  f, g :: x -> ()
-  {-# MINIMAL f,g #-}
-
-class B x where
-  fb, gb :: x -> ()
-  fb = gb
-  gb = fb
-  {-# MINIMAL fb | gb #-}
-
-class C x where
-  fc, gc, hc :: x -> x
-  gc = fc
-  hc = fc
-  fc = gc . hc
-  {-# MINIMAL fc | (gc, hc) #-}
-
-class D x where
-  fd :: x -> x
-  fd = id
-  {-# MINIMAL #-}
− examples/Decl/MixedInstance.hs 
@@ -1,11 +0,0 @@-{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-}
-module Decl.MixedInstance where
-
-data Canvas = Canvas
-data V2 = V2
-
-class Backend c v e where
-  data Options c v e :: *
-
-instance Backend Canvas V2 Double where
-  data Options Canvas V2 Double = CanvasOptions
− examples/Decl/MultipleFixity.hs 
@@ -1,12 +0,0 @@-module Decl.MultipleFixity where
-
-f :: Int -> Int -> Int
-f a b = a + b
-
-g = f
-
-infixl 6 `f`, `g`
-
-h = f
-
-infixl 5 `h`
− examples/Decl/MultipleSigs.hs 
@@ -1,6 +0,0 @@-module Decl.MultipleSigs where
-
-f, g :: Int -> Int -> Int
-f a b = a + b
-
-g = f
− examples/Decl/OperatorBind.hs 
@@ -1,6 +0,0 @@-module Decl.OperatorBind where
-
-a >< b = a ++ b
-
-(<+>) :: Int -> Int -> Int -> Int
-(a <+> b) c = a + b + c
− examples/Decl/OperatorDecl.hs 
@@ -1,6 +0,0 @@-module Decl.OperatorDecl where
-
-(-!-) :: Int -> Int -> Int
-(-!-) a b = a + b
-
-test = (-!-) (1 -!- 2) 3
− examples/Decl/ParamDataType.hs 
@@ -1,5 +0,0 @@-module Decl.ParamDataType where
-
-data A a = B Int | C a
-
-data X a = X a
− examples/Decl/PatternBind.hs 
@@ -1,3 +0,0 @@-module Decl.PatternBind where
-
-(x,y) | 1 == 1 = (1,2)
− examples/Decl/PatternSynonym.hs 
@@ -1,28 +0,0 @@-{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
-module Decl.PatternSynonym where
-
-data Type = App String [Type]
-
-pattern Arrow :: Type -> Type -> Type
-pattern Arrow t1 t2 = App "->"    [t1, t2]
-
-
-pattern Int        <- App "Int"   []
-
-pattern Maybe t    <- App "Maybe" [t]
-   where Maybe (App "()" []) = App "Bool" []
-         Maybe t = App "Maybe" [t]
-
-pattern (:<) :: [a] -> a -> [a]
-pattern (:<) xs x <- ((\ys -> (init ys,last ys)) -> (xs,x))
-  where
-    (:<) xs x = xs ++ [x]
-
------- this is not supported yet
--- class ListLike a where
---   pattern Head :: e -> a e0
---   pattern Tail :: a e -> a e
-
--- instance ListLike [] where
---   pattern Head h = h:_
---   pattern Tail t = _:t
− examples/Decl/RecordPatternSynonyms.hs 
@@ -1,8 +0,0 @@-{-# LANGUAGE PatternSynonyms #-}
-module Decl.RecordPatternSynonyms where
-
-pattern XPoint {xp} <- (xp, 0) where XPoint xp = (xp, 0)
-
-pattern Point {x, y} = (x, y)
-
-r = (0, 0) { x = 1 }
− examples/Decl/RecordType.hs 
@@ -1,3 +0,0 @@-module Decl.RecordType where
-
-data A = B { valB, extra :: Int, qq :: Double } | C
− examples/Decl/RewriteRule.hs 
@@ -1,3 +0,0 @@-module Decl.RewriteRule where
-
-{-# RULES "map/map" forall f g xs . map f (map g xs) = map (f . g) xs #-}
− examples/Decl/SpecializePragma.hs 
@@ -1,5 +0,0 @@-module Decl.SpecializePragma where
-
-hammeredLookup :: Ord key => [(key, value)] -> key -> value
-{-# SPECIALIZE hammeredLookup :: [(String, value)] -> String -> value, [(Char, value)] -> Char -> value #-}
-hammeredLookup = undefined
− examples/Decl/StandaloneDeriving.hs 
@@ -1,6 +0,0 @@-{-# LANGUAGE StandaloneDeriving #-}
-module Decl.StandaloneDeriving where
-
-data WrapStr = WrapStr String 
-
-deriving instance Eq WrapStr
− examples/Decl/TypeClass.hs 
@@ -1,13 +0,0 @@-{-# LANGUAGE TypeFamilies #-}
-module Decl.TypeClass where
-
-class EmptyClass a
-
-class Show a => C a where
-  type X a :: *
-  type X a = Int
-  data Q a :: *
-  
-  f :: a -> String
-  f = show
-
− examples/Decl/TypeClassMinimal.hs 
@@ -1,8 +0,0 @@-module Decl.TypeClassMinimal where
-
-class Eq' a where
-    (=.=) :: a -> a -> Bool
-    (/.=) :: a -> a -> Bool
-    x =.= y = not (x /.= y)
-    x /.= y = not (x =.= y)
-    {-# MINIMAL (=.=) | (/.=) #-}
− examples/Decl/TypeFamily.hs 
@@ -1,6 +0,0 @@-{-# LANGUAGE TypeFamilies #-}
-module Decl.TypeFamily where
-
-type family Array a :: *
-
-type instance Array () = Int
− examples/Decl/TypeFamilyKindSig.hs 
@@ -1,6 +0,0 @@-{-# LANGUAGE TypeFamilies #-}
-module Decl.TypeFamilyKindSig where
-
-type family Array (a :: *) :: *
-
-type instance Array () = Int
− examples/Decl/TypeInstance.hs 
@@ -1,14 +0,0 @@-{-# LANGUAGE TypeFamilies, InstanceSigs #-}
-module Decl.TypeInstance where
-
-import Decl.TypeClass
-
-data A = A deriving Show
-
-instance C A where
-  type X A = Int
-  data Q A = Bool
-
-  f :: A -> String
-  f A = "XXX"
-
− examples/Decl/TypeRole.hs 
@@ -1,5 +0,0 @@-{-# LANGUAGE RoleAnnotations #-}
-module Decl.TypeRole where
-
-type role Foo representational representational
-data Foo a b = Foo Int
− examples/Decl/TypeSynonym.hs 
@@ -1,3 +0,0 @@-module Decl.TypeSynonym where
-
-type List = Int
− examples/Decl/ValBind.hs 
@@ -1,3 +0,0 @@-module Decl.ValBind where
-
-x = 1
− examples/Decl/ViewPatternSynonym.hs 
@@ -1,8 +0,0 @@-{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
-module Decl.ViewPatternSynonym where
-
-data Uncert a = Un a a
-
-pattern x :+/- dx <- Un x (sqrt->dx)
-  where
-    x :+/- dx = Un x (dx*dx)
− examples/Expr/ArrowNotation.hs 
@@ -1,10 +0,0 @@-{-# LANGUAGE Arrows #-}
-module Expr.ArrowNotation where
-
-import Control.Arrow
-
-addA :: Arrow a => a b Int -> a b Int -> a b Int
-addA f g = proc x -> do
-                y <- f -< x
-                z <- g -< x
-                returnA -< y + z
− examples/Expr/Case.hs 
@@ -1,8 +0,0 @@-module Expr.Case where
-
-x = 12
-
-a = case x of 1 -> 0
-              _ -> 1
-
-b = case x of { 1 -> 0; _ -> 1 }
− examples/Expr/DoNotation.hs 
@@ -1,15 +0,0 @@-module Expr.DoNotation where
-
-import Control.Monad.Identity
-
-x1 :: Identity ()
-x1 = return ()
-
-x2 :: Identity ()
-x2 = do return ()
-
-x3 :: Identity ()
-x3 = do { return () }
-
-x4 :: Identity Int
-x4 = do { one <- Identity 1; return (one + 1) }
− examples/Expr/EmptyCase.hs 
@@ -1,8 +0,0 @@-{-# LANGUAGE EmptyCase #-}
-module Expr.EmptyCase where
-
-x = 12
-
-a = case x of 
-
-b = case x of {}
− examples/Expr/EmptyLet.hs 
@@ -1,6 +0,0 @@-module Expr.EmptyLet where
-
-a = let in ()
-
-m = do let
-       putStrLn "hello"
− examples/Expr/FunSection.hs 
@@ -1,6 +0,0 @@-module Expr.FunSection where
-
-data Rule = Rule {
-    rulePath :: String -> Bool }
-
-f r = filter (`rulePath` r)
− examples/Expr/GeneralizedListComp.hs 
@@ -1,31 +0,0 @@-{-# LANGUAGE ParallelListComp, 
-             TransformListComp,
-             MonadComprehensions,
-             RecordWildCards #-}
-module Expr.GeneralizedListComp where
-
-import GHC.Exts
-import qualified Data.Map as M
-import Data.Ord (comparing)
-
-data Character = Character
-  { firstName :: String
-  , lastName :: String
-  , birthYear :: Int
-  } deriving (Show, Eq)
-
-friends :: [Character]
-friends = [ Character "Phoebe" "Buffay" 1963
-          , Character "Chandler" "Bing" 1969
-          , Character "Rachel" "Green" 1969
-          , Character "Joey" "Tribbiani" 1967
-          , Character "Monica" "Geller" 1964
-          , Character "Ross" "Geller" 1966
-          ]
-          
-oldest :: Int -> [Character] -> [String]
-oldest k tbl = [ firstName ++ " " ++ lastName
-               | Character{..} <- tbl
-               , then sortWith by birthYear
-               , then take k
-               ]
− examples/Expr/If.hs 
@@ -1,4 +0,0 @@-module Expr.If where
-
-b = 12
-a = if b > 3 then 1 else 0
− examples/Expr/LambdaCase.hs 
@@ -1,11 +0,0 @@-{-# LANGUAGE LambdaCase, EmptyCase #-}
-module Expr.LambdaCase where
-
-a = \case 1 -> 0
-          _ -> 1
-
-b = \case { 1 -> 0; _ -> 1 }
-
-c = \case {}
-
-d = \case
− examples/Expr/ListComp.hs 
@@ -1,3 +0,0 @@-module Expr.ListComp where
-
-ls = [ x+y | x <- [1..5], y <- [1..5]]
− examples/Expr/MultiwayIf.hs 
@@ -1,7 +0,0 @@-{-# LANGUAGE MultiWayIf #-}
-module Expr.MultiwayIf where
-
-b = 12
-a = if | b > 3     -> 1
-       | b < -5    -> 2
-       | otherwise -> 3
− examples/Expr/Negate.hs 
@@ -1,4 +0,0 @@-module Expr.Negate where
-
-y = 1
-x = -y
− examples/Expr/Operator.hs 
@@ -1,5 +0,0 @@-module Expr.Operator where
-
-x = 1 + 2
-y = (+) 1 2
-z = 1 `mod` 2
− examples/Expr/ParListComp.hs 
@@ -1,4 +0,0 @@-{-# LANGUAGE ParallelListComp #-}
-module Expr.ParListComp where
-
-ls = [ x+y | x <- [1..5] | y <- [1..5]]
− examples/Expr/ParenName.hs 
@@ -1,3 +0,0 @@-module Expr.ParenName where
-
-a x y = (mod) x y
− examples/Expr/PatternAndDo.hs 
@@ -1,10 +0,0 @@-{-# LANGUAGE RecordWildCards #-}
-module Expr.PatternAndDo where
-
-import Control.Monad
-import Control.Monad.Identity
-
-data A = A { x :: Int }
-
-a = forM_ [] $ \A {..} -> do
-      Identity "Hello"
− examples/Expr/RecordPuns.hs 
@@ -1,6 +0,0 @@-{-# LANGUAGE NamedFieldPuns #-}
-module Expr.RecordPuns where
-
-data Point = Point { x :: Int, y :: Int }
-
-f (Point {y}) = y
− examples/Expr/RecordWildcards.hs 
@@ -1,6 +0,0 @@-{-# LANGUAGE RecordWildCards #-}
-module Expr.RecordWildcards where
-
-data Point = Point { x :: Int, y :: Int }
-
-p1 = let x = 3; y = 4 in Point { x = 1, .. }
− examples/Expr/RecursiveDo.hs 
@@ -1,9 +0,0 @@-{-# LANGUAGE RecursiveDo #-}
-module Expr.RecursiveDo where
-
-justOnes = mdo xs <- Just (1:xs)
-               return (map negate xs)
-
-justOnes' = do rec xs <- Just (1:xs)
-                   return (map negate xs)
-               return xs
− examples/Expr/SccPragma.hs 
@@ -1,4 +0,0 @@-module Expr.SccPragma where
-
-f x = {-# SCC "drawComponent" #-}
-        case x of () -> ()
− examples/Expr/Sections.hs 
@@ -1,4 +0,0 @@-module Expr.Sections where
-
-x = (1+)
-y = (+1)
− examples/Expr/SemicolonDo.hs 
@@ -1,7 +0,0 @@-module Expr.SemicolonDo where
-
-import Control.Monad.Identity
-
-a = do { n <- Identity ()
-            ; return ()
-            }
− examples/Expr/StaticPtr.hs 
@@ -1,16 +0,0 @@-{-# LANGUAGE StaticPointers #-}
-module Expr.StaticPtr where
-
-import GHC.StaticPtr
-
-inc :: Int -> Int
-inc x = x + 1
-
-ref1, ref3, ref4 :: StaticPtr Int
-ref2 :: StaticPtr (Int -> Int)
-ref5 :: Int -> StaticPtr Int
-ref1 = static 1
-ref2 = static inc
-ref3 = static (inc 1)
-ref4 = static ((\x -> x + 1) (1 :: Int))
-ref5 y = static (let x = 1 in x)
− examples/Expr/TupleSections.hs 
@@ -1,7 +0,0 @@-{-# LANGUAGE TupleSections #-}
-module Expr.TupleSections where
-
-f1 = (1,,)
-f2 = (,1)
-
-x = (,("x", []))
− examples/Expr/UnboxedSum.hs 
@@ -1,13 +0,0 @@-{-# LANGUAGE UnboxedSums #-}
-module Expr.UnboxedSum where
-
-f = ()
-  where
-    expr :: (# Int | Bool #)
-    expr = (# | True #)
-
-    expr2 :: (# Int | Bool #)
-    expr2 = (# 3 | #)
-
-    expr3 :: (# Int | String | Bool #)
-    expr3 = (# | "aaa" | #)
− examples/Expr/UnicodeSyntax.hs 
@@ -1,7 +0,0 @@-{-# LANGUAGE UnicodeSyntax #-}
-module Expr.UnicodeSyntax where
-    
-import Data.List.Unicode ((∪))
-
-main ∷ IO ()
-main = print $ [1, 2, 3] ∪ [1, 3, 5]
− examples/InstanceControl/Control/Instances/Morph.hs 
@@ -1,149 +0,0 @@-{-# LANGUAGE TypeFamilies, DataKinds, TypeOperators, MultiParamTypeClasses, FlexibleInstances, PolyKinds, UndecidableInstances, AllowAmbiguousTypes, RankNTypes, ScopedTypeVariables, FlexibleContexts #-}
-
-module Control.Instances.Morph (GenMorph(..), Morph(..)) where
-
-import Control.Instances.ShortestPath
-
-import Control.Monad.Identity
-import Control.Monad.Trans.Maybe
-import Control.Monad.Trans.List
-import Control.Monad.State
-import Data.Maybe
-import Data.Proxy
-import GHC.TypeLits
-import Control.Instances.TypeLevelPrelude
-
--- | States that 'm1' can be represented with 'm2'.
--- That is because 'm2' contains more infromation than 'm1'.
---
--- The 'MMorph' relation defines a natural transformation from 'm1' to 'm2'
--- that keeps the following laws:
---
--- > morph (return x)  =  return x
--- > morph (m >>= f)   =  morph m >>= morph . f
--- 
--- It is a reflexive and transitive relation.
---
-class Morph (m1 :: * -> *) (m2 :: * -> *) where
-  -- | Lifts the first monad into the second.
-  morph :: m1 a -> m2 a
-  
-instance GenMorph DB m1 m2 => Morph m1 m2 where
-  morph = genMorph db
-  
--- | A generalized version of 'Morph'. Can work on different
--- rulesets, so this should be used if the ruleset is to be extended.
-class GenMorph db (m1 :: * -> *) (m2 :: * -> *) where
-  -- | Lifts the first monad into the second.
-  genMorph :: db -> m1 a -> m2 a
-  
-instance ( fl ~ (TransformPath (PathFromList (ShortestPath (ToMorphRepo DB) x y)))
-         , CorrectPath x y fl
-         , GeneratableMorph DB fl
-         , Morph' fl x y
-         ) => GenMorph DB x y where
-  genMorph db = repr (generateMorph db :: fl)
-  
-class Morph' fl x y where
-  repr :: fl -> x a -> y a
-  
-instance Morph' r y z => Morph' (ConnectMorph x y :+: r) x z where
-  repr (ConnectMorph m :+: r) = repr r . m
- 
-instance (Morph' r m x, Monad m) => Morph' (IdentityMorph m :+: r) Identity x where
-  repr (IdentityMorph :+: r) = (repr r :: forall a . m a -> x a) . return . runIdentity
-  
-instance Morph' (MUMorph m :+: r) m Proxy where
-  repr (MUMorph :+: _) = const Proxy
- 
-instance Morph' NoMorph x x where
-  repr fl = id
-  
-infixr 6 :+:
-data a :+: r = a :+: r 
-
-data NoMorph = NoMorph
-  
-type family ToMorphRepo db where
-  ToMorphRepo (cm :+: r) = TranslateConn cm ': ToMorphRepo r
-  ToMorphRepo NoMorph = '[]
-   
-type DB = ConnectMorph_2m Maybe MaybeT
-           :+: ConnectMorph_mt MaybeT 
-           :+: ConnectMorph Maybe [] 
-           :+: ConnectMorph_2m [] ListT
-           :+: ConnectMorph (MaybeT IO) (ListT IO)
-           :+: NoMorph
- 
-db :: DB 
-db = ConnectMorph_2m (MaybeT . return) 
-       :+: ConnectMorph_mt (MaybeT . liftM Just) 
-       :+: ConnectMorph (maybeToList) 
-       :+: ConnectMorph_2m (ListT . return) 
-       :+: ConnectMorph (ListT . liftM maybeToList . runMaybeT) 
-       :+: NoMorph
-  
--- | This class provides a way to construct the value-level transformations
--- from the type-level path and a rulebase.
-class GeneratableMorph db ch where
-  generateMorph :: db -> ch
-    
-instance GeneratableMorph db NoMorph where
-  generateMorph _ = NoMorph
-  
-instance GeneratableMorph db r 
-      => GeneratableMorph db ((IdentityMorph m) :+: r) where
-  generateMorph db = IdentityMorph :+: generateMorph db
-  
-instance GeneratableMorph db r 
-      => GeneratableMorph db (MUMorph m :+: r) where
-  generateMorph db = MUMorph :+: generateMorph db
-  
-instance (HasMorph db (ConnectMorph a b), GeneratableMorph db r) 
-      => GeneratableMorph db (ConnectMorph a b :+: r) where
-  generateMorph db = getMorph db :+: generateMorph db
-  
--- | This class extracts a given morph from the set of rules
-class HasMorph r m where 
-  getMorph :: r -> m
-instance {-# OVERLAPPING #-} Monad k => HasMorph (ConnectMorph_2m a b :+: r) (ConnectMorph a (b k)) where
-  getMorph (ConnectMorph_2m f :+: r) = ConnectMorph f
-instance {-# OVERLAPPING #-} Monad k => HasMorph (ConnectMorph_mt t :+: r) (ConnectMorph k (t k)) where
-  getMorph (ConnectMorph_mt f :+: r) = ConnectMorph f
-instance {-# OVERLAPS #-} HasMorph r m => HasMorph (c :+: r) m where
-  getMorph (c :+: r) = getMorph r
-instance {-# OVERLAPPABLE #-} HasMorph (m :+: r) m where
-  getMorph (c :+: r) = c
-
--- | Checks if the path is found to provide usable error messages
-class CorrectPath from to path
-
-instance CorrectPath from to (a :+: b)
-instance CorrectPath from to NoMorph
-
-data ConnectMorph m1 m2 = ConnectMorph { fromConnectMorph :: forall a . m1 a -> m2 a }
-data ConnectMorph_2m m1 m2 = ConnectMorph_2m { fromConnectMorph_2m :: forall a k . Monad k => m1 a -> m2 k a }
-data ConnectMorph_mt mt = ConnectMorph_mt { fromConnectMorph_mt :: forall a k . Monad k => k a -> mt k a }
-data IdentityMorph (m :: * -> *) = IdentityMorph
-data MUMorph m = MUMorph
-
--- | Transforms a path element from the generic format to the specific one
-type family TranslateConn m where
-  TranslateConn (ConnectMorph m1 m2) = Connect m1 m2
-  TranslateConn (ConnectMorph_2m m1 m2) = Connect_2m m1 m2
-  TranslateConn (ConnectMorph_mt mt) = Connect_mt mt
-  
--- | Transforms the path from the generic format to the specific one
-type family TransformPath m where
-  TransformPath (Connect m1 m2 :+: r) = ConnectMorph m1 m2 :+: TransformPath r
-  TransformPath (Connect_id m :+: r) = IdentityMorph m :+: TransformPath r
-  TransformPath (Connect_MU m :+: r) = MUMorph m :+: TransformPath r
-  TransformPath NoMorph = NoMorph
-  TransformPath NoPathFound = NoPathFound
-  
-type family PathFromList ls where
-  PathFromList '[] = NoMorph
-  PathFromList '[ NoPathFound ] = NoPathFound
-  PathFromList (c ': ls) = c :+: PathFromList ls
-
-
− examples/InstanceControl/Control/Instances/ShortestPath.hs 
@@ -1,69 +0,0 @@-{-# LANGUAGE TypeFamilies, DataKinds, TypeOperators, MultiParamTypeClasses, FlexibleInstances, PolyKinds, UndecidableInstances, AllowAmbiguousTypes, RankNTypes, ScopedTypeVariables, FlexibleContexts #-}
-
-module Control.Instances.ShortestPath where
-
-import Control.Monad.Identity
-import Control.Monad.Trans.Maybe
-import Control.Monad.Trans.List
-import Control.Monad.State
-import Data.Maybe
-import Data.Proxy
-import GHC.TypeLits
-import Control.Instances.TypeLevelPrelude
-
--- * Generic datatypes to store connections
-  
-data Connect m1 m2
-data Connect_2m m1 m2
-data Connect_mt mt
-data Connect_id m
-data Connect_MU m
-
--- | Marks that there is no legal path between the two types according
--- to the rulebase.
-data NoPathFound
-  
-type family ShortestPath (e :: [*]) (s :: * -> *) (t :: * -> *) :: [*] where
-  ShortestPath e t t = '[]
-  ShortestPath e Identity t = '[ Connect_id t ]
-  ShortestPath e s Proxy = '[ Connect_MU s ]
-  ShortestPath e s t = ShortestPath' e s (InitCurrent e t)
-  
-type family ShortestPath' (e :: [*]) (s :: * -> *) (c :: [[*]]) :: [*] where
-  ShortestPath' e s '[] = '[ NoPathFound ]
-  ShortestPath' e s c = FromMaybe (ShortestPath' e s (ApplyEdges e c c))
-                                  (GetFinished s c) 
-                                  
-                                      
-type family GetFinished s c where
-  GetFinished s ((Connect s b ': p) ': lls) 
-    = Just (Connect s b ': p)
-  GetFinished s (p ': lls) = GetFinished s lls
-  GetFinished s '[] = Nothing
-
-type family InitCurrent (e :: [*]) (t :: * -> *) :: [[*]] where
-  InitCurrent '[] t = '[]
-  InitCurrent (e ': es) t = IfJust (ApplyEdge e t)
-                                   ('[ MonomorphEnd e t ] ': InitCurrent es t) 
-                                   (InitCurrent es t)
-  
-type family ApplyEdges (e :: [*]) (co :: [[*]]) (c :: [[*]]) :: [[*]] where
-  ApplyEdges (e ': es) co ((Connect s b ': p) ': cs) 
-    = AppendJust (IfThenJust (IsJust (ApplyEdge e s)) 
-                                (MonomorphEnd e s ': Connect s b ': p)) 
-                 (ApplyEdges (e ': es) co cs)
-  ApplyEdges (e ': es) co '[] = ApplyEdges es co co
-  ApplyEdges '[] co cr = '[]  
-  
-type family ApplyEdge e t :: Maybe (* -> *) where
-  ApplyEdge (Connect ms mr) mr = Just ms
-  ApplyEdge (Connect_2m ms mt) (mt m) = Just ms
-  ApplyEdge (Connect_mt mt) (mt m) = Just m
-  ApplyEdge e t = Nothing
-
-type family MonomorphEnd c v :: * where
-  MonomorphEnd (Connect_2m m m') v = Connect m v
-  MonomorphEnd (Connect_mt t) (t m) = Connect m (t m)
-  MonomorphEnd c v = c
-
-
− examples/InstanceControl/Control/Instances/Test.hs 
@@ -1,23 +0,0 @@-module Control.Instances.Test where
-
-import Control.Instances.Morph
-
-import Control.Monad.Identity
-import Control.Monad.Trans.Maybe
-import Control.Monad.Trans.List
-import Control.Monad.State
-
-test1 :: Identity a -> IO a
-test1 = morph
-
-test2 :: Maybe a -> [a]
-test2 = morph
-
-test3 :: Maybe a -> ListT IO a
-test3 = morph
-
-test4 :: Maybe a -> MaybeT IO a
-test4 = morph
-
-test5 :: Monad m => Maybe a -> ListT (StateT s m) a
-test5 = morph
− examples/InstanceControl/Control/Instances/TypeLevelPrelude.hs 
@@ -1,88 +0,0 @@-{-# LANGUAGE TypeFamilies, DataKinds, TypeOperators, MultiParamTypeClasses, FlexibleInstances, PolyKinds, UndecidableInstances, AllowAmbiguousTypes, RankNTypes, ScopedTypeVariables, FlexibleContexts #-}
-
-module Control.Instances.TypeLevelPrelude where
-
-import GHC.TypeLits
-
-type family Const a b where
-  Const a b = a
-  
-type family Seq a b where
-  Seq a b = b
-  
-type family LazyIfThenElse p a b where
-  LazyIfThenElse True a b = a
-  LazyIfThenElse False a b = b
-  
-type family Iterate a where
-  Iterate a = a ': Iterate a
-
-type family l1 :++: l2 where
-  '[] :++: l2       = l2
-  (e ': r1) :++: l2 = e ': (r1 :++: l2)
-  
-type family Elem e ls where
-  Elem e '[] = False
-  Elem e (e ': ls) = True
-  Elem e (x ': ls) = Elem e ls
-  
-type family IfThenElse (b :: Bool) (th :: x) (el :: x) :: x where
-  IfThenElse True  th el = th
-  IfThenElse False th el = el
-         
-type family Length ls :: Nat where
-  Length '[] = 0
-  Length (e ': ls) = 1 + Length ls
-           
-type family Head (ls :: [k]) :: k where
-  Head (e ': ls) = e   
-  
-type family HeadMaybe (ls :: [k]) :: Maybe k where
-  HeadMaybe (e ': ls) = Just e
-  HeadMaybe '[] = Nothing
-  
-type family FromMaybe d m where
-  FromMaybe d (Just x) = x
-  FromMaybe d Nothing = d
-  
-type family Same a b where
-  Same a a = True
-  Same a b = False
-  
-type family Null (ls :: [k]) :: Bool where
-  Null '[] = True
-  Null ls = False
-           
-type family MapAppend e lls where
-  MapAppend e (ls ': lls) = (e ': ls) ': MapAppend e lls
-  MapAppend e '[] = '[]
-  
-type family AppendJust m ls where
-  AppendJust (Just x) ls = x ': ls
-  AppendJust Nothing ls = ls
-  
-type family Revert ls where
-  Revert '[] = '[]
-  Revert (e ': ls) = Revert ls :++: '[ e ]
-  
-type family IfThenJust (p :: Bool) (v :: k) :: Maybe k where
-  IfThenJust True v = Just v
-  IfThenJust False v = Nothing  
-  
-type family IfJust (p :: Maybe k) (t :: kr) (e :: kr) :: kr where
-  IfJust (Just x) t e = t
-  IfJust Nothing t e = e
-  
-type family IsJust (p :: Maybe k) :: Bool where
-  IsJust (Just x) = True
-  IsJust Nothing = False    
-  
-type family FromJust (p :: Maybe k) :: k where
-  FromJust (Just x) = x
-  
-type family Cat (f2 :: k2 -> k3) (f1 :: k1 -> k2) (a :: k1) :: k3 where
-  Cat f2 f1 a = f2 (f1 a)
-  
-
-  
-
− examples/Module/DeprecatedPragma.hs 
@@ -1,1 +0,0 @@-module Module.DeprecatedPragma {-# DEPRECATED "this module is deprecated" #-} where
− examples/Module/Export.hs 
@@ -1,2 +0,0 @@-module Module.Export (maybe, Maybe(..), Either(Left)) where
--- this module reexports Maybe from Prelude
− examples/Module/ExportModifiers.hs 
@@ -1,4 +0,0 @@-{-# LANGUAGE ExplicitNamespaces, PatternSynonyms #-}
-module Module.ExportModifiers (type Maybe, pattern Maybe) where
-
-pattern Maybe = 42
− examples/Module/ExportSubs.hs 
@@ -1,3 +0,0 @@-module Module.ExportSubs (T(Cons, name)) where
-
-data T = Cons { name :: String }
− examples/Module/GhcOptionsPragma.hs 
@@ -1,2 +0,0 @@-{-# OPTIONS_GHC -Wno-name-shadowing #-}
-module Module.GhcOptionsPragma where
− examples/Module/Import.hs 
@@ -1,11 +0,0 @@-{-# LANGUAGE PackageImports, Safe #-}
-module Module.Import where
-
-import Data.List
-import "base" Data.List
-import {-# SOURCE #-} Data.List
-import qualified Data.List
-import Data.List as List
-import Data.List(map,(++))
-import Data.Function hiding ((&))
-import safe Control.Monad.Writer hiding (Alt, Writer())
− examples/Module/ImportOp.hs 
@@ -1,3 +0,0 @@-module Module.ImportOp where
-
-import Module.Imported ((:-)(..))
− examples/Module/Imported.hs 
@@ -1,6 +0,0 @@-{-# LANGUAGE TypeOperators #-}
-module Module.Imported where
-
-infixr 8 :-
--- | A stack datatype. Just a better looking tuple.
-data a :- b = a :- b deriving (Eq, Show)
− examples/Module/LangPragmas.hs 
@@ -1,4 +0,0 @@-{-# LANGUAGE LambdaCase #-}
-{-#LANGUAGE LambdaCase #-}
-{-# LANGUAGE LambdaCase#-}
-module Module.LangPragmas where
− examples/Module/NamespaceExport.hs 
@@ -1,4 +0,0 @@-{-# LANGUAGE TypeOperators #-}
-module Module.NamespaceExport (type (++)) where
-
-data a ++ b = Ctor
− examples/Module/PatternImport.hs 
@@ -1,4 +0,0 @@-{-# LANGUAGE PatternSynonyms #-}
-module Module.PatternImport where
-
-import Decl.PatternSynonym (pattern Arrow)
− examples/Module/Simple.hs 
@@ -1,1 +0,0 @@-module Module.Simple where
− examples/Module/WarningPragma.hs 
@@ -1,1 +0,0 @@-module Module.WarningPragma {-# WARNING "this module is dangerous" #-} where
− examples/Pattern/Backtick.hs 
@@ -1,5 +0,0 @@-module Pattern.Backtick where
-
-data Point = Point { x :: Prelude.Int, y :: Int }
-
-f (x `Point` y) = 0
− examples/Pattern/Constructor.hs 
@@ -1,3 +0,0 @@-module Pattern.Constructor where
-
-Just x = Just 1
− examples/Pattern/ImplicitParams.hs 
@@ -1,9 +0,0 @@-{-# LANGUAGE ImplicitParams #-}
-module Pattern.ImplicitParams where
-
-import Data.List (sortBy)
-
-sort :: (?cmp :: a -> a -> Ordering) => [a] -> [a]
-sort = sortBy ?cmp
-
-main = let ?cmp = compare in putStrLn (show (sort [3,1,2]))
− examples/Pattern/Infix.hs 
@@ -1,5 +0,0 @@-module Pattern.Infix where
-
---(a:b:c:d) = ["1","2","3","4"]
-
-Nothing:_ = undefined
− examples/Pattern/NPlusK.hs 
@@ -1,6 +0,0 @@-{-# LANGUAGE NPlusKPatterns #-}
-module Pattern.NPlusK where
-
-factorial :: Integer -> Integer
-factorial 0 = 1
-factorial (n+1) = (*) (n+1) (factorial n)
− examples/Pattern/NestedWildcard.hs 
@@ -1,7 +0,0 @@-{-# LANGUAGE NamedFieldPuns, RecordWildCards #-}
-module Pattern.NestedWildcard where
-
-data A = A { b :: B, ai :: Int }
-data B = B { bi :: Int }
-
-h A { b = B {..}, .. } = bi + ai
− examples/Pattern/OperatorPattern.hs 
@@ -1,3 +0,0 @@-module Pattern.OperatorPattern where
-
-child r (_:ps) = r ps
− examples/Pattern/Record.hs 
@@ -1,11 +0,0 @@-{-# LANGUAGE NamedFieldPuns, RecordWildCards #-}
-module Pattern.Record where
-
-data Point = Point { x :: Int, y :: Int }
-
-f Point { x = 3, y = 1 } = 0
-f Point {} = 1
-
-g Point { x } = x
-
-h Point { x = 1, .. } = y
− examples/Pattern/UnboxedSum.hs 
@@ -1,6 +0,0 @@-{-# LANGUAGE UnboxedSums #-}
-module Pattern.UnboxedSum where
-
-f :: (# Int | Bool #) -> ()
-f (# i | #) = ()
-f (# | b #) = ()
+ examples/Refactor/AutoCorrect/ComplexExprReOrder.hs view
@@ -0,0 +1,9 @@+module Refactor.AutoCorrect.ComplexExprReOrder where
+
+x = f (B 1 2) (A "A")
+
+f :: A -> B -> ()
+f _ _ = ()
+
+data A = A String
+data B = B Int Int
+ examples/Refactor/AutoCorrect/ComplexExprReOrder2.hs view
@@ -0,0 +1,11 @@+module Refactor.AutoCorrect.ComplexExprReOrder2 where
+
+x = f (b { b1 = 0 }) (A { a = "fdf" })
+
+b = B 1 2
+
+f :: A -> B -> ()
+f _ _ = ()
+
+data A = A { a :: String }
+data B = B { b1 :: Int, b2 :: Int }
+ examples/Refactor/AutoCorrect/ComplexExprReOrder2_res.hs view
@@ -0,0 +1,11 @@+module Refactor.AutoCorrect.ComplexExprReOrder2 where
+
+x = f (A { a = "fdf" }) (b { b1 = 0 })
+
+b = B 1 2
+
+f :: A -> B -> ()
+f _ _ = ()
+
+data A = A { a :: String }
+data B = B { b1 :: Int, b2 :: Int }
+ examples/Refactor/AutoCorrect/ComplexExprReOrder_res.hs view
@@ -0,0 +1,9 @@+module Refactor.AutoCorrect.ComplexExprReOrder where
+
+x = f (A "A") (B 1 2)
+
+f :: A -> B -> ()
+f _ _ = ()
+
+data A = A String
+data B = B Int Int
+ examples/Refactor/AutoCorrect/ComplexExprReParen.hs view
@@ -0,0 +1,6 @@+module Refactor.AutoCorrect.ComplexExprReParen where
+
+x = f f (show ())
+
+f :: String -> String
+f = id
+ examples/Refactor/AutoCorrect/ComplexExprReParen_res.hs view
@@ -0,0 +1,6 @@+module Refactor.AutoCorrect.ComplexExprReParen where
+
+x = (f (f (show ())))
+
+f :: String -> String
+f = id
+ examples/Refactor/AutoCorrect/ExternalInstanceReOrder.hs view
@@ -0,0 +1,9 @@+module Refactor.AutoCorrect.ExternalInstanceReOrder where
+
+x = f 3 ()
+
+f :: (Show a, Num b) => a -> b -> ()
+f _ _ = ()
+
+a :: Integer
+a = 3
+ examples/Refactor/AutoCorrect/ExternalInstanceReOrder_res.hs view
@@ -0,0 +1,9 @@+module Refactor.AutoCorrect.ExternalInstanceReOrder where
+
+x = f () 3
+
+f :: (Show a, Num b) => a -> b -> ()
+f _ _ = ()
+
+a :: Integer
+a = 3
+ examples/Refactor/AutoCorrect/ExternalInstanceReParen.hs view
@@ -0,0 +1,4 @@+module Refactor.AutoCorrect.ExternalInstanceReParen where
+
+-- The only reason why ((show 1) + 2) is not a good result is that there are no Num instance for String
+x = show 1 + 2
+ examples/Refactor/AutoCorrect/ExternalInstanceReParen_res.hs view
@@ -0,0 +1,4 @@+module Refactor.AutoCorrect.ExternalInstanceReParen where
+
+-- The only reason why ((show 1) + 2) is not a good result is that there are no Num instance for String
+x = (show (1 + 2))
+ examples/Refactor/AutoCorrect/Instance.hs view
@@ -0,0 +1,4 @@+module Refactor.AutoCorrect.Instance where
+
+data A = A deriving Show
+data B = B
+ examples/Refactor/AutoCorrect/OwnInstanceReOrder.hs view
@@ -0,0 +1,9 @@+module Refactor.AutoCorrect.OwnInstanceReOrder where
+
+import Refactor.AutoCorrect.Instance
+
+x = f B A
+
+f :: Show a => a -> b -> ()
+f _ _ = ()
+
+ examples/Refactor/AutoCorrect/OwnInstanceReOrder_res.hs view
@@ -0,0 +1,9 @@+module Refactor.AutoCorrect.OwnInstanceReOrder where
+
+import Refactor.AutoCorrect.Instance
+
+x = f A B
+
+f :: Show a => a -> b -> ()
+f _ _ = ()
+
+ examples/Refactor/AutoCorrect/SectionReOrder.hs view
@@ -0,0 +1,3 @@+module Refactor.AutoCorrect.SectionReOrder where
+
+x = "x" $ (++"y")
+ examples/Refactor/AutoCorrect/SectionReOrder_res.hs view
@@ -0,0 +1,3 @@+module Refactor.AutoCorrect.SectionReOrder where
+
+x = (++"y") $ "x"
+ examples/Refactor/AutoCorrect/SimpleReOrder.hs view
@@ -0,0 +1,9 @@+module Refactor.AutoCorrect.SimpleReOrder where
+
+x = f B A
+
+f :: A -> B -> ()
+f _ _ = ()
+
+data A = A
+data B = B
+ examples/Refactor/AutoCorrect/SimpleReOrder_res.hs view
@@ -0,0 +1,9 @@+module Refactor.AutoCorrect.SimpleReOrder where
+
+x = f A B
+
+f :: A -> B -> ()
+f _ _ = ()
+
+data A = A
+data B = B
+ examples/Refactor/AutoCorrect/SimpleReParen.hs view
@@ -0,0 +1,6 @@+module Refactor.AutoCorrect.SimpleReParen where
+
+x = f f "a"
+
+f :: String -> String
+f = id
+ examples/Refactor/AutoCorrect/SimpleReParen_res.hs view
@@ -0,0 +1,6 @@+module Refactor.AutoCorrect.SimpleReParen where
+
+x = (f (f "a"))
+
+f :: String -> String
+f = id
+ examples/Refactor/AutoCorrect/ThreeArgFirstReOrder.hs view
@@ -0,0 +1,9 @@+module Refactor.AutoCorrect.ThreeArgFirstReOrder where
+
+x = f B A B
+
+f :: A -> B -> B -> ()
+f _ _ _ = ()
+
+data A = A
+data B = B
+ examples/Refactor/AutoCorrect/ThreeArgFirstReOrder_res.hs view
@@ -0,0 +1,9 @@+module Refactor.AutoCorrect.ThreeArgFirstReOrder where
+
+x = f A B B
+
+f :: A -> B -> B -> ()
+f _ _ _ = ()
+
+data A = A
+data B = B
+ examples/Refactor/AutoCorrect/ThreeArgReOrder.hs view
@@ -0,0 +1,9 @@+module Refactor.AutoCorrect.ThreeArgReOrder where
+
+x = f B A B
+
+f :: B -> B -> A -> ()
+f _ _ _ = ()
+
+data A = A
+data B = B
+ examples/Refactor/AutoCorrect/ThreeArgReOrder_res.hs view
@@ -0,0 +1,9 @@+module Refactor.AutoCorrect.ThreeArgReOrder where
+
+x = f B B A
+
+f :: B -> B -> A -> ()
+f _ _ _ = ()
+
+data A = A
+data B = B
+ examples/Refactor/AutoCorrect/TupleSectionReOrder.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE TupleSections #-}
+module Refactor.AutoCorrect.TupleSectionReOrder where
+
+x = "x" $ (,3)
+ examples/Refactor/AutoCorrect/TupleSectionReOrder_res.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE TupleSections #-}
+module Refactor.AutoCorrect.TupleSectionReOrder where
+
+x = (,3) $ "x"
− examples/Refactor/CommentHandling/BlockComments.hs 
@@ -1,10 +0,0 @@-module Refactor.CommentHandling.BlockComments where
-
-{-| 1 -}
-{- 2 -}
-import Control.Monad {- 3 -}
-{-^ 4 -}
-{-| 5 -}
-{- 6 -}
-import Control.Monad as Monad {- 7 -}
-{-^ 8 -}
− examples/Refactor/CommentHandling/CommentTypes.hs 
@@ -1,10 +0,0 @@-module Refactor.CommentHandling.CommentTypes where
-
--- | 1
--- 2
-import Control.Monad -- 3
--- ^ 4
--- | 5
--- 6
-import Control.Monad as Monad -- 7
--- ^ 8
− examples/Refactor/CommentHandling/Crosslinking.hs 
@@ -1,6 +0,0 @@-module Refactor.CommentHandling.Crosslinking where
-
-import Control.Monad
--- | forward
--- ^ back
-import Control.Monad as Monad
− examples/Refactor/CommentHandling/FunctionArgs.hs 
@@ -1,6 +0,0 @@-module Refactor.CommentHandling.FunctionArgs where
-
-f :: Int -- something
-  -> {-| result -} Int
-  -> Int  -- ^ other thing
-f = undefined
examples/Refactor/OrganizeImports/Class.hs view
@@ -1,6 +1,6 @@ module Refactor.OrganizeImports.Class where
 
-import Decl.TypeClass (C(f))
-import Decl.TypeInstance
+import Refactor.OrganizeImports.TypeClass (C(f))
+import Refactor.OrganizeImports.TypeInstance
 
 test = f A
examples/Refactor/OrganizeImports/Class_res.hs view
@@ -1,6 +1,6 @@ module Refactor.OrganizeImports.Class where
 
-import Decl.TypeClass (C(f))
-import Decl.TypeInstance (A(..))
+import Refactor.OrganizeImports.TypeClass (C(f))
+import Refactor.OrganizeImports.TypeInstance (A(..))
 
 test = f A
+ examples/Refactor/OrganizeImports/InstanceCarry/Duplicate.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE NoImplicitPrelude #-}
+module Refactor.OrganizeImports.InstanceCarry.Duplicate where
+
+import Data.List ()
+import Data.List ()
+ examples/Refactor/OrganizeImports/InstanceCarry/Duplicate_res.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE NoImplicitPrelude #-}
+module Refactor.OrganizeImports.InstanceCarry.Duplicate where
+
+import Data.List ()
+ examples/Refactor/OrganizeImports/InstanceCarry/Transitive.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE NoImplicitPrelude #-}
+module Refactor.OrganizeImports.InstanceCarry.Transitive where
+
+import Data.List ()
+import Data.Foldable ()
+ examples/Refactor/OrganizeImports/InstanceCarry/Transitive_res.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE NoImplicitPrelude #-}
+module Refactor.OrganizeImports.InstanceCarry.Transitive where
+
+import Data.List ()
+ examples/Refactor/OrganizeImports/TypeClass.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE TypeFamilies #-}
+module Refactor.OrganizeImports.TypeClass where
+
+class EmptyClass a
+
+class Show a => C a where
+  type X a :: *
+  type X a = Int
+  data Q a :: *
+  
+  f :: a -> String
+  f = show
+
+ examples/Refactor/OrganizeImports/TypeInstance.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE TypeFamilies, InstanceSigs #-}
+module Refactor.OrganizeImports.TypeInstance where
+
+import Refactor.OrganizeImports.TypeClass
+
+data A = A deriving Show
+
+instance C A where
+  type X A = Int
+  data Q A = Bool
+
+  f :: A -> String
+  f A = "XXX"
+
+ examples/Refactor/RenameDefinition/ThHelper.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.ThHelper where
+
+import Language.Haskell.TH
+
+nameOf :: Name -> Q [Dec]
+nameOf n = return []
examples/Refactor/RenameDefinition/TypeBracket.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE TemplateHaskell #-}
 module Refactor.RenameDefinition.TypeBracket where
 
-import TH.Splice.Define
+import Refactor.RenameDefinition.ThHelper
 
 data A = A
examples/Refactor/RenameDefinition/TypeBracket_res.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE TemplateHaskell #-}
 module Refactor.RenameDefinition.TypeBracket where
 
-import TH.Splice.Define
+import Refactor.RenameDefinition.ThHelper
 
 data B = A
examples/Refactor/RenameDefinition/ValBracket.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE TemplateHaskell #-}
 module Refactor.RenameDefinition.ValBracket where
 
-import TH.Splice.Define
+import Refactor.RenameDefinition.ThHelper
 
 data A = A
examples/Refactor/RenameDefinition/ValBracket_res.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE TemplateHaskell #-}
 module Refactor.RenameDefinition.ValBracket where
 
-import TH.Splice.Define
+import Refactor.RenameDefinition.ThHelper
 
 data A = B
− examples/TH/Brackets.hs 
@@ -1,19 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}
-module TH.Brackets where
-
-import Language.Haskell.TH
-
-decls :: Q [Dec]
-decls = [d| w = 3 |]
-
-exp :: Q Exp
-exp = [| 3 |]
-
-exp' :: Q Exp
-exp' = [e| 3 |]
-
-pat :: Q Pat
-pat = [p| x |]
-
-typ :: Q Type
-typ = [t| Int |]
− examples/TH/ClassUse.hs 
@@ -1,10 +0,0 @@-{-# LANGUAGE TemplateHaskell, FlexibleInstances #-}
-module TH.ClassUse where
-
-class C a where
-  f :: a -> a
-
-$([d|
-    instance C a where
-     f = id
- |])
− examples/TH/CrossDef.hs 
@@ -1,4 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}
-module TH.CrossDef where
-
-$([d| x = 3 |])
− examples/TH/DoubleSplice.hs 
@@ -1,4 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}
-module TH.DoubleSplice where
-
-$($(id [| return [] |]))
− examples/TH/GADTFields.hs 
@@ -1,7 +0,0 @@-{-# LANGUAGE GADTs, KindSignatures, TypeFamilies, TemplateHaskell #-}
-module TH.GADTFields where
-
-data Gadtrec1 a where
-  Gadtrecc1, Gadtrecc2 :: { gadtrec1a :: a, gadtrec1b :: b } -> Gadtrec1 (a,b)
-
-$( let a = ['gadtrec1a, 'gadtrec1b] in return [] )
− examples/TH/LocalDefinition.hs 
@@ -1,19 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}
-module TH.LocalDefinition where
-
-import Language.Haskell.TH
-
-decls :: Q [Dec]
-decls = [d| w = 3 |]
-
-exp :: Q Exp
-exp = [| 3 |]
-
-exp' :: Q Exp
-exp' = [e| 3 |]
-
-pat :: Q Pat
-pat = [p| x |]
-
-typ :: Q Type
-typ = [t| Int |]
− examples/TH/MultiImport.hs 
@@ -1,7 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}
-module TH.MultiImport where
-
-import Prelude (last,return)
-import qualified Data.Text (last)
-
-$(let f = last in return [])
− examples/TH/NestedSplices.hs 
@@ -1,6 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}
-module TH.NestedSplices where
-
-import Language.Haskell.TH
-
-f = [t| $(parensT [t| $(return ListT) |]) |]
− examples/TH/QuasiQuote/Define.hs 
@@ -1,8 +0,0 @@-{-# OPTIONS_GHC -fno-warn-missing-fields #-}
-module TH.QuasiQuote.Define where
-
-import Language.Haskell.TH.Quote
-import Language.Haskell.TH
-
-expr :: QuasiQuoter
-expr = QuasiQuoter { quoteExp = const (return $ VarE $ mkName "hello") }
− examples/TH/QuasiQuote/Use.hs 
@@ -1,11 +0,0 @@-{-# OPTIONS_GHC -fno-warn-missing-fields #-}
-{-# LANGUAGE QuasiQuotes #-}
-module TH.QuasiQuote.Use where
-
-import TH.QuasiQuote.Define
-
-hello :: Int
-hello = 3
-
-main :: IO ()
-main = print [expr| 1 + 2 + 4|]
− examples/TH/Quoted.hs 
@@ -1,6 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}
-module TH.Quoted where
-
-import qualified Text.Read.Lex (Lexeme)
-
-$(let x = ''Text.Read.Lex.Lexeme in return [])
− examples/TH/Splice/Define.hs 
@@ -1,24 +0,0 @@-module TH.Splice.Define where
-
-import Language.Haskell.TH
-
-def :: String -> Q [Dec]
-def name = return [ ValD (VarP (mkName name)) (NormalB $ LitE $ IntegerL 3) [] ]
-
-defHello :: Q [Dec]
-defHello = def "hello"
-
-defHello2 :: Q [Dec]
-defHello2 = def "hello2"
-
-defHello3 :: Q [Dec]
-defHello3 = def "hello3"
-
-expr :: Q Exp
-expr = return $ LitE $ IntegerL 3
-
-typ :: Q Type
-typ = return $ TupleT 0
-
-nameOf :: Name -> Q [Dec]
-nameOf n = return []
− examples/TH/Splice/Names.hs 
@@ -1,12 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}
-module TH.Splice.Names where
-
-import TH.Splice.Define
-
-data A = A
-
-$(nameOf ''A)
-nameOf ''A
-
-$(nameOf 'A)
-nameOf 'A
− examples/TH/Splice/Use.hs 
@@ -1,22 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}
-module TH.Splice.Use where
-
-import TH.Splice.Define
-
-$(return [])
-
-$(let x = return [] in x)
-
-$(def "x")
-
-$(defHello)
-
-$defHello2
-
-defHello3
-
-a :: $typ
-a = ()
-
-e :: Int
-e = $expr
− examples/TH/Splice/UseImported.hs 
@@ -1,9 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}
-module TH.Splice.UseImported where
-
-data T a = T a
-
-$([d|
-  instance Show a => Show (T a) where show = undefined
-  instance (Eq a, Show a) => Eq (T a) where (==) = undefined
-  |])
− examples/TH/Splice/UseQual.hs 
@@ -1,6 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}
-module TH.Splice.UseQual where
-
-import qualified TH.Splice.Define as Def
-
-$(Def.def "x")
− examples/TH/Splice/UseQualMulti.hs 
@@ -1,8 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}
-module TH.Splice.UseQualMulti where
-
-import qualified TH.Splice.Define as Def
-import qualified TH.Splice.Define as Def2
-
-$(Def.def "x")
-$(Def2.def "y")
− examples/TH/WithWildcards.hs 
@@ -1,8 +0,0 @@-{-# LANGUAGE TemplateHaskell, RecordWildCards #-}
-module TH.WithWildcards where
-
-import Language.Haskell.TH.Syntax
-
-data A = A { x :: Q Exp }
-
-g A{..} = [| $(x) |]
− examples/Type/Bang.hs 
@@ -1,4 +0,0 @@-module Type.Bang where
-
-data X = X !Int
-
− examples/Type/Builtin.hs 
@@ -1,20 +0,0 @@-{-# LANGUAGE MagicHash #-}
-module Type.Builtin where
-
-import GHC.Prim 
-import GHC.Base
-
-x1 :: IO ()
-x1 = undefined
-
-x2 :: IO Int
-x2 = return 2
-
-x3 :: Int
-x3 = I# x3'
-  where x3' :: Int#
-        x3' = 3#
-
-x4 :: (Int, Bool)
-x4 = (3,True)
-
− examples/Type/Ctx.hs 
@@ -1,10 +0,0 @@-module Type.Ctx where
-
-sh :: Show a => a -> String
-sh = show
-
-sh' :: (Show a) => a -> String
-sh' = show
-
-sh'' :: (Show a, Eq a) => a -> String
-sh'' = show
− examples/Type/ExplicitTypeApplication.hs 
@@ -1,7 +0,0 @@-{-# LANGUAGE TypeApplications #-}
-module Type.ExplicitTypeApplication where
-
-quad :: a -> b -> c -> d -> (a, b, c, d)
-quad w x y z = (w, x, y, z)
-
-foo = quad @Bool @_ @Int False 'c' 17 "Hello!"
− examples/Type/Forall.hs 
@@ -1,11 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}
-module Type.Forall where
-
-id :: forall a . a -> a
-id x = x
-
-id' :: a -> a
-id' x = x
-
-id'' :: forall a . Monoid a => a -> a
-id'' x = x
− examples/Type/Primitives.hs 
@@ -1,10 +0,0 @@-{-# LANGUAGE MagicHash #-}
-module Type.Primitives where
-import GHC.Prim
-
-data MyInt = MyInt Int#
-
-my3 = MyInt 3#
-
-myPlus :: MyInt -> MyInt -> MyInt
-myPlus (MyInt i) (MyInt j) = MyInt (i +# j)
− examples/Type/TupleAssert.hs 
@@ -1,5 +0,0 @@-{-# LANGUAGE ConstraintKinds #-}
-module Type.TupleAssert where
-
-f :: (Ord a, (Show a, Eq a)) => a -> String
-f = show
− examples/Type/TypeOperators.hs 
@@ -1,10 +0,0 @@-{-# LANGUAGE TypeOperators #-}
-module Type.TypeOperators where
-
-infixr 6 :+:
-data a :+: r = a :+: r 
-
-type X = Int :+: Char :+: String
-
-type (:&:) = (,)
-infixr :&:
− examples/Type/Unpack.hs 
@@ -1,4 +0,0 @@-module Type.Unpack where
-
-data X = X {-# UNPACK #-} !Int {-# NOUNPACK #-} !Int 
-
− examples/Type/Wildcard.hs 
@@ -1,7 +0,0 @@-{-# OPTIONS_GHC -fno-warn-partial-type-signatures #-}
-{-# LANGUAGE PartialTypeSignatures #-}
-module Type.Wildcard where
-
-not' :: Bool -> _
-not' x = not x
--- Inferred: Bool -> Bool
haskell-tools-builtin-refactorings.cabal view
@@ -1,5 +1,5 @@ name:                haskell-tools-builtin-refactorings
-version:             1.0.0.4
+version:             1.0.1.1
 synopsis:            Refactoring Tool for Haskell
 description:         Contains a set of refactorings based on the Haskell-Tools framework to easily transform a Haskell program. For the descriptions of the implemented refactorings, see the homepage.
 homepage:            https://github.com/haskell-tools/haskell-tools
@@ -12,16 +12,8 @@ cabal-version:       >=1.10
 
 extra-source-files: examples/CPP/*.hs
-                  , examples/CppHs/Language/Preprocessor/*.hs
-                  , examples/CppHs/Language/Preprocessor/Cpphs/*.hs
-                  , examples/CppHs/Language/Preprocessor/Cpphs/*.hs
-                  , examples/Decl/*.hs
-                  , examples/Expr/*.hs
-                  , examples/InstanceControl/Control/Instances/*.hs
-                  , examples/Module/*.hs
-                  , examples/Pattern/*.hs
-                  , examples/Refactor/CommentHandling/*.hs
                   , examples/Refactor/ExtractBinding/*.hs
+                  , examples/Refactor/FloatOut/*.hs
                   , examples/Refactor/GenerateExports/*.hs
                   , examples/Refactor/GenerateTypeSignature/*.hs
                   , examples/Refactor/GenerateTypeSignature/BringToScope/*.hs
@@ -41,24 +33,40 @@                   , examples/Refactor/RenameDefinition/SpliceExpr_res/*.hs
                   , examples/Refactor/RenameDefinition/SpliceType/*.hs
                   , examples/Refactor/RenameDefinition/SpliceType_res/*.hs
-                  , examples/Refactor/FloatOut/*.hs
-                  , examples/TH/*.hs
-                  , examples/TH/QuasiQuote/*.hs
-                  , examples/TH/Splice/*.hs
-                  , examples/Type/*.hs
-                  , test/ExtensionOrganizerTest/RecordWildCardsTest/*.hs
-                  , test/ExtensionOrganizerTest/FlexibleInstancesTest/*.hs
-                  , test/ExtensionOrganizerTest/DerivingsTest/*.hs
+                  , examples/Refactor/AutoCorrect/*.hs
+
+                  , test/ExtensionOrganizerTest/ArrowsTest/*.hs
                   , test/ExtensionOrganizerTest/BangPatternsTest/*.hs
-                  , test/ExtensionOrganizerTest/PatternSynonymsTest/*.hs
-                  , test/ExtensionOrganizerTest/ViewPatternsTest/*.hs
+                  , test/ExtensionOrganizerTest/ConstrainedClassMethodsTest/*.hs
+                  , test/ExtensionOrganizerTest/ConstraintKindsTest/*.hs
+                  , test/ExtensionOrganizerTest/DefaultSignaturesTest/*.hs
+                  , test/ExtensionOrganizerTest/DerivingsTest/*.hs
+                  , test/ExtensionOrganizerTest/ExistentialQuantificationTest/*.hs
+                  , test/ExtensionOrganizerTest/ExplicitNamespacesTest/*.hs
+                  , test/ExtensionOrganizerTest/FlexibleInstancesTest/*.hs
+                  , test/ExtensionOrganizerTest/FunctionalDependenciesTest/*.hs
+                  , test/ExtensionOrganizerTest/GADTsTest/*.hs
+                  , test/ExtensionOrganizerTest/KindSignaturesTest/*.hs
                   , test/ExtensionOrganizerTest/LambdaCaseTest/*.hs
+                  , test/ExtensionOrganizerTest/MagicHashTest/Literal/*.hs
+                  , test/ExtensionOrganizerTest/MagicHashTest/Name/*.hs
+                  , test/ExtensionOrganizerTest/MultiParamTypeClassesTest/*.hs
+                  , test/ExtensionOrganizerTest/MultiWayIfTest/*.hs
+                  , test/ExtensionOrganizerTest/OverloadedStringsTest/*.hs
+                  , test/ExtensionOrganizerTest/ParallelListCompTest/*.hs
+                  , test/ExtensionOrganizerTest/PatternSynonymsTest/*.hs
+                  , test/ExtensionOrganizerTest/RecordWildCardsTest/*.hs
+                  , test/ExtensionOrganizerTest/RecursiveDoTest/*.hs
+                  , test/ExtensionOrganizerTest/TemplateHaskellTest/*.hs
                   , test/ExtensionOrganizerTest/TupleSectionsTest/*.hs
-                  --, test/ExtensionOrganizerTest/UnboxedTuplesTest/*.hs
+                  , test/ExtensionOrganizerTest/TypeFamiliesTest/*.hs
+                  , test/ExtensionOrganizerTest/TypeOperatorsTest/*.hs
+                  , test/ExtensionOrganizerTest/ViewPatternsTest/*.hs
 
 library
   ghc-options: -O2
   exposed-modules:     Language.Haskell.Tools.Refactor.Builtin
+                     , Language.Haskell.Tools.Refactor.Builtin.AutoCorrect
                      , Language.Haskell.Tools.Refactor.Builtin.GenerateTypeSignature
                      , Language.Haskell.Tools.Refactor.Builtin.OrganizeImports
                      , Language.Haskell.Tools.Refactor.Builtin.GenerateExports
@@ -66,32 +74,53 @@                      , Language.Haskell.Tools.Refactor.Builtin.ExtractBinding
                      , Language.Haskell.Tools.Refactor.Builtin.InlineBinding
                      , Language.Haskell.Tools.Refactor.Builtin.FloatOut
+                     , Language.Haskell.Tools.Refactor.Builtin.GetMatches
                      , Language.Haskell.Tools.Refactor.Builtin.OrganizeExtensions
-                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers
                      , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMap
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.SupportedExtensions
                      , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.TraverseAST
-
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Instances.Checkable
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Instances.AppSelector
 
-  other-modules:       Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers
+  other-modules:       Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.ArrowsChecker
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.BangPatternsChecker
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.ConstrainedClassMethodsChecker
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.ConstraintKindsChecker
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.DefaultSignaturesChecker
                      , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.DerivingsChecker
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.ExplicitForAllChecker
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.ExplicitNamespacesChecker
                      , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.FlexibleInstancesChecker
-                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.RecordWildCardsChecker
-                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.BangPatternsChecker
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.FunctionalDependenciesChecker
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.GADTsChecker
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.KindSignaturesChecker
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.LambdaCaseChecker
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.MagicHashChecker
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.MultiParamTypeClassesChecker
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.MultiWayIfChecker
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.OverloadedStringsChecker
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.ParallelListCompChecker
                      , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.PatternSynonymsChecker
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.RecordWildCardsChecker
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.RecursiveDoChecker
                      , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.TemplateHaskellChecker
-                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.ViewPatternsChecker
-                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.LambdaCaseChecker
                      , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.TupleSectionsChecker
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.TypeFamiliesChecker
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.TypeOperatorsChecker
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.TypeSynonymInstancesChecker
                      , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.UnboxedTuplesChecker
-                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.MagicHashChecker
-                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Utils.TypeLookup
-                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Utils.SupportedExtensions
-
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.ViewPatternsChecker
+                     , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Utils.Debug
 
 
   build-depends:       base                      >= 4.10  && < 4.11
                      , mtl                       >= 2.2  && < 2.3
+                     , aeson                     >= 1.0 && < 1.4
                      , uniplate                  >= 1.6  && < 1.7
+                     , classyplate               >= 0.3  && < 0.4
+                     , deepseq                   >= 1.4  && < 1.5
                      , ghc-paths                 >= 0.1  && < 0.2
                      , containers                >= 0.5  && < 0.6
                      , directory                 >= 1.2  && < 1.4
@@ -100,8 +129,9 @@                      , split                     >= 0.2  && < 0.3
                      , filepath                  >= 1.4  && < 1.5
                      , template-haskell          >= 2.12 && < 2.13
+                     , minisat-solver            >= 0.1  && < 0.2
                      , ghc                       >= 8.2  && < 8.3
-                     , Cabal                     >= 2.0  && < 2.1
+                     , Cabal                     >= 2.0  && < 2.3
                      , haskell-tools-ast         >= 1.0  && < 1.1
                      , haskell-tools-backend-ghc >= 1.0  && < 1.1
                      , haskell-tools-rewrite     >= 1.0  && < 1.1
@@ -114,9 +144,9 @@   ghc-options:         -with-rtsopts=-M2g
   hs-source-dirs:      test
   main-is:             Main.hs
-  build-depends:       base                      >= 4.10  && < 4.11
+  build-depends:       base                      >= 4.10 && < 4.11
                      , tasty                     >= 0.11 && < 1.1
-                     , tasty-hunit               >= 0.9 && < 0.11
+                     , tasty-hunit               >= 0.9  && < 0.11
                      , transformers              >= 0.5  && < 0.6
                      , either                    >= 4.4  && < 5.1
                      , filepath                  >= 1.4  && < 1.5
@@ -130,16 +160,13 @@                      , template-haskell          >= 2.12 && < 2.13
                      , ghc                       >= 8.2  && < 8.3
                      , ghc-paths                 >= 0.1  && < 0.2
-                     , Cabal                     >= 2.0 && < 2.1
+                     , Cabal                     >= 2.0  && < 2.3
                      , haskell-tools-ast         >= 1.0  && < 1.1
                      , haskell-tools-backend-ghc >= 1.0  && < 1.1
                      , haskell-tools-rewrite     >= 1.0  && < 1.1
                      , haskell-tools-prettyprint >= 1.0  && < 1.1
                      , haskell-tools-refactor    >= 1.0  && < 1.1
                      , haskell-tools-builtin-refactorings
-                     -- libraries used by the examples
-                     , old-time                  >= 1.1  && < 1.2
-                     , polyparse                 >= 1.12 && < 1.13
   default-language:    Haskell2010
 
 test-suite ht-extension-organizer-test
@@ -147,11 +174,12 @@   type:                exitcode-stdio-1.0
   ghc-options:         -with-rtsopts=-M2g
   other-modules:       ExtensionOrganizerTest.AnnotationParser
+                     , ExtensionOrganizerTest.Parser
   hs-source-dirs:      test
   main-is:             ExtensionOrganizerTest/Main.hs
   build-depends:       base                      >= 4.10 && < 4.11
                      , tasty                     >= 0.11 && < 1.1
-                     , tasty-hunit               >= 0.9 && < 0.11
+                     , tasty-hunit               >= 0.9  && < 0.11
                      , transformers              >= 0.5  && < 0.6
                      , either                    >= 4.4  && < 5.1
                      , filepath                  >= 1.4  && < 1.5
@@ -165,7 +193,7 @@                      , template-haskell          >= 2.12 && < 2.13
                      , ghc                       >= 8.2  && < 8.3
                      , ghc-paths                 >= 0.1  && < 0.2
-                     , Cabal                     >= 2.0  && < 2.1
+                     , Cabal                     >= 2.0  && < 2.3
                      , haskell-tools-ast         >= 1.0  && < 1.1
                      , haskell-tools-backend-ghc >= 1.0  && < 1.1
                      , haskell-tools-rewrite     >= 1.0  && < 1.1
@@ -174,3 +202,36 @@                      , haskell-tools-builtin-refactorings
 
   default-language:    Haskell2010
+
+-- benchmark ht-extension-organizer-benchmark
+--   type:                exitcode-stdio-1.0
+--   ghc-options:         -with-rtsopts=-M2g
+--   other-modules:       ExtensionOrganizerBenchmark.ManualTraversal
+--                      , ExtensionOrganizerBenchmark.UniPlateTraversal
+--   hs-source-dirs:      benchmark
+--   main-is:             ExtensionOrganizerBenchmark/Main.hs
+--   build-depends:       base                      >= 4.10 && < 4.11
+--                      , criterion                 >= 1.2  && < 1.3
+--                      , silently                  >= 1.2  && < 1.3
+--                      , transformers              >= 0.5  && < 0.6
+--                      , either                    >= 4.4  && < 4.6
+--                      , filepath                  >= 1.4  && < 1.5
+--                      , mtl                       >= 2.2  && < 2.3
+--                      , uniplate                  >= 1.6  && < 1.7
+--                      , containers                >= 0.5  && < 0.6
+--                      , directory                 >= 1.2  && < 1.4
+--                      , references                >= 0.3  && < 0.4
+--                      , split                     >= 0.2  && < 0.3
+--                      , time                      >= 1.8  && < 1.9
+--                      , template-haskell          >= 2.12 && < 2.13
+--                      , ghc                       >= 8.2  && < 8.3
+--                      , ghc-paths                 >= 0.1  && < 0.2
+--                      , Cabal                     >= 2.0  && < 2.3
+--                      , haskell-tools-ast         >= 1.0  && < 1.1
+--                      , haskell-tools-backend-ghc >= 1.0  && < 1.1
+--                      , haskell-tools-rewrite     >= 1.0  && < 1.1
+--                      , haskell-tools-prettyprint >= 1.0  && < 1.1
+--                      , haskell-tools-refactor    >= 1.0  && < 1.1
+--                      , haskell-tools-builtin-refactorings
+--
+--   default-language:    Haskell2010
test/ExtensionOrganizerTest/AnnotationParser.hs view
@@ -1,28 +1,51 @@-module ExtensionOrganizerTest.AnnotationParser where
+module ExtensionOrganizerTest.AnnotationParser
+  -- (getLocalExtensionAnnotations, getGlobalExtensionAnnotations)
+  where
 
+import ExtensionOrganizerTest.Parser
+
 import Data.List
 import qualified Data.Map.Strict as SMap (Map, empty, insertWith)
-import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad (Extension, LogicalRelation(..)) -- for Ord Extension
+import Language.Haskell.Tools.Refactor.Utils.Extensions (canonExt)
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMap
 
+
 {-# ANN module "HLint: ignore Use zipWith" #-}
 
 
-getExtensionAnnotations :: String -> SMap.Map (LogicalRelation Extension) [Int]
-getExtensionAnnotations s = foldl f SMap.empty (parseFile s)
+getGlobalExtensionAnnotations :: String -> [Extension]
+getGlobalExtensionAnnotations s
+  | [] <- getGlobalAnnot s = []
+  | otherwise              = parseGlobalAnnot . getGlobalAnnot $ s
+
+getLocalExtensionAnnotations :: String -> SMap.Map (LogicalRelation Extension) [Int]
+getLocalExtensionAnnotations s = foldl f SMap.empty (parseFile s)
   where f m (num, exts) = foldl (g num) m exts
-        g num m' ext = SMap.insertWith (++) (LVar ext) [num] m'
+        g num m' ext = SMap.insertWith (++) ext [num] m'
 
-parseFile :: String -> [(Int, [Extension])] -- SMap.Map Extension [Int]
+parseFile :: String -> [(Int, [LogicalRelation Extension])] -- SMap.Map Extension [Int]
 parseFile = map parseLine . zip [1..] . lines
 
-parseLine :: (Int, String) -> (Int, [Extension])
-parseLine (num, line) = (num, parseAnnot line)
+parseLine :: (Int, String) -> (Int, [LogicalRelation Extension])
+parseLine (num, line) = (num, parseLocalAnnot . getLocalAnnot $ line)
 
-parseAnnot :: String -> [Extension]
-parseAnnot = map read . delimit (== ',') . getAnnot
+parseLocalAnnot :: String -> [LogicalRelation Extension]
+parseLocalAnnot = map parseRelation . prepareAnnot
 
-getAnnot :: String -> String
-getAnnot = concat . takeWhile (not . isPrefixOf "*-}") . tail' . dropWhile (not . isPrefixOf "{-*" ) . words
+parseRelation :: String -> LogicalRelation Extension
+parseRelation = execParser relation
+
+parseGlobalAnnot :: String -> [Extension]
+parseGlobalAnnot = map read . delimit (== ',')
+
+getGlobalAnnot :: String -> String
+getGlobalAnnot = getAnnot "{-@" "@-}"
+
+getLocalAnnot :: String -> String
+getLocalAnnot = getAnnot "{-*" "*-}"
+
+getAnnot :: String -> String -> String -> String
+getAnnot start end = concat . takeWhile (not . isPrefixOf end) . tail' . dropWhile (not . isPrefixOf start ) . words
   where tail' [] = []
         tail' xs = tail xs
 
@@ -34,8 +57,34 @@ delimit' pred xs acc = delimit' pred l2 (acc ++ [l1])
   where (l1, l2) = break' pred xs
 
--- exludes the elemnt for which the predicate is true
+-- exludes the element for which the predicate is true
 break' _ xs@[] = (xs, xs)
 break' p (x:xs')
   | p x        = ([],xs')
   | otherwise  = let (ys,zs) = break' p xs' in (x:ys,zs)
+
+---------
+
+prepareAnnot :: String -> [String]
+prepareAnnot = map (filter (not . isSpace)) .  delimit (== ',')
+
+crop :: String -> String
+crop = dropWhile isSpace . reverse . dropWhile isSpace . reverse
+
+-- | A relation parser that tries to reduce the left-hand side of operators,
+-- before applíing the left-recursive rules.
+-- Also the rules are a bit convoluted in order to respect the precedence
+-- of the operators
+relation :: Parser (LogicalRelation Extension)
+relation = primRel
+       <|> (:&&:) <$> primRel  <*> (token "*" *> primRel)
+       <|> (:||:) <$> primRel  <*> (token "+" *> relation)
+       <|> (:||:) <$> relation <*> (token "+" *> relation)
+       <|> (:&&:) <$> relation <*> (token "*" *> relation)
+       <|> Not    <$> (token "~" *> relation)
+
+  where primRel = (lVar . readExt) <$> word
+              <|> Not <$> (token "~" *> primRel)
+
+        readExt :: String -> Extension
+        readExt = read . canonExt
+ test/ExtensionOrganizerTest/ArrowsTest/Basic.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE Arrows #-}
+
+module Basic where
+
+import Control.Arrow (returnA)
+
+idA :: a -> a
+idA = proc a -> returnA -< a  {-* Arrows *-}
+
+plusOne :: Int -> Int
+plusOne = proc a -> returnA -< (a+1)  {-* Arrows *-}
+
+plusFive =
+ proc a -> do b <- plusOne -< a {-* Arrows *-}
+              c <- plusOne -< b {-* Arrows *-}
+              d <- plusOne -< c {-* Arrows *-}
+              e <- plusOne -< d {-* Arrows *-}
+              plusOne -< e      {-* Arrows, Arrows *-}
+ test/ExtensionOrganizerTest/ConstrainedClassMethodsTest/Definitions.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module Definitions where
+
+class C0 where
+  f :: ()
+
+class D a where
+  g :: a -> ()
+ test/ExtensionOrganizerTest/ConstrainedClassMethodsTest/MixedTyVars.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE FlexibleContexts, ConstrainedClassMethods #-}
+
+module MixedTyVars where
+
+import Definitions
+
+class C a where
+  op1 :: D (a, b) => a -> b
+  op2 :: D b      => b -> a
+ test/ExtensionOrganizerTest/ConstrainedClassMethodsTest/NullaryConstraint.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE ConstrainedClassMethods #-}
+
+module NullaryConstraint where
+
+import Definitions
+
+class C a where
+  op :: C0 => a -> a
+ test/ExtensionOrganizerTest/ConstrainedClassMethodsTest/OnlyClassTyVars.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE ConstrainedClassMethods #-}
+
+module OnlyClassTyVars where
+
+import Definitions
+
+class C a where       {-* ConstrainedClassMethods *-}
+  op :: D a => a -> b
+ test/ExtensionOrganizerTest/ConstraintKindsTest/ClassConstraints.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE ConstraintKinds #-}
+
+module ClassConstraints where
+
+type Bar1 a = Eq a            {-* ConstraintKinds *-}
+type Bar2 a = (Eq a, Show a)  {-* ConstraintKinds *-}
+ test/ExtensionOrganizerTest/ConstraintKindsTest/ComplexConstraints.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE RankNTypes, KindSignatures, ConstraintKinds #-}
+
+module ComplexConstraints where
+
+import GHC.Exts
+
+type Foo1 (f :: * -> Constraint) b = (Eq b, f b) => b -> b         {-* ConstraintKinds, KindSignatures, KindSignatures, KindSignatures *-}
+type Foo2 (f :: * -> Constraint)   = forall b . (Eq b, f b) => b   {-* ConstraintKinds, KindSignatures, KindSignatures, KindSignatures, ExplicitForAll *-}
+ test/ExtensionOrganizerTest/ConstraintKindsTest/NotClassConstraints.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE RankNTypes, KindSignatures, ConstraintKinds #-}
+
+module NotClassConstraints where
+
+import GHC.Exts
+
+type Foo0 (f ::      Constraint)   = f                    {-* ConstraintKinds, KindSignatures *-}
+type Foo1 (f :: * -> Constraint) b = f b                  {-* ConstraintKinds, KindSignatures, KindSignatures, KindSignatures *-}
+type Foo2 (f :: * -> Constraint) b = f b => b -> b        {-* ConstraintKinds, KindSignatures, KindSignatures, KindSignatures *-}
+type Foo3 (f :: * -> Constraint)   = forall b . f b => b  {-* ConstraintKinds, KindSignatures, KindSignatures, KindSignatures, ExplicitForAll *-}
+ test/ExtensionOrganizerTest/DefaultSignaturesTest/Basic.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE DefaultSignatures #-}
+
+module Basic where
+
+class DefaultClass a where
+  f :: a -> ()
+  f = const ()
+
+class C a where
+  g :: a -> ()
+  default g :: DefaultClass a => a -> ()  {-* DefaultSignatures *-}
+  g = f
+ test/ExtensionOrganizerTest/ExistentialQuantificationTest/WithGADT.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE ExistentialQuantification, GADTSyntax #-}
+
+module WithGADT where
+
+{-@ ExistentialQuantification, GADTSyntax @-}
+
+data T a = forall c . T a c      {-* ExplicitForAll, GADTs + ExistentialQuantification *-}
+
+data GT a where
+  GT1 :: forall a . a -> GT [a]  {-* GADTSyntax, GADTs + ExistentialQuantification, ExplicitForAll *-}
+ test/ExtensionOrganizerTest/ExistentialQuantificationTest/WithGADTSyntax.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE ExistentialQuantification, GADTSyntax #-}
+
+module WithGADTSyntax where
+
+{-@ ExistentialQuantification, GADTSyntax @-}
+
+data T a = forall c . T a c  {-* ExplicitForAll, GADTs + ExistentialQuantification *-}
+
+data GT a where
+  GT1 :: a -> GT a           {-* GADTSyntax *-}
+ test/ExtensionOrganizerTest/ExistentialQuantificationTest/WithoutGADTSyntax.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE ExistentialQuantification #-}
+
+module WithoutGADTSyntax where
+
+{-@ ExistentialQuantification @-}
+
+data T1 a = forall c . T1 a c  {-* ExplicitForAll, GADTs + ExistentialQuantification *-}
+data T2 a = Eq a => T2 a       {-* GADTs + ExistentialQuantification *-}
+ test/ExtensionOrganizerTest/ExplicitNamespacesTest/Definitions.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE TypeOperators #-}
+
+module Definitions where
+
+data (:+:) a b = Plus a b
+ test/ExtensionOrganizerTest/ExplicitNamespacesTest/Export.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE ExplicitNamespaces #-}
+
+module Export
+  ( module Export
+  , type (:+:)    {-* ExplicitNamespaces *-}
+  ) where
+
+import Definitions
+ test/ExtensionOrganizerTest/ExplicitNamespacesTest/Import.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE ExplicitNamespaces #-}
+
+module Import where
+
+import Definitions (type (:+:)) {-* ExplicitNamespaces *-}
test/ExtensionOrganizerTest/FlexibleInstancesTest/Definitions.hs view
@@ -23,6 +23,21 @@ data T1 a = T1 a
 data T0 = T0
 
-data a :+: b = Plus a b
+type TS4 a b c d = T4 a b c d
+type TS3 a b c = T3 a b c
+type TS2 a b = T2 a b
+type TS1 a = T1 a
+type TS0 = T0
+
+data a :-: b      = Minus a b
+data a :+: b      = Plus a b
 data (a :++: b) c = PPlus a b c
-data a :-: b = Minus a b
+
+type MinusSyn a b   = a :-: b
+type PlusSyn  a b   = a :+: b
+type PPlusSyn a b c = (a :++: b) c
+
+
+type Phantom    a b = [a]
+type HomoTuple  a   = (a,a)
+type DoubleList a   = [[a]]
test/ExtensionOrganizerTest/FlexibleInstancesTest/NestedTypes.hs view
@@ -9,7 +9,7 @@ {-# ANN module "HLint: ignore Redundant bracket" #-}
 
 
-instance C1 (T1 a) where  
+instance C1 (T1 a) where
   f1 _ = True
 
 instance C1 (T1 (T1 a)) where    {-* FlexibleInstances *-}
+ test/ExtensionOrganizerTest/FlexibleInstancesTest/NoOccurence.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE KindSignatures,
+             TypeOperators,
+             MultiParamTypeClasses,
+             FlexibleInstances
+             #-}
+
+module NoOccurence where
+
+import Definitions
+
+{-# ANN module "HLint: ignore Redundant bracket" #-}
+
+-- NOTE: The FlexibleInstancesChecker should find some extensions,
+--       because FlexibleInstances is turned on.
+--       (However it shouldn't find FlexibleInstances)
+--       Same test-cases as in NoOccurenceOFF.
+
+
+instance (C1 (((T4) (a)) b c d)) where
+    f1 _ = True
+
+instance C1 (T2 a b) where
+    f1 _ = True
+
+instance C1 (T1 a) where
+    f1 _ = True
+
+-- (because T0 is a type ctor here)
+instance C1 T0 where
+    f1 _ = True
+
+instance C1 (a :+: b) where   {-* TypeOperators *-}
+  f1 _ = True
+
+instance C1 ((:-:) a b) where
+  f1 _ = True
+
+instance (:?:) T0 T0 where    {-* MultiParamTypeClasses *-}
+  h _ _ = True
+
+instance T0 :!: T0 where      {-* MultiParamTypeClasses, TypeOperators *-}
+  j _ _ = True                {-*  *-}
+
+instance T0 :!: (T1 a) where  {-* MultiParamTypeClasses, TypeOperators *-}
+  j _ _ = True
+
+instance (T2 a b) :!: (T1 a) where  {-* MultiParamTypeClasses, TypeOperators *-}
+  j _ _ = True
+
+instance (a :+: b) :!: (T1 a) where  {-* MultiParamTypeClasses, TypeOperators, TypeOperators *-}
+  j _ _ = True
+
+instance C1 [(a :: *)] where         {-* KindSignatures *-}
+  f1 _ = True
+
+instance C2 (T1 a) (T1 a) where      {-* MultiParamTypeClasses *-}
+  f2 _ _ = True
− test/ExtensionOrganizerTest/FlexibleInstancesTest/NoOccurenceOFF.hs 
@@ -1,54 +0,0 @@-{-# LANGUAGE KindSignatures,
-             TypeOperators,
-             MultiParamTypeClasses
-             #-}
-
-module NoOccurenceOFF where
-
-import Definitions
-
-{-# ANN module "HLint: ignore Redundant bracket" #-}
-
--- NOTE: The FlexibleInstancesChecker shouldn't even run,
---       since the FlexibleInstances isn't even turned on.
---       Same test-cases as in NoOccurenceON.
-
-instance (C1 (((T4) (a)) b c d)) where
-    f1 _ = True
-
-instance C1 (T2 a b) where
-    f1 _ = True
-
-instance C1 (T1 a) where
-    f1 _ = True
-
--- (because T0 is a type ctor here)
-instance C1 T0 where
-    f1 _ = True
-
-instance C1 (a :+: b) where
-  f1 _ = True
-
-instance C1 ((:-:) a b) where
-  f1 _ = True
-
-instance (:?:) T0 T0 where
-  h _ _ = True
-
-instance T0 :!: T0 where
-  j _ _ = True
-
-instance T0 :!: (T1 a) where
-  j _ _ = True
-
-instance (T2 a b) :!: (T1 a) where
-  j _ _ = True
-
-instance (a :+: b) :!: (T1 a) where
-  j _ _ = True
-
-instance C1 [(a :: *)] where
-  f1 _ = True
-
-instance C2 (T1 a) (T1 a) where
-  f2 _ _ = True
− test/ExtensionOrganizerTest/FlexibleInstancesTest/NoOccurenceON.hs 
@@ -1,57 +0,0 @@-{-# LANGUAGE KindSignatures,
-             TypeOperators,
-             MultiParamTypeClasses,
-             FlexibleInstances
-             #-}
-
-module NoOccurenceON where
-
-import Definitions
-
-{-# ANN module "HLint: ignore Redundant bracket" #-}
-
--- NOTE: The FlexibleInstancesChecker should find some extensions,
---       because FlexibleInstances is turned on.
---       (However it shouldn't find FlexibleInstances)
---       Same test-cases as in NoOccurenceOFF.
-
-
-instance (C1 (((T4) (a)) b c d)) where
-    f1 _ = True
-
-instance C1 (T2 a b) where
-    f1 _ = True
-
-instance C1 (T1 a) where
-    f1 _ = True
-
--- (because T0 is a type ctor here)
-instance C1 T0 where
-    f1 _ = True
-
-instance C1 (a :+: b) where   {-* TypeOperators *-}
-  f1 _ = True
-
-instance C1 ((:-:) a b) where
-  f1 _ = True
-
-instance (:?:) T0 T0 where    {-* MultiParamTypeClasses *-}
-  h _ _ = True
-
-instance T0 :!: T0 where      {-* TypeOperators, MultiParamTypeClasses *-}
-  j _ _ = True
-
-instance T0 :!: (T1 a) where  {-* TypeOperators, MultiParamTypeClasses *-}
-  j _ _ = True
-
-instance (T2 a b) :!: (T1 a) where  {-* TypeOperators, MultiParamTypeClasses *-}
-  j _ _ = True
-
-instance (a :+: b) :!: (T1 a) where  {-* TypeOperators, TypeOperators, MultiParamTypeClasses *-}
-  j _ _ = True
-
-instance C1 [(a :: *)] where         {-* KindSignatures *-}
-  f1 _ = True
-
-instance C2 (T1 a) (T1 a) where      {-* MultiParamTypeClasses *-}
-  f2 _ _ = True
+ test/ExtensionOrganizerTest/FlexibleInstancesTest/SynonymCombined.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE FlexibleInstances,
+             MultiParamTypeClasses
+             #-}
+
+module SynonymCombined where
+
+import Definitions
+
+-- NOTE: runs really slowly
+
+-- same TyVars and TopLevelTyVar
+
+instance C2 a (TS2 c c) where  {-* FlexibleInstances, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances *-}
+  f2 _ _ = True
+ test/ExtensionOrganizerTest/FlexibleInstancesTest/SynonymNestedTypes.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE TypeOperators,
+             FlexibleInstances
+             #-}
+
+module SynonymNestedTypes where
+
+import Definitions
+
+{-# ANN module "HLint: ignore Redundant bracket" #-}
+
+
+instance C1 (TS1 a) where  {-* TypeSynonymInstances *-}
+  f1 _ = True
+
+instance C1 (TS1 (TS1 a)) where    {-* FlexibleInstances, TypeSynonymInstances *-}
+  f1 _ = True
+
+instance C1 (TS2 a (TS1 b)) where  {-* FlexibleInstances, TypeSynonymInstances *-}
+  f1 _ = True
+
+instance C1 (TS2 (TS1 a) b) where  {-* FlexibleInstances, TypeSynonymInstances *-}
+  f1 _ = True
+
+instance C1 (PlusSyn (TS1 a) b) where  {-* FlexibleInstances, TypeSynonymInstances *-}
+  f1 _ = True
+
+instance C1 (DoubleList a) where  {-* FlexibleInstances, TypeSynonymInstances *-}
+  f1 _ = True
+
+instance C1 (Phantom (T1 a) a) where  {-* FlexibleInstances, TypeSynonymInstances *-}
+  f1 _ = True
+
+-- False positive
+instance C1 (Phantom a (T1 a)) where  {-* FlexibleInstances, TypeSynonymInstances *-}
+  f1 _ = True
+ test/ExtensionOrganizerTest/FlexibleInstancesTest/SynonymNestedUnitTyCon.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE FlexibleInstances
+             #-}
+
+module SynonymNestedUnitTyCon where
+
+import Definitions
+
+
+instance C1 (TS3 a b TS0) where  {-* FlexibleInstances, TypeSynonymInstances *-}
+  f1 _ = True
+
+instance C1 (TS3 a TS0 c) where  {-* FlexibleInstances, TypeSynonymInstances *-}
+  f1 _ = True
+
+instance C1 (TS3 TS0 b c) where  {-* FlexibleInstances, TypeSynonymInstances *-}
+  f1 _ = True
+
+instance C1 (DoubleList T0) where  {-* FlexibleInstances, FlexibleInstances, TypeSynonymInstances *-}
+  f1 _ = True
+
+instance C1 (HomoTuple T0) where  {-* FlexibleInstances, FlexibleInstances, TypeSynonymInstances *-}
+  f1 _ = True
+
+instance C1 (Phantom T0 a) where  {-* FlexibleInstances, TypeSynonymInstances *-}
+  f1 _ = True
+
+-- False positive
+instance C1 (Phantom a T0) where  {-* FlexibleInstances, TypeSynonymInstances *-}
+  f1 _ = True
+ test/ExtensionOrganizerTest/FlexibleInstancesTest/SynonymNestedWiredInType.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE FlexibleInstances #-}
+
+module SynonymNestedWiredInType where
+
+import Definitions
+
+
+instance C1 (TS3 a b Int) where  {-* FlexibleInstances, TypeSynonymInstances *-}
+  f1 _ = True
+
+instance C1 (TS3 a Int c) where  {-* FlexibleInstances, TypeSynonymInstances *-}
+  f1 _ = True
+
+instance C1 (TS3 Int b c) where  {-* FlexibleInstances, TypeSynonymInstances *-}
+  f1 _ = True
+
+instance C1 (Phantom Int a) where  {-* FlexibleInstances, TypeSynonymInstances *-}
+  f1 _ = True
+
+-- False positive
+instance C1 (Phantom a Int) where  {-* FlexibleInstances, TypeSynonymInstances *-}
+  f1 _ = True
+ test/ExtensionOrganizerTest/FlexibleInstancesTest/SynonymNoOccurence.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE KindSignatures,
+             TypeOperators,
+             MultiParamTypeClasses,
+             FlexibleInstances
+             #-}
+
+module SynonymNoOccurence where
+
+import Definitions
+
+{-# ANN module "HLint: ignore Redundant bracket" #-}
+
+instance (C1 (((TS4) (a)) b c d)) where  {-* TypeSynonymInstances *-}
+    f1 _ = True
+
+instance C1 (TS2 a b) where  {-* TypeSynonymInstances *-}
+    f1 _ = True
+
+instance C1 (TS1 a) where  {-* TypeSynonymInstances *-}
+    f1 _ = True
+
+-- (because TS0 is a type ctor here)
+instance C1 TS0 where  {-* TypeSynonymInstances *-}
+    f1 _ = True
+
+instance C1 (PlusSyn a b) where  {-* TypeSynonymInstances *-}
+  f1 _ = True
+
+instance C1 ((:-:) a b) where
+  f1 _ = True                   
+
+instance (:?:) TS0 TS0 where    {-* MultiParamTypeClasses, TypeSynonymInstances, TypeSynonymInstances *-}
+  h _ _ = True
+
+instance TS0 :!: TS0 where      {-* MultiParamTypeClasses, TypeSynonymInstances, TypeSynonymInstances, TypeOperators *-}
+  j _ _ = True
+
+instance TS0 :!: (TS1 a) where  {-* MultiParamTypeClasses, TypeSynonymInstances, TypeSynonymInstances, TypeOperators *-}
+  j _ _ = True
+
+instance (TS2 a b) :!: (TS1 a) where  {-* MultiParamTypeClasses, TypeSynonymInstances, TypeSynonymInstances, TypeOperators *-}
+  j _ _ = True
+
+instance (a :+: b) :!: (TS1 a) where  {-* MultiParamTypeClasses, TypeSynonymInstances, TypeOperators, TypeOperators *-}
+  j _ _ = True
+
+instance C1 [(a :: *)] where         {-* KindSignatures *-}
+  f1 _ = True
+
+instance C2 (TS1 a) (TS1 a) where      {-* MultiParamTypeClasses, TypeSynonymInstances, TypeSynonymInstances *-}
+  f2 _ _ = True
+ test/ExtensionOrganizerTest/FlexibleInstancesTest/SynonymSameTyVars.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE FlexibleInstances
+             #-}
+
+module SynonymSameTyVars where
+
+import Definitions
+
+
+instance C1 (TS2 a a) where      {-* FlexibleInstances, TypeSynonymInstances *-}
+  f1 _ = True
+
+instance C1 (TS4 a b d d) where  {-* FlexibleInstances, TypeSynonymInstances *-}
+  f1 _ = True
+
+instance C1 (HomoTuple a) where  {-* FlexibleInstances, TypeSynonymInstances *-}
+  f1 _ = True
+
+-- False positive
+instance C1 (Phantom a a) where  {-* FlexibleInstances, TypeSynonymInstances *-}
+  f1 _ = True
+ test/ExtensionOrganizerTest/FlexibleInstancesTest/SynonymTopLevelTyVar.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE MultiParamTypeClasses,
+             TypeOperators,
+             FlexibleInstances
+             #-}
+
+module SynonymTopLevelTyVar where
+
+import Definitions
+
+{-# ANN module "HLint: ignore Redundant bracket" #-}
+
+-- There are two matches, because there are two top-level tyvars
+
+instance C2 a a where  {-* FlexibleInstances, FlexibleInstances, MultiParamTypeClasses *-}
+  f2 _ _ = True
+
+-- extra check for the brackets around "d"
+instance C2 ((PPlusSyn a b) c) (d) where  {-* FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances *-}
+  f2 _ _ = True
+ test/ExtensionOrganizerTest/FunctionalDependenciesTest/Basic.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE FunctionalDependencies #-}
+
+module Basic where
+
+class C a b where               {-* MultiParamTypeClasses *-}
+  f :: a -> b -> ()
+
+class FDC a b | a -> b  where   {-* FunctionalDependencies, MultiParamTypeClasses *-}
+  g :: a -> b -> ()
+ test/ExtensionOrganizerTest/GADTsTest/AssocGDataFamily.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE TypeFamilies, GADTs #-}
+
+module AssocGDataFamily where
+
+class GC a where
+  data GD a :: * -> *           {-* TypeFamilies, KindSignatures, KindSignatures, KindSignatures *-}
+
+instance GC Int where
+  data GD Int a where
+    G1 :: Int -> a -> GD Int a  {-* TypeFamilies, GADTSyntax *-}
+ test/ExtensionOrganizerTest/GADTsTest/GDataFamilyDecl.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE TypeFamilies
+           , GADTs
+           #-}
+
+module GDataFamilyDecl where
+
+data family G a b {-* TypeFamilies *-}
+
+data instance G [a] b where
+   G1 :: c -> G [Int] b     {-* GADTSyntax, GADTs + ExistentialQuantification *-}
+   G2 :: G [a] Bool         {-* GADTSyntax, GADTs + ExistentialQuantification, TypeFamilies *-}
+ test/ExtensionOrganizerTest/GADTsTest/GDataInstDecl.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE GADTs, TypeFamilies #-}
+
+module GDataInstDecl where
+
+data family G a b                      {-* TypeFamilies *-}
+data instance G [a] b where            
+   GExistential :: c -> G [a] b        {-* GADTSyntax, GADTs + ExistentialQuantification *-}
+   GSpecResTy   :: G [Int] b           {-* GADTSyntax, GADTs + ExistentialQuantification *-}
+   GContext     :: Eq a => G [a] b     {-* GADTSyntax, GADTs + ExistentialQuantification *-}
+   GRegular     :: G [a] b             {-* GADTSyntax, TypeFamilies *-}
+ test/ExtensionOrganizerTest/GADTsTest/NormalContext.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE GADTs #-}
+
+module NormalContext where
+
+{-@ GADTs @-}
+
+data T a where
+  T1 :: Eq a => a -> T a  {-* GADTSyntax, GADTs + ExistentialQuantification *-}
+  T2 :: a -> a -> T a     {-* GADTSyntax *-}
+ test/ExtensionOrganizerTest/GADTsTest/NormalExistential.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE GADTs #-}
+
+module NormalExistential where
+
+{-@ GADTs @-}
+
+data T a where
+  T1 :: b -> T a          {-* GADTSyntax, GADTs + ExistentialQuantification *-}
+  T2 :: a -> a -> T a     {-* GADTSyntax *-}
+ test/ExtensionOrganizerTest/GADTsTest/NormalOnlySyntax.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE GADTSyntax #-}
+
+module NormalOnlySyntax where
+
+data T a where
+  T1 :: a -> T a       {-* GADTSyntax *-}
+  T2 :: a -> a -> T a  {-* GADTSyntax *-}
+ test/ExtensionOrganizerTest/GADTsTest/NormalSpecResultType.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE GADTs #-}
+
+module NormalSpecResultType where
+
+{-@ GADTs @-}
+
+data T a where
+  T1 :: a -> T [a]       {-* GADTSyntax, GADTs + ExistentialQuantification *-}
+  T2 :: a -> a -> T a    {-* GADTSyntax *-}
+ test/ExtensionOrganizerTest/GADTsTest/RecordContext.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE GADTs #-}
+
+module RecordContext where
+
+{-@ GADTs @-}
+
+data T a b where
+  T1 :: Eq a => { f1::a, f2::b } -> T a b  {-* GADTSyntax, GADTs + ExistentialQuantification *-}
+  T2 :: { f1::a, f2::b } -> T a b          {-* GADTSyntax *-}
+ test/ExtensionOrganizerTest/GADTsTest/RecordExistential.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE GADTs #-}
+
+module RecordExistential where
+
+{-@ GADTs @-}
+
+data T a b where
+  T1 :: { f1::a, f2::c } -> T a b  {-* GADTSyntax, GADTs + ExistentialQuantification *-}
+  T2 :: { g1::a, g2::b } -> T a b  {-* GADTSyntax *-}
+ test/ExtensionOrganizerTest/GADTsTest/RecordOnlySyntax.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE GADTSyntax #-}
+
+module RecordOnlySyntax where
+
+data T a b where
+  T1 :: { f1::a, f2::b } -> T a b  {-* GADTSyntax *-}
+  T2 :: { f1::a, f2::b } -> T a b  {-* GADTSyntax *-}
+ test/ExtensionOrganizerTest/GADTsTest/RecordSpecResultType.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE GADTs #-}
+
+module RecordSpecResultType where
+
+{-@ GADTs @-}
+
+data T a b where
+  T1 :: { f1::a, f2::b } -> T [a] [b]  {-* GADTSyntax, GADTs + ExistentialQuantification *-}
+  T2 :: { g1::a, g2::b } -> T a b      {-* GADTSyntax *-}
+ test/ExtensionOrganizerTest/GADTsTest/TypeEquality.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE GADTs, ConstraintKinds #-}
+
+module TypeEquality where
+
+{-@ GADTs, ConstraintKinds @-}
+
+type EqRel a b = a ~ b {-* TypeFamilies + GADTs, TypeFamilies + GADTs, ConstraintKinds *-}
+
+data T a where
+  T1 :: b -> T a       {-* GADTSyntax, GADTs + ExistentialQuantification *-}
+ test/ExtensionOrganizerTest/GADTsTest/TypeEqualityWithOnlySyntax.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE GADTs, ConstraintKinds #-}
+
+module TypeEqualityWithOnlySyntax where
+
+{-@ GADTs, ConstraintKinds @-}
+
+type EqRel a b = a ~ b {-* TypeFamilies + GADTs, TypeFamilies + GADTs, ConstraintKinds *-}
+
+data T a where
+  T1 :: a -> T a       {-* GADTSyntax *-}
+ test/ExtensionOrganizerTest/KindSignaturesTest/InClassDecl.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE KindSignatures #-}
+
+module InClassDecl where
+
+class C (a :: *) where {-* KindSignatures *-}
+  f :: a -> ()
+ test/ExtensionOrganizerTest/KindSignaturesTest/InDataDecl.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE KindSignatures #-}
+
+module InDataDecl where
+
+data Foo (f :: * -> *) a = Foo (f a)  {-* KindSignatures, KindSignatures, KindSignatures *-}
+ test/ExtensionOrganizerTest/KindSignaturesTest/InForAll.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE KindSignatures, ExplicitForAll #-}
+
+module InForAll where
+
+f :: forall (a :: *) . a -> a {-* KindSignatures, ExplicitForAll *-}
+f = id
+ test/ExtensionOrganizerTest/KindSignaturesTest/InTypeFamily.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE TypeFamilies #-}
+
+module InTypeFamily where
+
+type family F a :: * where  {-* KindSignatures *-}
+  F () = ()
+  F _  = ()                 {-* TypeFamilies *-}
+ test/ExtensionOrganizerTest/KindSignaturesTest/InTypeSynonym.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE KindSignatures #-}
+
+module InTypeSynonym where
+
+type Foo (f :: * -> *) a = f a  {-* KindSignatures, KindSignatures, KindSignatures *-}
test/ExtensionOrganizerTest/LambdaCaseTest/InExpr.hs view
@@ -28,7 +28,7 @@ 
 x5 = if | (\case {_ -> False}) 5 -> 20                    {-* LambdaCase *-}
         | (\case {_ -> True}) 5 -> (\case {_ -> 10}) ()   {-* LambdaCase, LambdaCase *-}
-        | otherwise -> (\case {_ -> 10}) ()               {-* LambdaCase *-} --MultiWayIf
+        | otherwise -> (\case {_ -> 10}) ()               {-* LambdaCase, MultiWayIf *-}
 
 x6 = case (\case {_ -> [1..10]}) () of  {-* LambdaCase *-}
        [] -> \case {_ -> 5}             {-* LambdaCase *-}
+ test/ExtensionOrganizerTest/MagicHashTest/Literal/InExpr.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE MagicHash #-}
+
+module InExpr where
+
+-- non-exhaustive check for Expr node location in AST
+
+f :: ()
+f = ()
+  where
+  x1 = 1#       {-* MagicHash *-}
+  x2 = 1##      {-* MagicHash *-}
+  x3 = 3.14#    {-* MagicHash *-}
+  x4 = 3.14##   {-* MagicHash *-}
+  x5 = 'c'#     {-* MagicHash *-}
+  x6 = "xxx"#   {-* MagicHash *-}
+ test/ExtensionOrganizerTest/MagicHashTest/Name/InAssertion.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE MagicHash,
+             TypeOperators,
+             MultiParamTypeClasses
+             #-}
+
+module InAssertion where
+
+-- TODO: implicit assert
+
+class C# a where          {-* MagicHash *-}
+  f1 :: a -> a
+
+class a :!: b where          {-* MultiParamTypeClasses *-} 
+  f2 :: a -> b               {-* TypeOperators *-}
+
+
+g1 :: C# a# => a# -> a#      {-* MagicHash, MagicHash, MagicHash, MagicHash *-}
+g1 = id
+
+g2 :: (a :!: b#) => a -> b# -> ()     {-* MagicHash, MagicHash, TypeOperators *-}
+g2 _ _ = ()
+
+g3 :: (C# a, (a :!: b#)) => a -> b# -> ()   {-* MagicHash, MagicHash, MagicHash, TypeOperators *-}
+g3 _ _ = ()
+ test/ExtensionOrganizerTest/MagicHashTest/Name/InClassElement.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE MagicHash,
+             DefaultSignatures
+             #-}
+
+module InClassElement where
+
+class C a where
+  f# :: a -> a          {-* MagicHash *-}
+  default f# :: a -> a  {-* MagicHash, DefaultSignatures *-}
+  f# = id               {-* MagicHash *-}
+ test/ExtensionOrganizerTest/MagicHashTest/Name/InDecl.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE MagicHash #-}
+
+module InDecl where
+
+-- non-exhaustive check for Decl node location in AST
+
+-- TODO: Foreign Import/Export
+ test/ExtensionOrganizerTest/MagicHashTest/Name/InDeclHead.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE MagicHash,
+             GADTSyntax
+             #-}
+
+module InDeclHead where
+
+type T1# = ()           {-* MagicHash *-}
+newtype T2# = T2# T1#   {-* MagicHash, MagicHash, MagicHash *-}
+data T3# = T31# | T32#  {-* MagicHash, MagicHash, MagicHash *-}
+
+data Expr# a where                           {-* MagicHash *-}
+    I   :: Int  -> Expr# a                   {-* GADTSyntax, MagicHash *-}
+    B   :: Bool -> Expr# a                   {-* GADTSyntax, MagicHash *-}
+    Add :: Expr# Int -> Expr# Int -> Expr# a {-* GADTSyntax, MagicHash, MagicHash, MagicHash *-}
+    Mul :: Expr# Int -> Expr# Int -> Expr# a {-* GADTSyntax, MagicHash, MagicHash, MagicHash *-}
+    Eq  :: Expr# Int -> Expr# Int -> Expr# a {-* GADTSyntax, MagicHash, MagicHash, MagicHash *-}
+
+class C1# a where  {-* MagicHash *-}
+  f :: a -> a
+ test/ExtensionOrganizerTest/MagicHashTest/Name/InExpr.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE MagicHash #-}
+
+module InExpr where
+
+-- TODO: non-exhaustive
+
+data Rec = Rec# { x :: Int }  {-* MagicHash *-}
+
+f :: Int -> Int
+f x# = x# + x#                 {-* MagicHash, MagicHash, MagicHash *-}
+
+g :: Rec -> Rec
+g Rec#{x = x} = Rec# {x = 2}  {-* MagicHash, MagicHash *-}
+ test/ExtensionOrganizerTest/MagicHashTest/Name/InFieldDecl.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE MagicHash #-}
+
+module InFieldDecl where
+
+import GHC.Prim
+
+data Rec a# = R               {-* MagicHash *-}
+              { f1# :: Int#   {-* MagicHash, MagicHash *-}
+              , f2# :: a#     {-* MagicHash, MagicHash *-}
+              }
+ test/ExtensionOrganizerTest/MagicHashTest/Name/InFieldUpdate.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE MagicHash #-}
+
+module InFieldUpdate where
+
+-- TODO: non-exhaustive
+
+data Rec = Rec { x# :: Int }  {-* MagicHash *-}
+
+g :: Rec -> Rec
+g Rec{x# = x} = Rec {x# = 2}  {-* MagicHash, MagicHash *-}
+ test/ExtensionOrganizerTest/MagicHashTest/Name/InFunDeps.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE MagicHash,
+             FunctionalDependencies
+             #-}
+
+module InFunDeps where
+
+class C a# b# | a# -> b# where  {-* MagicHash, MagicHash, MagicHash, MagicHash, FunctionalDependencies, MultiParamTypeClasses *-}
+  f :: a# -> b#                 {-* MagicHash, MagicHash *-}
+ test/ExtensionOrganizerTest/MagicHashTest/Name/InInstanceHead.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE MagicHash #-}
+
+module InInstanceHead where
+
+class C# a where          {-* MagicHash *-}
+  f :: a -> a
+
+instance (C#) Int where   {-* MagicHash *-}
+  f = id
+ test/ExtensionOrganizerTest/MagicHashTest/Name/InKind.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE MagicHash,
+             PolyKinds,
+             MultiParamTypeClasses
+             #-}
+
+module InKind where
+
+-- TODO: unboxed kinds
+
+class C (f :: k# -> *) (a :: k#) (b :: *) where  {-* Magichash, Magichash *-} --PolyKinds, MultiParamTypeClasses
+    g :: f a -> b
+ test/ExtensionOrganizerTest/MagicHashTest/Name/InMatchLhs.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE MagicHash #-}
+
+module InMatchLhs where
+
+f :: [a] -> [a]
+f (a# : as#) = as#  {-* MagicHash, MagicHash, MagicHash *-}
+f [a#] = [a#]       {-* MagicHash, MagicHash *-}
+ test/ExtensionOrganizerTest/MagicHashTest/Name/InPatSynLhs.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE MagicHash,
+             PatternSynonyms
+             #-}
+
+module InPatSynLhs where
+
+pattern Uni# :: a -> b -> c -> (a,b,c)  {-* PatternSynonyms, MagicHash *-}
+pattern Uni# a b c <- (a,b,c)           {-* PatternSynonyms, MagicHash *-}
+
+pattern Bi# :: a -> [a]      {-* PatternSynonyms, MagicHash *-}
+pattern Bi# a = [a]          {-* PatternSynonyms, MagicHash *-}
+ test/ExtensionOrganizerTest/MagicHashTest/Name/InPattern.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE MagicHash,
+             BangPatterns,
+             ScopedTypeVariables,
+             ViewPatterns
+             #-}
+
+module InPattern where
+
+-- NOTE: non-exhaustive
+
+data Rec = Rec# { x :: Int }    {-* MagicHash *-}
+
+f1 :: a -> ()
+f1 x# = ()                      {-* MagicHash *-}
+
+f2 :: [a] -> ()
+f2 (a# : as#) = ()              {-* MagicHash, MagicHash *-}
+f2 [x#] = ()                    {-* MagicHash *-}
+f2 _ = ()
+
+f3 :: Maybe a -> ()
+f3 (Just x#) = ()               {-* MagicHash *-}
+f3 _ = ()
+
+f4 :: (a,a) -> ()
+f4 (x#, y#) = ()                {-* MagicHash, MagicHash *-}
+
+f5 :: Rec -> ()
+f5 Rec#{x = x} = ()             {-* MagicHash *-}
+
+f6 :: a -> ()
+f6 x#@y# = ()                   {-* MagicHash, MagicHash *-}
+
+f7 :: a -> ()
+f7 !x# = ()                     {-* MagicHash, BangPatterns *-}
+
+f8 :: a -> ()
+f8 (x# :: a) = ()               {-* MagicHash *-} -- ScopedTypeVariables
+
+f9 :: a -> ()
+f9 (id -> x#) = ()              {-* MagicHash, ViewPatterns *-}
+ test/ExtensionOrganizerTest/MagicHashTest/Name/InPatternField.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE MagicHash,
+             NamedFieldPuns
+             #-}
+
+module InPatternField where
+
+-- NOTE: non-exhaustive
+
+data Rec = Rec { x# :: Int }    {-* MagicHash *-}
+
+f5 :: Rec -> ()
+f5 Rec{x# = 0} = ()             {-* MagicHash *-}
+f5 Rec{x#}     = ()             {-* MagicHash *-} --RecordPuns
+ test/ExtensionOrganizerTest/MagicHashTest/Name/InType.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE MagicHash,
+             ExplicitForAll,
+             KindSignatures,
+             TypeOperators
+             #-}
+
+module InType where
+
+{-# ANN module "HLint: ignore Redundant bracket" #-}
+
+
+-- TODO: unboxed tuples, template haskell, etc ...
+
+
+
+newtype T a b = T (a,b)
+
+data a :+: b = Plus a b        {-* TypeOperators *-}
+
+
+f1 :: forall a# . a# -> ()     {-* MagicHash, MagicHash, ExplicitForAll *-}
+f1 x = ()
+
+f2 :: Show a# => a# -> ()      {-* MagicHash, MagicHash *-}
+f2 x = ()
+
+f3 :: a# -> b# -> ()           {-* MagicHash, MagicHash *-}
+f3 x y = ()
+
+f4 :: (a#, b#) -> ()           {-* MagicHash, MagicHash *-}
+f4 x = ()
+
+f5 :: [a#] -> ()               {-* MagicHash *-}
+f5 xs = ()
+
+f6 :: T a# b# -> T a# b#       {-* MagicHash, MagicHash, MagicHash, MagicHash *-}
+f6 = id
+
+f7 :: (a#) -> ()               {-* MagicHash *-}
+f7 x = ()
+
+f8 :: a# :+: b# -> ()          {-* MagicHash, MagicHash, TypeOperators *-}
+f8 x = ()
+
+f9 :: (a# :: *) -> ()          {-* MagicHash, KindSignatures *-}
+f9 x = ()
+ test/ExtensionOrganizerTest/MagicHashTest/Name/InTypeFamily.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE MagicHash,
+             TypeFamilyDependencies
+             #-}
+
+module InTypeFamily where
+
+-- DeclHead, TypeEqn, InjectivityAnn
+
+-- a function on types: gets a type 'a' and return a type with kind *
+type family Id# a# = r# | r# -> a# where  {-* MagicHash, MagicHash, MagicHash, MagicHash, MagicHash*-}  --TypeFamilies, TypeFamilyDependencies
+  Id# a# = a#  {-* MagicHash, MagicHash *-}
+ test/ExtensionOrganizerTest/MagicHashTest/Name/InTypeSig.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE MagicHash #-}
+
+module InTypeSig where
+
+-- non-exhaustive
+
+f# :: a -> a            {-* MagicHash *-}
+f# = id                 {-* MagicHash *-}
+  where asd# :: b -> b  {-* MagicHash *-}
+        asd# = id       {-* MagicHash *-}
+
+class C a where
+  g# :: a -> a   {-* MagicHash *-}
test/ExtensionOrganizerTest/Main.hs view
@@ -9,10 +9,11 @@ import SrcLoc (SrcSpan(..), srcSpanEndLine)
 
 import Data.List (sort)
+import Control.Monad (unless)
 import qualified Data.Map.Strict as SMap (Map, map)
 import System.FilePath (FilePath, addExtension, (</>))
 
-import ExtensionOrganizerTest.AnnotationParser (getExtensionAnnotations)
+import ExtensionOrganizerTest.AnnotationParser
 import Language.Haskell.Tools.Refactor hiding (ModuleName)
 import Language.Haskell.Tools.Refactor.Builtin.OrganizeExtensions
 
@@ -38,6 +39,22 @@   , mkTests lambdaCaseTest
   , mkTests tupleSectionsTest
   , mkNestedTests magicHashTest
+  , mkTests functionalDependenciesTest
+  , mkTests defaultSignaturesTest
+  , mkTests recursiveDoTest
+  , mkTests arrowsTest
+  , mkTests parallelListCompTest
+  , mkTests typeFamiliesTest
+  , mkTests multiParamTypeClassesTest
+  , mkTests constraintKindsTest
+  , mkTests kindSignaturesTest
+  , mkTests explicitNamespacesTest
+  , mkTests overloadedStringsTest
+  , mkTests gadtsTest
+  , mkTests existentialQuantificationTest
+  , mkTests constrainedClassMethodsTest
+  , mkTests multiWayIfTest
+  , mkTests typeOperatorsTest
   ]
 
 testRoot = "test/ExtensionOrganizerTest"
@@ -58,34 +75,38 @@ simplifyExtMap :: ExtMap -> SimpleMap
 simplifyExtMap = SMap.map (map spanToLine)
 
-loadModuleAST :: FilePath -> ModuleName -> Ghc TypedModule
-loadModuleAST dir moduleName = do
-  useFlags ["-w"]
-  modSummary <- loadModule (testRoot </> dir) moduleName
-  parseTyped modSummary
-
 getExtensionsFrom :: FilePath -> ModuleName -> IO SimpleMap
 getExtensionsFrom dir moduleName = runGhc (Just libdir) $ do
-  modAST <- loadModuleAST dir moduleName
+  modAST <- loadModuleAST (testRoot </> dir) moduleName
   exts <- collectExtensions modAST
   return $! simplifyExtMap exts
 
-getExtAnnotsFrom :: FilePath -> ModuleName -> IO SimpleMap
-getExtAnnotsFrom dir moduleName = do
+getLclExtAnnotsFrom :: FilePath -> ModuleName -> IO SimpleMap
+getLclExtAnnotsFrom dir moduleName = do
   s <- readFile $ addExtension (mkModulePath dir moduleName) ".hs"
-  return $! getExtensionAnnotations s
+  return $! getLocalExtensionAnnotations s
 
+getGlbExtAnnotsFrom :: FilePath -> ModuleName -> IO [Extension]
+getGlbExtAnnotsFrom dir moduleName = do
+  s <- readFile $ addExtension (mkModulePath dir moduleName) ".hs"
+  return $! getGlobalExtensionAnnotations s
 
 mkTest :: FilePath -> ModuleName -> TestTree
 mkTest dir moduleName = testCase moduleName $ mkAssertion dir moduleName
 
+-- | Compares the local annotations with the result of the checker.
+-- Also compares the global expected result with minimized extension set.
 mkAssertion :: FilePath -> ModuleName -> IO ()
 mkAssertion dir moduleName = do
-  expected <- getExtAnnotsFrom  dir moduleName
-  result   <- getExtensionsFrom dir moduleName
-  assertEqual "Failure" (mapSort expected) (mapSort result)
-  where mapSort = SMap.map sort
+  global <- getGlbExtAnnotsFrom dir moduleName
+  local  <- getLclExtAnnotsFrom dir moduleName
+  result <- getExtensionsFrom   dir moduleName
+  let minimalExts = determineExtensions result
+      mapSort = SMap.map sort
 
+  assertEqual "Failure" (mapSort local) (mapSort result)
+  unless (null global) $ assertEqual "Failure" (sort global) (sort minimalExts)
+
 mkTests :: TestSuite -> TestTree
 mkTests (testDir, tests) = testGroup testDir (map (mkTest testDir) tests)
 
@@ -111,11 +132,17 @@                            , "NestedTypes"
                            , "NestedUnitTyCon"
                            , "NestedWiredInType"
-                           , "NoOccurenceON"
-                           , "NoOccurenceOFF"
+                           , "NoOccurence"
                            , "SameTyVars"
                            , "TopLevelTyVar"
                            , "TopLevelWiredInType"
+                           , "SynonymCombined"
+                           , "SynonymNestedTypes"
+                           , "SynonymNestedUnitTyCon"
+                           , "SynonymNestedWiredInType"
+                           , "SynonymNoOccurence"
+                           , "SynonymSameTyVars"
+                           , "SynonymTopLevelTyVar"
                            ]
 
 derivingsTest :: TestSuite
@@ -235,3 +262,164 @@ magicHashLiteralTest = (mhLiteralRoot, mhLiteralModules)
 mhLiteralRoot = "Literal"
 mhLiteralModules = [ "InExpr" ]
+
+
+functionalDependenciesTest :: TestSuite
+functionalDependenciesTest = (fdRoot, fdModules)
+fdRoot = "FunctionalDependenciesTest"
+fdModules = [ "Basic" ]
+
+
+defaultSignaturesTest :: TestSuite
+defaultSignaturesTest = (dsRoot, dsModules)
+dsRoot = "DefaultSignaturesTest"
+dsModules = [ "Basic" ]
+
+
+recursiveDoTest :: TestSuite
+recursiveDoTest = (rdRoot, rdModules)
+rdRoot = "RecursiveDoTest"
+rdModules = [ "MDo"
+            , "RecStmt"
+            ]
+
+
+arrowsTest :: TestSuite
+arrowsTest = (arrRoot, arrModules)
+arrRoot = "ArrowsTest"
+arrModules = [ "Basic" ]
+
+
+parallelListCompTest :: TestSuite
+parallelListCompTest = (pcRoot, pcModules)
+pcRoot = "ParallelListCompTest"
+pcModules = [ "InCaseRhs"
+            , "InCompStmt"
+            , "InExpr"
+            , "InFieldUpdate"
+            , "InPattern"
+            , "InRhs"
+            , "InRhsGuard"
+            , "InStmt"
+            , "InTupSecElem"
+            ]
+
+typeFamiliesTest :: TestSuite
+typeFamiliesTest = (tfRoot, tfModules)
+tfRoot = "TypeFamiliesTest"
+tfModules = [ "AssocDataFamily"
+            , "AssocGDataFamily"
+            , "AssocTypeFamily"
+            , "ClosedTypeFamilyDecl"
+            , "DataFamilyDecl"
+            , "GDataFamilyDecl"
+            , "NestedTypeEqualityContextSynonyms"
+            , "NestedTypeEqualitySynonyms"
+            , "TypeEqualityContext"
+            , "TypeEqualityContextSynonyms"
+            , "TypeEquality"
+            , "TypeEqualitySynonyms"
+            , "TypeEqualityInName"
+            , "TypeFamilyDecl"
+            ]
+
+multiParamTypeClassesTest :: TestSuite
+multiParamTypeClassesTest = (mptcRoot, mptcModules)
+mptcRoot = "MultiParamTypeClassesTest"
+mptcModules = [ "MultipleTyVars"
+              , "ZeroTyVars"
+              ]
+
+constraintKindsTest :: TestSuite
+constraintKindsTest = (ckRoot, ckModules)
+ckRoot = "ConstraintKindsTest"
+ckModules = [ "ClassConstraints"
+            , "ComplexConstraints"
+            , "NotClassConstraints"
+            ]
+
+kindSignaturesTest :: TestSuite
+kindSignaturesTest = (ksRoot, ksModules)
+ksRoot = "KindSignaturesTest"
+ksModules = [ "InClassDecl"
+            , "InDataDecl"
+            , "InForAll"
+            , "InTypeFamily"
+            , "InTypeSynonym"
+            ]
+
+explicitNamespacesTest :: TestSuite
+explicitNamespacesTest = (esRoot, esModules)
+esRoot = "ExplicitNamespacesTest"
+esModules = [ "Import"
+            , "Export"
+            ]
+
+overloadedStringsTest :: TestSuite
+overloadedStringsTest = (osRoot, osModules)
+osRoot = "OverloadedStringsTest"
+osModules = [ "Synonym"
+            , "Newtype"
+            , "Other"
+            ]
+
+gadtsTest :: TestSuite
+gadtsTest = (gadtRoot, gadtModules)
+gadtRoot = "GADTsTest"
+gadtModules = [ "AssocGDataFamily"
+              , "GDataFamilyDecl"
+              , "GDataInstDecl"
+              , "NormalContext"
+              , "NormalExistential"
+              , "NormalOnlySyntax"
+              , "NormalSpecResultType"
+              , "RecordContext"
+              , "RecordExistential"
+              , "RecordOnlySyntax"
+              , "RecordSpecResultType"
+              , "TypeEquality"
+              , "TypeEqualityWithOnlySyntax"
+              ]
+
+existentialQuantificationTest :: TestSuite
+existentialQuantificationTest = (eqRoot, eqModules)
+eqRoot = "ExistentialQuantificationTest"
+eqModules = [ "WithGADT"
+            , "WithGADTSyntax"
+            , "WithoutGADTSyntax"
+            ]
+
+constrainedClassMethodsTest :: TestSuite
+constrainedClassMethodsTest = (ccmRoot, ccmModules)
+ccmRoot = "ConstrainedClassMethodsTest"
+ccmModules = [ "MixedTyVars"
+             , "NullaryConstraint"
+             , "OnlyClassTyVars"
+             ]
+
+multiWayIfTest :: TestSuite
+multiWayIfTest = (mwiRoot, mwiModules)
+mwiRoot = "MultiWayIfTest"
+mwiModules = [ "InCaseRhs"
+             , "InCompStmt"
+             , "InExpr"
+             , "InFieldUpdate"
+             , "InPattern"
+             , "InRhs"
+             , "InRhsGuard"
+             , "InStmt"
+             , "InTupSecElem"
+             ]
+
+typeOperatorsTest :: TestSuite
+typeOperatorsTest = (toRoot, toModules)
+toRoot = "TypeOperatorsTest"
+toModules = [ "InfixClassDecl"
+            , "InfixDataDecl"
+            , "InfixInstance"
+            , "InfixTypeAnnot"
+            , "InfixTypeSig"
+            , "NormalClassDecl"
+            , "NormalDataDecl"
+            , "NormalInstance"
+            ]
+ test/ExtensionOrganizerTest/MultiParamTypeClassesTest/MultipleTyVars.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module MultipleTyVars where
+
+class C2 a b where  {-* MultiParamTypeClasses *-}
+  f :: a -> b -> ()
+
+class C3 a b c where  {-* MultiParamTypeClasses *-}
+  g :: a -> b -> c -> ()
+
+instance C2 Int Int where  {-* MultiParamTypeClasses *-}
+  f _ _ = ()
+
+instance C3 Int Int Int where  {-* MultiParamTypeClasses *-}
+  g _ _ _ = ()
+ test/ExtensionOrganizerTest/MultiParamTypeClassesTest/ZeroTyVars.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module ZeroTyVars where
+
+class C0 where  {-* MultiParamTypeClasses *-}
+  f :: ()
+
+instance C0 where  {-* MultiParamTypeClasses *-}
+  f = ()
+ test/ExtensionOrganizerTest/MultiWayIfTest/Definitions.hs view
@@ -0,0 +1,3 @@+module Definitions where
+
+data Rec = Rec { num :: Int }
+ test/ExtensionOrganizerTest/MultiWayIfTest/InCaseRhs.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE MultiWayIf #-}
+
+module InCaseRhs where
+
+f x = case x of
+        [] -> if | True -> 0 | False -> 1    {-* MultiWayIf *-}
+        xs -> if | True -> 0 | False -> 1    {-* MultiWayIf *-}
+ test/ExtensionOrganizerTest/MultiWayIfTest/InCompStmt.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE MultiWayIf #-}
+
+module InCompStmt where
+
+xs = [ (if | x == 0 -> 0 | x == 1 -> 1) | x <- [1..10] ] {-* MultiWayIf *-}
+
+ys = [ 2*y | y <- (if | 0 == 0 -> [] | 1 == 1 -> []) ]  {-* MultiWayIf *-}
+ test/ExtensionOrganizerTest/MultiWayIfTest/InExpr.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE MultiWayIf,
+             TupleSections
+             #-}
+
+module InExpr where
+
+import Definitions
+
+{-# ANN module "HLint: ignore Redundant lambda" #-}
+{-# ANN module "HLint: ignore Redundant bracket" #-}
+
+x1 = (if | True -> 0 | False -> 1) : [if | True -> 0 | False -> 1]  {-* MultiWayIf, MultiWayIf *-}
+
+x2 = - ((if | True -> id | False -> id) 6) {-* MultiWayIf *-}
+
+f1 g = g (if | True -> 0 | False -> 1)  {-* MultiWayIf *-}
+
+f2 g h = h g (if | True -> 0 | False -> 1)  {-* MultiWayIf *-}
+
+f3 = \x -> if | True -> 0 | False -> 1  {-* MultiWayIf *-}
+
+x3 = let x = (if | True -> id | False -> id) 5 in x {-* MultiWayIf *-}
+
+x4 = if (if | True -> id | False -> id) True       {-* MultiWayIf *-}
+       then (if | True -> 0 | False -> 1)       {-* MultiWayIf *-}
+       else (if | True -> 0 | False -> 2)       {-* MultiWayIf *-}
+
+x6 = case (if | True -> [] | False -> []) of  {-* MultiWayIf *-}
+       [] -> ()            
+       xs -> ()
+
+x7 = (if | True -> 0 | False -> 1, 5)       {-* MultiWayIf *-}
+
+x8 = (if | True -> 0 | False -> 1,)         {-* MultiWayIf, TupleSections *-}
+
+x9 = ([(if | True -> 0 | False -> 1)])      {-* MultiWayIf *-}
+
+f4 = ((if | True -> 0 | False -> 1) +)   {-* MultiWayIf *-}
+
+f5 = (+ (if | True -> 0 | False -> 1))   {-* MultiWayIf *-}
+
+x10 = Rec { num = (if | True -> 0 | False -> 1) }    {-* MultiWayIf *-}
+
+x11 r = r { num = (if | True -> 0 | False -> 1) }    {-* MultiWayIf *-}
+
+x12 = [(if | True -> 0 | False -> 1), (if | True -> 0 | False -> 1) .. (if | True -> 0 | False -> 1) ]    {-* MultiWayIf, MultiWayIf, MultiWayIf *-}
+
+x13 = (if | True -> 0 | False -> 1) :: Int   {-* MultiWayIf *-}
+ test/ExtensionOrganizerTest/MultiWayIfTest/InFieldUpdate.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE MultiWayIf #-}
+
+module InFieldUpdate where
+
+import Definitions
+
+f Rec { num = num } = Rec {num = if | True -> 0 | False -> 1} {-* MultiWayIf *-}
+ test/ExtensionOrganizerTest/MultiWayIfTest/InPattern.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE MultiWayIf,
+             ViewPatterns
+             #-}
+
+module InPattern where
+
+f ((if | True -> id | False -> id) -> []) = ()   {-* MultiWayIf, ViewPatterns *-}
+f ((if | True -> id | False -> id) -> ys) = ()   {-* MultiWayIf, ViewPatterns *-}
+ test/ExtensionOrganizerTest/MultiWayIfTest/InRhs.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE MultiWayIf #-}
+
+module InRhs where
+
+f [] = if | True -> 0 | False -> 1    {-* MultiWayIf *-}
+f x  = if | True -> 0 | False -> 1    {-* MultiWayIf *-}
+ test/ExtensionOrganizerTest/MultiWayIfTest/InRhsGuard.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE MultiWayIf #-}
+
+module InRhsGuard where
+
+f x
+  | y1 <- if | True -> 0 | False -> 1,   {-* MultiWayIf *-}
+    y2 <- if | True -> 0 | False -> 1    {-* MultiWayIf *-}
+  = ()
+  | z1 <- if | True -> 0 | False -> 1    {-* MultiWayIf *-}
+  = ()
+ test/ExtensionOrganizerTest/MultiWayIfTest/InStmt.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE MultiWayIf #-}
+
+module InStmt where
+
+f x = do
+  let k = if | True -> 0 | False -> 1          {-* MultiWayIf *-}
+  if | True -> Just 0 | False -> Just 1        {-* MultiWayIf *-}
+  y <- if | True -> Just 0 | False -> Just 1   {-* MultiWayIf *-}
+  z <- if | True -> Just 0 | False -> Just 1   {-* MultiWayIf *-}
+  return $ if | True -> 0 | False -> 1         {-* MultiWayIf *-}
+ test/ExtensionOrganizerTest/MultiWayIfTest/InTupSecElem.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE MultiWayIf,
+             TupleSections
+             #-}
+
+module InTupSecElem where
+
+f = (,if | True -> 0 | False -> 1) {-* MultiWayIf, TupleSections *-}
+ test/ExtensionOrganizerTest/OverloadedStringsTest/Newtype.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE OverloadedStrings #-}
+
+module Newtype where
+
+import GHC.Exts (IsString(..))
+
+newtype MyString = MyString String
+  deriving Eq
+
+instance IsString MyString where
+  fromString = MyString
+
+f :: MyString -> MyString
+f "asd" = "qwe"             {-* OverloadedStrings, OverloadedStrings *-}
+f x     = x
+ test/ExtensionOrganizerTest/OverloadedStringsTest/Other.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE OverloadedStrings #-}
+
+module Other where
+
+import GHC.Exts (IsString(..))
+import Data.Text
+
+f :: Text -> Text
+f "asd" = "qwe"     {-* OverloadedStrings, OverloadedStrings *-}
+f x     = x
+ test/ExtensionOrganizerTest/OverloadedStringsTest/Synonym.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE OverloadedStrings #-}
+
+-- the pragma is only enabled so that the OverloadedStrings checker runs
+module Synonym where
+
+import GHC.Exts (IsString(..))
+
+type MyString1 = [Char]
+type MyString2 = String
+
+f :: MyString1 -> MyString1
+f "asd" = "qwe"
+f x     = x
+
+g :: MyString2 -> MyString2
+g "asd" = "qwe"
+g x     = x
+ test/ExtensionOrganizerTest/ParallelListCompTest/Definitions.hs view
@@ -0,0 +1,3 @@+module Definitions where
+
+data Rec = Rec { num :: Int }
+ test/ExtensionOrganizerTest/ParallelListCompTest/InCaseRhs.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE ParallelListComp #-}
+
+module InCaseRhs where
+
+f x = case x of
+        [] -> [ (x,y) | x <- [1..10] | y <- [1..10] ]    {-* ParallelListComp *-}
+        xs -> [ (x,y) | x <- [1..10] | y <- [1..10] ]    {-* ParallelListComp *-}
+ test/ExtensionOrganizerTest/ParallelListCompTest/InCompStmt.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE ParallelListComp #-}
+
+module InCompStmt where
+
+{-# ANN module "HLint: ignore Redundant list comprehension" #-}
+
+xs = [ [ (x,y) | x <- [1..10] | y <- [1..10] ] | z <- [1..10] ] {-* ParallelListComp *-}
+
+ys = [ z | z <- [ (x,y) | x <- [1..10] | y <- [1..10] ] ]  {-* ParallelListComp *-}
+
+zs = [ [ (x,y) | x <- [1..10] | y <- [1..10] ] | z <- [ (x,y) | x <- [1..10] | y <- [1..10] ] ]  {-* ParallelListComp, ParallelListComp *-}
+ test/ExtensionOrganizerTest/ParallelListCompTest/InExpr.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE ParallelListComp,
+             MultiWayIf,
+             TupleSections
+             #-}
+
+module InExpr where
+
+import Definitions
+
+{-# ANN module "HLint: ignore Redundant lambda" #-}
+{-# ANN module "HLint: ignore Redundant bracket" #-}
+{-# ANN module "HLint: ignore Redundant if" #-}
+
+x1 = [ (x,y) | x <- [1..10] | y <- [1..10] ] : [[ (x,y) | x <- [1..10] | y <- [1..10] ]]  {-* ParallelListComp, ParallelListComp *-}
+
+x2 = length ([ (x,y) | x <- [1..10] | y <- [1..10] ]) {-* ParallelListComp *-}
+
+f1 g = g [ (x,y) | x <- [1..10] | y <- [1..10] ]  {-* ParallelListComp *-}
+
+f2 g h = h g ([ (x,y) | x <- [1..10] | y <- [1..10] ])  {-* ParallelListComp *-}
+
+f3 = \z -> [ (x,y) | x <- [1..10] | y <- [1..10] ]  {-* ParallelListComp *-}
+
+x3 = let z = [ (x,y) | x <- [1..10] | y <- [1..10] ] in z {-* ParallelListComp *-}
+
+x4 = if null [ (x,y) | x <- [1..10] | y <- [1..10] ]     {-* ParallelListComp *-}
+       then ([ (x,y) | x <- [1..10] | y <- [1..10] ])    {-* ParallelListComp *-}
+       else ([ (x,y) | x <- [1..10] | y <- [1..10] ])    {-* ParallelListComp *-}
+
+x5 = if | null [ (x,y) | x <- [1..10] | y <- [1..10] ] -> []                    {-* ParallelListComp *-}
+        | null [ (x,y) | x <- [1..10] | y <- [1..10] ] -> [ (x,y) | x <- [1..10] | y <- [1..10] ]   {-* ParallelListComp, ParallelListComp *-}
+        | otherwise -> [ (x,y) | x <- [1..10] | y <- [1..10] ]               {-* ParallelListComp, MultiWayIf *-}
+
+x6 = case [ (x,y) | x <- [1..10] | y <- [1..10] ] of  {-* ParallelListComp *-}
+       [] -> [ (x,y) | x <- [1..10] | y <- [1..10] ]             {-* ParallelListComp *-}
+       xs -> [ (x,y) | x <- [1..10] | y <- [1..10] ]             {-* ParallelListComp *-}
+
+x7 = ([ (x,y) | x <- [1..10] | y <- [1..10] ], 5)       {-* ParallelListComp *-}
+
+x8 = ([ (x,y) | x <- [1..10] | y <- [1..10] ],)         {-* ParallelListComp, TupleSections *-}
+
+x9 = ([[ (x,y) | x <- [1..10] | y <- [1..10] ]])      {-* ParallelListComp *-}
+
+f4 = (([ (x,y) | x <- [1..10] | y <- [1..10] ]) ++)   {-* ParallelListComp *-}
+
+f5 = (++ ([ (x,y) | x <- [1..10] | y <- [1..10] ]))   {-* ParallelListComp *-}
+
+x10 = Rec { num = length [ (x,y) | x <- [1..10] | y <- [1..10] ] }    {-* ParallelListComp *-}
+
+x11 r = r { num = length [ (x,y) | x <- [1..10] | y <- [1..10] ] }    {-* ParallelListComp *-}
+
+x12 = [(length [ (x,y) | x <- [1..10] | y <- [1..10] ]) .. (length [ (x,y) | x <- [1..10] | y <- [1..10] ]) ]    {-* ParallelListComp, ParallelListComp *-}
+
+x13 = (length [ (x,y) | x <- [1..10] | y <- [1..10] ]) :: Int   {-* ParallelListComp *-}
+
+-- x14 = (\case {_ -> 5}) @Int ((\case {_ -> 5}) 5)
+ test/ExtensionOrganizerTest/ParallelListCompTest/InFieldUpdate.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE ParallelListComp #-}
+
+module InFieldUpdate where
+
+import Definitions
+
+f Rec { num = num } = Rec {num = length ([ (x,y) | x <- [1..10] | y <- [1..10] ])} {-* ParallelListComp *-}
+ test/ExtensionOrganizerTest/ParallelListCompTest/InPattern.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE ParallelListComp,
+             ViewPatterns
+             #-}
+
+module InPattern where
+
+f (const [ (x,y) | x <- [1..10] | y <- [1..10] ] -> []) = ()   {-* ParallelListComp, ViewPatterns *-}
+f (const [ (x,y) | x <- [1..10] | y <- [1..10] ] -> ys) = ()   {-* ParallelListComp, ViewPatterns *-}
+ test/ExtensionOrganizerTest/ParallelListCompTest/InRhs.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE ParallelListComp #-}
+
+module InRhs where
+
+f [] = [ (x,y) | x <- [1..10] | y <- [1..10] ]    {-* ParallelListComp *-}
+f x  = [ (x,y) | x <- [1..10] | y <- [1..10] ]    {-* ParallelListComp *-}
+ test/ExtensionOrganizerTest/ParallelListCompTest/InRhsGuard.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE ParallelListComp #-}
+
+module InRhsGuard where
+
+f x
+  | y1 <- [ (x,y) | x <- [1..10] | y <- [1..10] ],   {-* ParallelListComp *-}
+    y2 <- [ (x,y) | x <- [1..10] | y <- [1..10] ]   {-* ParallelListComp *-}
+  = ()
+  | z1 <- [ (x,y) | x <- [1..10] | y <- [1..10] ]    {-* ParallelListComp *-}
+  = ()
+ test/ExtensionOrganizerTest/ParallelListCompTest/InStmt.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE ParallelListComp #-}
+
+module InStmt where
+
+f x = do
+  let k = [ (x,y) | x <- [1..10] | y <- [1..10] ]     {-* ParallelListComp *-}
+  Just [ (x,y) | x <- [1..10] | y <- [1..10] ]        {-* ParallelListComp *-}
+  y <- Just [ (x,y) | x <- [1..10] | y <- [1..10] ]   {-* ParallelListComp *-}
+  z <- Just [ (x,y) | x <- [1..10] | y <- [1..10] ]   {-* ParallelListComp *-}
+  return $ [ (x,y) | x <- [1..10] | y <- [1..10] ]    {-* ParallelListComp *-}
+ test/ExtensionOrganizerTest/ParallelListCompTest/InTupSecElem.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE ParallelListComp,
+             TupleSections
+             #-}
+
+module InTupSecElem where
+
+f = (,[ (x,y) | x <- [1..10] | y <- [1..10] ]) {-* ParallelListComp, TupleSections *-}
+ test/ExtensionOrganizerTest/Parser.hs view
@@ -0,0 +1,111 @@+module ExtensionOrganizerTest.Parser
+  ( module ExtensionOrganizerTest.Parser
+  , module Control.Applicative
+  , module Data.Char
+  ) where
+
+import Control.Applicative
+import Data.Char
+import Data.List (foldl')
+import Data.Maybe
+
+{-# ANN module "HLint: ignore Use mappend" #-}
+
+newtype Parser a = P (String -> [(a, String)])
+
+char :: Char -> Parser Char
+char c = matches (== c)
+
+matches :: (Char -> Bool) -> Parser Char
+matches p = P $ \s ->
+  case s of
+    (x:xs) | p x -> [(x, xs)]
+    _            -> []
+
+instance Functor Parser where
+  fmap f (P p) = P $ \s -> [ (f x, s') | (x, s') <- p s ]
+
+instance Applicative Parser where
+  pure x           = P $ \s -> [(x, s)]
+  (P pf) <*> (P q) = P $ \s -> [ (f x, s'') | (f, s') <- pf s, (x, s'') <- q s' ]
+
+instance Alternative Parser where
+  empty           = P $ const []
+  (P p) <|> (P q) = P $ \s -> p s ++ q s
+
+instance Monad Parser where
+  return = pure
+  --(>>=) :: Parser a -> (a -> Parser b) -> Parser b
+  --qs    :: Parser (Parser b) ~ P ( String -> [(Parser b, Strng)]
+  p >>= f = P (\s -> case f <$> p of
+                          P qs -> concat [ qs' s' | (P qs', s') <- qs s ] )
+
+
+times :: Int -> Parser a -> Parser [a]
+times 0 _ = pure []
+times n p = (:) <$> p <*> times (n-1) p
+
+--parseNInts :: Parser [Int]
+--parseNInts = (decimal <* whitespace) >>= (\n -> times n (decimal <* whitespace))
+
+token :: String -> Parser String
+token ""     = pure ""
+token (x:xs) = (:) <$> char x <*> token xs
+
+digit :: Parser Int
+digit = digitToInt <$> matches isDigit
+
+decimal :: Parser Int
+decimal = foldl' (\n x -> 10 * n + fromIntegral x) 0 <$> some digit
+
+string :: Parser String
+string = char '"' *> many (matches (/= '"')) <* char '"'
+
+word :: Parser String
+word = many $ matches isAlpha
+
+whitespace :: Parser String
+whitespace = many (matches isSpace)
+
+endParsing :: Parser ()
+endParsing = P $ const [((), "")]
+
+parserResult :: Parser a -> String -> [(a, String)]
+parserResult (P p) = p
+
+runParser :: Parser a -> String -> Maybe a
+runParser (P p) s =
+  case dropWhile (not . null . snd) $ p s of
+    ((x,""):_) -> Just x
+    _          -> Nothing
+
+execParser :: Parser a -> String -> a
+execParser p s = fromMaybe (error $ "execParser: Couldn't parse: " ++ s)
+                           (runParser p s)
+
+
+-- Examples for the monad instance
+{-
+parseNInts :: Parser [Int]
+parseNInts = do
+{
+  n   <-         (decimal <* whitespace);
+  res <- times n (decimal <* whitespace);
+  return res;
+}
+
+parseNTests :: Parser [[Int]]
+parseNTests = do
+{
+  numOfTests <- decimal';
+  tests <- times numOfTests (do
+  {
+    n    <-         decimal';
+    ints <- times n decimal';
+    return ints;
+  });
+
+  return tests;
+}
+  where decimal' = decimal <* whitespace
+-}
+ test/ExtensionOrganizerTest/RecursiveDoTest/MDo.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE RecursiveDo #-}
+
+module MDo where
+
+justOnes = mdo { xs <- Just (1:xs)
+               ; return (map negate xs) } {-* RecursiveDo *-}
+ test/ExtensionOrganizerTest/RecursiveDoTest/RecStmt.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE RecursiveDo #-}
+
+module RecStmt where
+
+justOnes = do { rec { xs <- Just (1:xs) } {-* RecursiveDo *-}
+              ; return (map negate xs) }
+ test/ExtensionOrganizerTest/TemplateHaskellTest/Quote.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE TemplateHaskellQuotes #-}
+
+module Quote where
+
+import Language.Haskell.TH
+
+add1 :: Int -> Q Exp
+add1 x = [| x + 1 |]  {-* TemplateHaskellQuotes *-}
+ test/ExtensionOrganizerTest/TemplateHaskellTest/Splice.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE TemplateHaskell #-}
+
+module Splice where
+
+import Quote
+
+two :: Int
+two = $(add1 1) {-* TemplateHaskell *-}
test/ExtensionOrganizerTest/TupleSectionsTest/InExpr.hs view
@@ -27,7 +27,7 @@ 
 x5 = if | fst $ (True,) 0 -> 20             {-* TupleSections *-}
         | snd $ (,True) 0 -> fst $ (0,) 5   {-* TupleSections, TupleSections *-}
-        | otherwise -> fst $ (0,) 5         {-* TupleSections *-} --MultiWayIf
+        | otherwise -> fst $ (0,) 5         {-* TupleSections, MultiWayIf *-}
 
 x6 = case fst $ ([],) () of  {-* TupleSections *-}
        [] -> (0,)             {-* TupleSections *-}
+ test/ExtensionOrganizerTest/TypeFamiliesTest/AssocDataFamily.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE TypeFamilies #-}
+
+module AssocDataFamily where
+
+class GMapKey k where
+  data GMap k :: * -> *  {-* TypeFamilies, KindSignatures, KindSignatures, KindSignatures *-}
+
+instance GMapKey Int where
+  data GMap Int [v]   = G1 v  {-* TypeFamilies *-}
+  data GMap Int (a,a) = G2 a  {-* TypeFamilies *-}
+ test/ExtensionOrganizerTest/TypeFamiliesTest/AssocGDataFamily.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE TypeFamilies, GADTSyntax #-}
+
+module AssocGDataFamily where
+
+class GC a where
+  data GD a :: * -> *           {-* TypeFamilies, KindSignatures, KindSignatures, KindSignatures *-}
+
+instance GC Int where
+  data GD Int a where
+    G1 :: Int -> a -> GD Int a  {-* TypeFamilies, GADTSyntax *-}
+ test/ExtensionOrganizerTest/TypeFamiliesTest/AssocTypeFamily.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE TypeFamilies #-}
+
+module AssocTypeFamily where
+
+class Collects ce where
+  type Elem ce :: *           {-* TypeFamilies, KindSignatures *-}
+  type instance Elem ce = ()  {-* TypeFamilies *-}
+
+instance Collects [a] where
+  type Elem [a] = a           {-* TypeFamilies *-}
+ test/ExtensionOrganizerTest/TypeFamiliesTest/ClosedTypeFamilyDecl.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE TypeFamilies #-}
+
+module ClosedTypeFamilyDecl where
+
+type family F a :: * where  {-* KindSignatures *-}
+  F Int  = Integer
+  F Char = String  {-* TypeFamilies *-}
+ test/ExtensionOrganizerTest/TypeFamiliesTest/DataFamilyDecl.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE TypeFamilies #-}
+
+module DataFamilyDecl where
+
+data family F a :: * {-* TypeFamilies, KindSignatures *-}
+
+data instance F Int  = F1  {-* TypeFamilies *-}
+data instance F Char = F2  {-* TypeFamilies *-}
+ test/ExtensionOrganizerTest/TypeFamiliesTest/Definitions.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE TypeFamilies
+           , ConstraintKinds
+           , RankNTypes
+            #-}
+
+module Definitions where
+
+type EqRel a b = a ~ b
+
+type TrfAB a b = a ~ b => a -> b
+
+type family F a :: * where
+  F Int  = Integer
+  F Char = String
+  F a    = a
+
+type HiddenEqRel a b = EqRel a b
+
+type ComplexEqRelType a =
+  Eq a => a -> a -> (forall c . HiddenEqRel a c => c -> c -> Bool) -> Bool  
+
+
+eqRelName :: EqRel a b => a -> b
+eqRelName = id
+ test/ExtensionOrganizerTest/TypeFamiliesTest/GDataFamilyDecl.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE TypeFamilies
+           , GADTs
+           #-}
+
+module GDataFamilyDecl where
+
+{-@ TypeFamilies, GADTs @-}
+
+data family G a b {-* TypeFamilies *-}
+
+data instance G [a] b where
+   G1 :: c -> G [Int] b     {-* GADTSyntax, GADTs + ExistentialQuantification *-}
+   G2 :: G [a] Bool         {-* TypeFamilies, GADTSyntax, GADTs + ExistentialQuantification *-}
+ test/ExtensionOrganizerTest/TypeFamiliesTest/NestedTypeEqualityContextSynonyms.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE TypeFamilies, RankNTypes #-}
+
+module NestedTypeEqualityContextSynonyms where
+
+import Definitions
+
+{-@ GADTs @-}
+
+f :: HiddenEqRel a b => a -> b  {-* TypeFamilies + GADTs, TypeFamilies + GADTs *-}
+f = id
+
+g :: ComplexEqRelType a  {-* TypeFamilies + GADTs, TypeFamilies + GADTs *-}
+g x y h = h x y          {-* TypeFamilies + GADTs *-}
+ test/ExtensionOrganizerTest/TypeFamiliesTest/NestedTypeEqualitySynonyms.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE TypeFamilies, ConstraintKinds #-}
+
+module NestedTypeEqualitySynonyms where
+
+import Definitions
+
+{-@ GADTs, ConstraintKinds @-}
+
+type TripleEq a b c = (HiddenEqRel a b, HiddenEqRel b c) {-* TypeFamilies + GADTs, TypeFamilies + GADTs, ConstraintKinds *-}
+ test/ExtensionOrganizerTest/TypeFamiliesTest/TypeEquality.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE TypeFamilies, ConstraintKinds #-}
+
+module TypeEquality where
+
+{-@ GADTs, ConstraintKinds @-}
+
+type DoubleEq a b c = (a ~ b, b ~ c) {-* TypeFamilies + GADTs, TypeFamilies + GADTs, TypeFamilies + GADTs, ConstraintKinds *-}
+ test/ExtensionOrganizerTest/TypeFamiliesTest/TypeEqualityContext.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE TypeFamilies #-}
+
+module TypeEqualityContext where
+
+{-@ GADTs @-}
+
+f :: a ~ b => a -> b  {-* TypeFamilies + GADTs, TypeFamilies + GADTs *-}
+f = id
+ test/ExtensionOrganizerTest/TypeFamiliesTest/TypeEqualityContextSynonyms.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE TypeFamilies #-}
+
+module TypeEqualityContextSynonyms where
+
+import Definitions
+
+{-@ GADTs @-}
+
+f :: EqRel a b => a -> b  {-* TypeFamilies + GADTs, TypeFamilies + GADTs *-}
+f = id
+
+g :: TrfAB a b  {-* TypeFamilies + GADTs, TypeFamilies + GADTs *-}
+g = id
+ test/ExtensionOrganizerTest/TypeFamiliesTest/TypeEqualityInName.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE TypeFamilies #-}
+
+module TypeEqualityInName where
+
+import Definitions
+
+{-@ GADTs @-}
+
+g = eqRelName {-* TypeFamilies + GADTs *-}
+ test/ExtensionOrganizerTest/TypeFamiliesTest/TypeEqualitySynonyms.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE TypeFamilies, ConstraintKinds #-}
+
+module TypeEqualitySynonyms where
+
+import Definitions
+
+{-@ GADTs, ConstraintKinds @-}
+
+type DoubleEq a b c = (EqRel a b, EqRel b c) {-* TypeFamilies + GADTs, TypeFamilies + GADTs, ConstraintKinds *-}
+ test/ExtensionOrganizerTest/TypeFamiliesTest/TypeFamilyDecl.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE TypeFamilies #-}
+
+module TypeFamilyDecl where
+
+type family F a :: * {-* TypeFamilies, KindSignatures *-}
+
+type instance F Int  = Integer  {-* TypeFamilies *-}
+type instance F Char = String   {-* TypeFamilies *-}
+ test/ExtensionOrganizerTest/TypeOperatorsTest/InfixClassDecl.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE TypeOperators, MultiParamTypeClasses #-}
+
+module InfixClassDecl where
+
+class a :?: b where  {-* MultiParamTypeClasses *-}
+  f :: a -> b -> ()  {-* TypeOperators *-}
+ test/ExtensionOrganizerTest/TypeOperatorsTest/InfixDataDecl.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE TypeOperators #-}
+
+module InfixDataDecl where
+
+data a :+: b = Plus a b  {-* TypeOperators *-}
+ test/ExtensionOrganizerTest/TypeOperatorsTest/InfixInstance.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE TypeOperators, MultiParamTypeClasses #-}
+
+module InfixInstance where
+
+import InfixClassDecl
+
+instance [a] :?: [b] where  {-* TypeOperators, MultiParamTypeClasses *-}
+  f _ _ = ()
+ test/ExtensionOrganizerTest/TypeOperatorsTest/InfixTypeAnnot.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE TypeOperators, ScopedTypeVariables #-}
+
+module InfixTypeAnnot where
+
+import InfixDataDecl
+import NormalDataDecl
+
+h :: forall a b . (:+:) a b -> (:-:) a b  {-* ExplicitForAll *-}
+h (Plus x y) = Minus x y :: a :-: b  {-* TypeOperators *-}
+ test/ExtensionOrganizerTest/TypeOperatorsTest/InfixTypeSig.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE TypeOperators #-}
+
+module InfixTypeSig where
+
+import InfixDataDecl
+
+h :: a :+: b -> ()  {-* TypeOperators *-}
+h _ = ()
+ test/ExtensionOrganizerTest/TypeOperatorsTest/NormalClassDecl.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE TypeOperators, MultiParamTypeClasses #-}
+
+module NormalClassDecl where
+
+class (:!:) a b where  {-* MultiParamTypeClasses *-}
+  g :: a -> b -> ()    {-* TypeOperators *-}
+ test/ExtensionOrganizerTest/TypeOperatorsTest/NormalDataDecl.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE TypeOperators #-}
+
+module NormalDataDecl where
+
+data (:-:) a b = Minus a b  {-* TypeOperators *-}
+ test/ExtensionOrganizerTest/TypeOperatorsTest/NormalInstance.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE TypeOperators, MultiParamTypeClasses #-}
+
+module NormalInstance where
+
+import NormalClassDecl
+
+instance (:!:) [a] [b] where  {-* MultiParamTypeClasses *-}
+  g _ _ = ()
test/Main.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE LambdaCase, TypeFamilies #-}
+{-# LANGUAGE LambdaCase, MonoLocalBinds #-}
+
            
 module Main where
 
@@ -33,194 +34,25 @@ --import ExtensionOrganizerTest.Main (extensionOrganizerTestGroup)
 
 main :: IO ()
-main = defaultMain nightlyTests
-
-nightlyTests :: TestTree
-nightlyTests
-  = testGroup "all tests" [ testGroup "functional tests" functionalTests
-                          , testGroup "CppHs tests" $ map makeCpphsTest cppHsTests
-                          , testGroup "instance-control tests" $ map makeInstanceControlTest instanceControlTests
-                          ]
-
-functionalTests :: [TestTree]
-functionalTests
-  = [ testGroup "reprint tests" (map makeReprintTest checkTestCases)
-    , testGroup "refactor tests"
-        $ map makeOrganizeImportsTest organizeImportTests
-            ++ map makeGenerateSignatureTest generateSignatureTests
-            ++ map makeWrongGenerateSigTest wrongGenerateSigTests
-            ++ map makeGenerateExportsTest generateExportsTests
-            ++ map makeRenameDefinitionTest renameDefinitionTests
-            ++ map makeWrongRenameDefinitionTest wrongRenameDefinitionTests
-            ++ map makeExtractBindingTest extractBindingTests
-            ++ map makeWrongExtractBindingTest wrongExtractBindingTests
-            ++ map makeInlineBindingTest inlineBindingTests
-            ++ map makeWrongInlineBindingTest wrongInlineBindingTests
-            ++ map makeFloatOutTest floatOutTests
-            ++ map makeWrongFloatOutTest wrongFloatOutTests
-            ++ map (makeMultiModuleTest checkMultiResults) multiModuleTests
-            ++ map (makeMultiModuleTest checkMultiFail) wrongMultiModuleTests
-    ]
-  where checkTestCases = languageTests
-                          ++ organizeImportTests
-                          ++ map fst generateSignatureTests
-                          ++ generateExportsTests
-                          ++ map (\(mod,_,_) -> mod) renameDefinitionTests
-                          ++ map (\(mod,_,_) -> mod) wrongRenameDefinitionTests
-                          ++ map (\(mod,_,_) -> mod) extractBindingTests
-                          ++ map (\(mod,_,_) -> mod) wrongExtractBindingTests
-                          ++ map (\(mod,_) -> mod) inlineBindingTests
+main = defaultMain $ testGroup "refactor tests"
+                       $ map makeOrganizeImportsTest organizeImportTests
+                           ++ map makeGenerateSignatureTest generateSignatureTests
+                           ++ map makeWrongGenerateSigTest wrongGenerateSigTests
+                           ++ map makeGenerateExportsTest generateExportsTests
+                           ++ map makeRenameDefinitionTest renameDefinitionTests
+                           ++ map makeWrongRenameDefinitionTest wrongRenameDefinitionTests
+                           ++ map makeExtractBindingTest extractBindingTests
+                           ++ map makeWrongExtractBindingTest wrongExtractBindingTests
+                           ++ map makeInlineBindingTest inlineBindingTests
+                           ++ map makeWrongInlineBindingTest wrongInlineBindingTests
+                           ++ map makeFloatOutTest floatOutTests
+                           ++ map makeAutoCorrectTest autoCorrectTests
+                           ++ map makeWrongFloatOutTest wrongFloatOutTests
+                           ++ map (makeMultiModuleTest checkMultiResults) multiModuleTests
+                           ++ map (makeMultiModuleTest checkMultiFail) wrongMultiModuleTests
 
 rootDir = "examples"
 
-languageTests =
-  [ "CPP.JustEnabled"
-  , "CPP.ConditionalCode"
-  , "Decl.AmbiguousFields"
-  , "Decl.AnnPragma"
-  , "Decl.ClassInfix"
-  , "Decl.ClosedTypeFamily"
-  , "Decl.CompletePragma"
-  , "Decl.CtorOp"
-  , "Decl.DataFamily"
-  , "Decl.DataType"
-  , "Decl.DataInstanceGADT"
-  , "Decl.DataTypeDerivings"
-  , "Decl.DefaultDecl"
-  , "Decl.FunBind"
-  , "Decl.FunctionalDeps"
-  , "Decl.FunGuards"
-  , "Decl.GADT"
-  , "Decl.GadtConWithCtx"
-  , "Decl.InfixAssertion"
-  , "Decl.InfixInstances"
-  , "Decl.InfixPatSyn"
-  , "Decl.InjectiveTypeFamily"
-  , "Decl.InlinePragma"
-  , "Decl.InstanceFamily"
-  , "Decl.InstanceOverlaps"
-  , "Decl.InstanceSpec"
-  , "Decl.LocalBindings"
-  , "Decl.LocalBindingInDo"
-  , "Decl.LocalFixity"
-  , "Decl.MinimalPragma"
-  , "Decl.MultipleFixity"
-  , "Decl.MultipleSigs"
-  , "Decl.OperatorBind"
-  , "Decl.OperatorDecl"
-  , "Decl.ParamDataType"
-  , "Decl.PatternBind"
-  , "Decl.PatternSynonym"
-  , "Decl.RecordPatternSynonyms"
-  , "Decl.RecordType"
-  , "Decl.RewriteRule"
-  , "Decl.SpecializePragma"
-  , "Decl.StandaloneDeriving"
-  , "Decl.TypeClass"
-  , "Decl.TypeClassMinimal"
-  , "Decl.TypeFamily"
-  , "Decl.TypeFamilyKindSig"
-  , "Decl.TypeInstance"
-  , "Decl.TypeRole"
-  , "Decl.TypeSynonym"
-  , "Decl.ValBind"
-  , "Decl.ViewPatternSynonym"
-  , "Expr.ArrowNotation"
-  , "Expr.Case"
-  , "Expr.DoNotation"
-  , "Expr.GeneralizedListComp"
-  , "Expr.EmptyCase"
-  , "Expr.FunSection"
-  , "Expr.If"
-  , "Expr.LambdaCase"
-  , "Expr.ListComp"
-  , "Expr.MultiwayIf"
-  , "Expr.Negate"
-  , "Expr.Operator"
-  , "Expr.ParenName"
-  , "Expr.ParListComp"
-  , "Expr.PatternAndDo"
-  , "Expr.RecordPuns"
-  , "Expr.RecordWildcards"
-  , "Expr.RecursiveDo"
-  , "Expr.Sections"
-  , "Expr.SemicolonDo"
-  , "Expr.StaticPtr"
-  , "Expr.TupleSections"
-  , "Expr.UnboxedSum"
-  , "Module.Simple"
-  , "Module.GhcOptionsPragma"
-  , "Module.Export"
-  , "Module.ExportSubs"
-  , "Module.ExportModifiers"
-  , "Module.NamespaceExport"
-  , "Module.Import"
-  , "Module.ImportOp"
-  , "Module.LangPragmas"
-  , "Module.PatternImport"
-  , "Pattern.Backtick"
-  , "Pattern.Constructor"
-  -- , "Pattern.ImplicitParams"
-  , "Pattern.Infix"
-  , "Pattern.NestedWildcard"
-  , "Pattern.NPlusK"
-  , "Pattern.OperatorPattern"
-  , "Pattern.Record"
-  , "Pattern.UnboxedSum"
-  , "Type.Bang"
-  , "Type.Builtin"
-  , "Type.Ctx"
-  , "Type.ExplicitTypeApplication"
-  , "Type.Forall"
-  , "Type.Primitives"
-  , "Type.TupleAssert"
-  , "Type.TypeOperators"
-  , "Type.Unpack"
-  , "Type.Wildcard"
-  , "TH.Brackets"
-  , "TH.QuasiQuote.Define"
-  , "TH.QuasiQuote.Use"
-  , "TH.Splice.Define"
-  , "TH.Splice.Use"
-  , "TH.CrossDef"
-  , "TH.ClassUse"
-  , "TH.Splice.UseImported"
-  , "TH.Splice.UseQual"
-  , "TH.Splice.UseQualMulti"
-  , "TH.LocalDefinition"
-  , "TH.MultiImport"
-  , "TH.NestedSplices"
-  , "TH.Quoted"
-  , "TH.WithWildcards"
-  , "TH.DoubleSplice"
-  , "TH.GADTFields"
-  , "Refactor.CommentHandling.CommentTypes"
-  , "Refactor.CommentHandling.BlockComments"
-  , "Refactor.CommentHandling.Crosslinking"
-  , "Refactor.CommentHandling.FunctionArgs"
-  ]
-
-cppHsTests =
-  [ "Language.Preprocessor.Cpphs"
-  , "Language.Preprocessor.Unlit"
-  , "Language.Preprocessor.Cpphs.CppIfdef"
-  , "Language.Preprocessor.Cpphs.HashDefine"
-  , "Language.Preprocessor.Cpphs.MacroPass"
-  , "Language.Preprocessor.Cpphs.Options"
-  , "Language.Preprocessor.Cpphs.Position"
-  , "Language.Preprocessor.Cpphs.ReadFirst"
-  , "Language.Preprocessor.Cpphs.RunCpphs"
-  , "Language.Preprocessor.Cpphs.SymTab"
-  , "Language.Preprocessor.Cpphs.Tokenise"
-  ]
-
-instanceControlTests =
-  [ "Control.Instances.Test"
-  , "Control.Instances.Morph"
-  , "Control.Instances.ShortestPath"
-  , "Control.Instances.TypeLevelPrelude"
-  ]
-
 organizeImportTests =
   [ "Refactor.OrganizeImports.Narrow"
   , "Refactor.OrganizeImports.Reorder"
@@ -252,6 +84,8 @@   , "Refactor.OrganizeImports.MakeExplicit.Renamed"
   , "Refactor.OrganizeImports.InstanceCarry.ImportOrphan"
   , "Refactor.OrganizeImports.InstanceCarry.ImportNonOrphan"
+  , "Refactor.OrganizeImports.InstanceCarry.Duplicate"
+  , "Refactor.OrganizeImports.InstanceCarry.Transitive"
   , "Refactor.OrganizeImports.NarrowQual"
   , "Refactor.OrganizeImports.NarrowSpec"
   , "Refactor.OrganizeImports.StandaloneDeriving"
@@ -443,6 +277,21 @@ wrongMultiModuleTests =
   [ ("InlineBinding 3:1-3:2", "A", "Refactor" </> "InlineBinding" </> "AppearsInAnother", [])
   ]
+  
+autoCorrectTests =
+  [ ("Refactor.AutoCorrect.SimpleReParen", "3:5-3:12")
+  , ("Refactor.AutoCorrect.ExternalInstanceReParen", "4:5-4:15")
+  , ("Refactor.AutoCorrect.ComplexExprReParen", "3:5-3:29")
+  , ("Refactor.AutoCorrect.SimpleReOrder", "3:5-3:10")
+  , ("Refactor.AutoCorrect.ThreeArgReOrder", "3:5-3:12")
+  , ("Refactor.AutoCorrect.ThreeArgFirstReOrder", "3:5-3:10")
+  , ("Refactor.AutoCorrect.ExternalInstanceReOrder", "3:5-3:11")
+  , ("Refactor.AutoCorrect.ComplexExprReOrder", "3:5-3:22")
+  , ("Refactor.AutoCorrect.OwnInstanceReOrder", "5:5-5:10")
+  , ("Refactor.AutoCorrect.ComplexExprReOrder2", "3:5-3:39")
+  , ("Refactor.AutoCorrect.SectionReOrder", "3:5-3:18")
+  , ("Refactor.AutoCorrect.TupleSectionReOrder", "4:5-4:15")
+  ]
 
 makeMultiModuleTest :: ((String, String, String, [String]) -> Either String [(String, Maybe String)] -> IO ())
                          -> (String, String, String, [String]) -> TestTree
@@ -469,8 +318,12 @@ 
 createTest :: String -> [String] -> String -> TestTree
 createTest refactoring args mod
-  = testCase mod $ checkCorrectlyTransformed (refactoring ++ (concatMap (" "++) args)) rootDir mod
+  = testCase mod $ checkCorrectlyTransformed False (refactoring ++ (concatMap (" "++) args)) rootDir mod
 
+createResilientTest :: String -> [String] -> String -> TestTree
+createResilientTest refactoring args mod
+  = testCase mod $ checkCorrectlyTransformed True (refactoring ++ (concatMap (" "++) args)) rootDir mod
+
 createFailTest :: String -> [String] -> String -> TestTree
 createFailTest refactoring args mod
   = testCase mod $ checkTransformFails (refactoring ++ (concatMap (" "++) args)) rootDir mod
@@ -511,12 +364,17 @@ makeWrongFloatOutTest :: (String, String) -> TestTree
 makeWrongFloatOutTest (mod, rng) = createFailTest "FloatOut" [rng] mod
 
-checkCorrectlyTransformed :: String -> String -> String -> IO ()
-checkCorrectlyTransformed command workingDir moduleName
+makeAutoCorrectTest :: (String, String) -> TestTree
+makeAutoCorrectTest (mod, rng) = createResilientTest "AutoCorrect" [rng] mod
+
+
+checkCorrectlyTransformed :: Bool -> String -> String -> String -> IO ()
+checkCorrectlyTransformed suppressErrors command workingDir moduleName
   = do expected <- loadExpected True workingDir moduleName
-       res <- performRefactor command workingDir [] moduleName
+       res <- performRefactor command workingDir (if suppressErrors then deferFlags else []) moduleName
        assertEqual "The transformed result is not what is expected" (Right (standardizeLineEndings expected))
                                                                     (mapRight standardizeLineEndings res)
+  where deferFlags = ["-fdefer-type-errors","-fdefer-typed-holes","-fdefer-out-of-scope-variables", "-w"]
 
 testRefactor :: (UnnamedModule -> LocalRefactoring) -> String -> IO (Either String String)
 testRefactor refact moduleName
@@ -541,30 +399,6 @@      hGetContents expectedHandle
 
 standardizeLineEndings = filter (/= '\r')
-
-makeReprintTest :: String -> TestTree
-makeReprintTest mod = testCase mod (checkCorrectlyPrinted rootDir mod)
-
-makeCpphsTest :: String -> TestTree
-makeCpphsTest mod = testCase mod (checkCorrectlyPrinted (rootDir </> "CppHs") mod)
-
-makeInstanceControlTest :: String -> TestTree
-makeInstanceControlTest mod = testCase mod (checkCorrectlyPrinted (rootDir </> "InstanceControl") mod)
-
-checkCorrectlyPrinted :: String -> String -> IO ()
-checkCorrectlyPrinted workingDir moduleName
-  = do -- need to use binary or line endings will be translated
-       expectedHandle <- openBinaryFile (workingDir </> map (\case '.' -> pathSeparator; c -> c) moduleName ++ ".hs") ReadMode
-       expected <- hGetContents expectedHandle
-       (actual, actual', actual'') <- runGhc (Just libdir) $ do
-         parsed <- loadModule workingDir moduleName
-         actual <- prettyPrint <$> parseAST parsed
-         actual' <- prettyPrint <$> parseRenamed parsed
-         actual'' <- prettyPrint <$> parseTyped parsed
-         return (actual, actual', actual'')
-       assertEqual "Parsed: The original and the transformed source differ" expected actual
-       assertEqual "Renamed: The original and the transformed source differ" expected actual'
-       assertEqual "Typechecked: The original and the transformed source differ" expected actual''
 
 performRefactors :: String -> String -> [String] -> String -> IO (Either String [(String, Maybe String)])
 performRefactors command workingDir flags target = do