packages feed

haskell-tools-builtin-refactorings (empty) → 1.0.0.0

raw patch · 575 files changed

+9957/−0 lines, 575 filesdep +Cabaldep +basedep +containerssetup-changed

Dependencies added: Cabal, base, containers, directory, either, filepath, ghc, ghc-paths, haskell-tools-ast, haskell-tools-backend-ghc, haskell-tools-builtin-refactorings, haskell-tools-prettyprint, haskell-tools-refactor, haskell-tools-rewrite, mtl, old-time, polyparse, references, split, tasty, tasty-hunit, template-haskell, time, transformers, uniplate

This diff is very large; some files are shown as “too large to diff”. Download the raw patch for the complete diff.

Files

+ LICENSE view
@@ -0,0 +1,29 @@+Haskell-Tools is Copyright (c) Boldizsár Németh, 2016, all rights reserved,
+and is distributed as free software under the following license.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+- Redistributions of source code must retain the above copyright
+notice, this list of conditions, and the following disclaimer.
+
+- Redistributions in binary form must reproduce the above copyright
+notice, this list of conditions, and the following disclaimer in the
+documentation and/or other materials provided with the distribution.
+
+- The names of the copyright holders may not be used to endorse or
+promote products derived from this software without specific prior
+written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY
+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
+BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
+IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Language/Haskell/Tools/Refactor/Builtin.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
+module Language.Haskell.Tools.Refactor.Builtin ( builtinRefactorings ) where
+
+import Language.Haskell.Tools.Refactor (RefactoringChoice)
+import Language.Haskell.Tools.Refactor.Builtin.ExtractBinding (ExtractBindingDomain, extractBindingRefactoring)
+import Language.Haskell.Tools.Refactor.Builtin.FloatOut (floatOutRefactoring)
+import Language.Haskell.Tools.Refactor.Builtin.GenerateExports (DomGenerateExports, generateExportsRefactoring)
+import Language.Haskell.Tools.Refactor.Builtin.GenerateTypeSignature (GenerateSignatureDomain, generateTypeSignatureRefactoring)
+import Language.Haskell.Tools.Refactor.Builtin.InlineBinding (inlineBindingRefactoring)
+import Language.Haskell.Tools.Refactor.Builtin.OrganizeExtensions (OrganizeExtensionsDomain, organizeExtensionsRefactoring, projectOrganizeExtensionsRefactoring)
+import Language.Haskell.Tools.Refactor.Builtin.OrganizeImports (OrganizeImportsDomain, organizeImportsRefactoring, projectOrganizeImportsRefactoring)
+import Language.Haskell.Tools.Refactor.Builtin.RenameDefinition (DomainRenameDefinition, renameDefinitionRefactoring)
+
+builtinRefactorings :: ( DomGenerateExports dom, OrganizeImportsDomain dom
+                       , DomainRenameDefinition dom, ExtractBindingDomain dom
+                       , GenerateSignatureDomain dom, OrganizeExtensionsDomain dom
+                       ) => [RefactoringChoice dom]
+builtinRefactorings
+  = [ organizeImportsRefactoring
+    , projectOrganizeImportsRefactoring
+    , inlineBindingRefactoring
+    , generateTypeSignatureRefactoring
+    , renameDefinitionRefactoring
+    , generateExportsRefactoring
+    , floatOutRefactoring
+    , extractBindingRefactoring
+    , organizeExtensionsRefactoring
+    , projectOrganizeExtensionsRefactoring
+    ]
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers.hs view
@@ -0,0 +1,25 @@+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
+  ) 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
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/BangPatternsChecker.hs view
@@ -0,0 +1,28 @@+{-# 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
+
+chkBangPatterns' :: CheckNode Pattern
+chkBangPatterns' p@(BangPat _) = addOccurence BangPatterns p
+chkBangPatterns' x = return x
+
+{-
+  RhsGuard DONE
+  MatchLhs DONE
+  ValueBind DONE
+  Expr DONE
+  Alt DONE
+  Stmt DONE
+  Pattern MORE TESTS
+  Bracket ASK
+  PatSynRhs DONE
+-}
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/DerivingsChecker.hs view
@@ -0,0 +1,275 @@+{-# LANGUAGE FlexibleContexts, MultiWayIf, RankNTypes, TypeFamilies, ViewPatterns #-}
+
+{-
+  NOTE: We need Decl level checking in order to gain extra information
+        from the newtype and data keywords.
+  NOTE: Here we implicitly constrained the type with ExtDomain.
+        but we only really need HasNameInfo.
+
+        When a strategy is not explicitly given, every single extension
+        is analysied individually, so every occurence induces a separate
+        extension. However, when a strategy is specified, we only add
+        GND and DeriveAnyClass once, since no further examination is needed.
+
+        For examples see the test files.
+
+  SEE:  https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/DerivingStrategies#Thederivingstrategyresolutionalgorithm
+
+  TODO:
+  - write tests for GADTs, data instances
+  - correct DerivingStrategies behaviour with StandaloneDeriving
+-}
+
+
+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.DerivingsChecker where
+
+import Control.Reference ((^.), (!~), (&))
+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)
+
+-- can be derived
+isStockClass = flip elem stockClasses
+stockClasses = [ eqClassName
+               , ordClassName
+               , ixClassName
+               , showClassName
+               , readClassName
+               , enumClassName
+               , boundedClassName
+               , dataClassName
+               , typeableClassName
+               , genClassName
+               , gen1ClassName
+               , functorClassName
+               , foldableClassName
+               , traversableClassName
+               , liftClassName
+               ]
+
+-- can be derived for newtypes even without GND
+gndNotNeeded :: GHC.Name -> Bool
+gndNotNeeded = flip elem gndNotNeededClasses
+gndNotNeededClasses =
+  [ eqClassName
+  , ordClassName
+  , ixClassName
+  , boundedClassName
+  ]
+
+-- can be derived for newtypes with GND
+gndNeeded :: GHC.Name -> Bool
+gndNeeded = flip elem gndNeededClasses
+gndNeededClasses =
+  [ functorClassName
+  , foldableClassName
+  , enumClassName
+  ]
+
+-- never selected by default for newtypes (even with GND)
+gndNotAllowed :: GHC.Name -> Bool
+gndNotAllowed = flip elem gndNotAllowedClasses
+gndNotAllowedClasses =
+  [ dataClassName
+  , typeableClassName
+  , showClassName
+  , readClassName
+  , traversableClassName
+  , genClassName
+  , gen1ClassName
+  , liftClassName
+  ]
+
+whichExtension :: GHC.Name -> Maybe Extension
+whichExtension    = flip Map.lookup nameExtensionMap
+
+nameExtensionMap = Map.fromList nameExtensions
+  where nameExtensions = [ (dataClassName,        DeriveDataTypeable)
+                         , (typeableClassName,    DeriveDataTypeable)
+                         , (genClassName,         DeriveGeneric)
+                         , (gen1ClassName,        DeriveGeneric)
+                         , (functorClassName,     DeriveFunctor)
+                         , (foldableClassName,    DeriveFoldable)
+                         , (traversableClassName, DeriveTraversable)
+                         , (liftClassName,        DeriveLift)
+                         ]
+
+chkDerivings :: CheckNode Decl
+chkDerivings = conditionalAny chkDerivings'         derivingExts
+           >=> conditional    chkStandaloneDeriving Ext.StandaloneDeriving
+
+      where chkDerivings' = chkDataDecl
+                        >=> chkGADTDataDecl
+                        >=> chkDataInstance
+
+            derivingExts = [ DeriveDataTypeable
+                           , DeriveGeneric
+                           , DeriveFunctor
+                           , DeriveFoldable
+                           , DeriveTraversable
+                           , DeriveLift
+                           , DeriveAnyClass
+                           , GeneralizedNewtypeDeriving
+                           , DerivingStrategies
+                           ]
+
+
+chkDataDecl :: CheckNode Decl
+chkDataDecl d@(DataDecl keyw _ _ _ derivs) = do
+  annList !~ separateByKeyword keyw $ derivs
+  return d
+chkDataDecl d = return d
+
+chkGADTDataDecl :: CheckNode Decl
+chkGADTDataDecl d@(GADTDataDecl keyw _ _ _ _ derivs) = do
+  addOccurence_ GADTs d
+  annList !~ separateByKeyword keyw $ derivs
+  return d
+chkGADTDataDecl d = return d
+
+chkDataInstance :: CheckNode Decl
+chkDataInstance d@(DataInstance keyw _ _ derivs) = do
+  addOccurence_ TypeFamilies d
+  annList !~ separateByKeyword keyw $ derivs
+  return d
+chkDataInstance d = return d
+
+
+separateByKeyword :: DataOrNewtypeKeyword dom -> CheckNode Deriving
+separateByKeyword keyw derivs
+  | isNewtypeDecl keyw = chkByStrat chkClassForNewtype derivs
+  | otherwise          = chkByStrat chkClassForData    derivs
+  where isNewtypeDecl keyw = case keyw ^. element of
+                               UNewtypeKeyword -> True
+                               _               -> False
+
+
+getStrategy :: Deriving dom -> Maybe (DeriveStrategy dom)
+getStrategy d = d ^. (deriveStrategy & annMaybe)
+
+addExtension :: (MonadState ExtMap m, HasRange node) =>
+                 GHC.Name -> node -> m node
+addExtension sname
+  | Just ext <- whichExtension sname = addOccurence ext
+  | otherwise                        = return
+
+addStockExtension :: CheckNode InstanceHead
+addStockExtension x
+  | Just sname <- nameFromStock x = addExtension sname x
+  | otherwise = return x
+
+chkByStrat :: CheckNode' InstanceHead dom -> CheckNode' Deriving dom
+chkByStrat checker d
+  | Just strat <- getStrategy d = do
+    addOccurence DerivingStrategies d
+    chkDerivingClause (chkStrat strat) d
+  | otherwise =
+    chkDerivingClause checker d
+
+chkStrat :: DeriveStrategy dom -> CheckNode' InstanceHead dom
+chkStrat (_element -> UStockStrategy)    = addStockExtension
+chkStrat (_element -> UNewtypeStrategy)  = addOccurence GeneralizedNewtypeDeriving
+chkStrat (_element -> UAnyClassStrategy) = addOccurence DeriveAnyClass
+
+chkDerivingClause :: CheckNode' InstanceHead dom -> CheckNode' Deriving dom
+chkDerivingClause checker d@(DerivingOne   x)  = checker x               >> return d
+chkDerivingClause checker d@(DerivingMulti xs) = (annList !~ checker) xs >> return d
+
+-- checks whether the class is stock, and if it is, returns its name
+nameFromStock :: HasNameInfo dom => InstanceHead dom -> Maybe GHC.Name
+nameFromStock x
+  | InstanceHead name <- skipParens x,
+    Just sname <- getSemName name,
+    isStockClass sname
+    = Just sname
+  | otherwise = Nothing
+
+chkClassForData :: CheckNode InstanceHead
+chkClassForData x
+  | Just sname <- nameFromStock x = addExtension sname x
+  | otherwise = addOccurence DeriveAnyClass x
+
+-- performs check in case no explicit strategy is given
+chkClassForNewtype :: CheckNode InstanceHead
+chkClassForNewtype x
+  | Just sname <- nameFromStock x
+    = if | gndNotNeeded  sname -> return x
+         | gndNeeded     sname -> addOccurence GeneralizedNewtypeDeriving x
+         | gndNotAllowed sname -> addExtension sname x
+  | otherwise = do
+      gndOn       <- isTurnedOn GeneralizedNewtypeDeriving
+      deriveAnyOn <- isTurnedOn DeriveAnyClass
+      if | gndOn && deriveAnyOn -> addOccurence_ DeriveAnyClass x
+         | deriveAnyOn          -> addOccurence_ DeriveAnyClass x
+         | gndOn                -> addOccurence_ GeneralizedNewtypeDeriving x
+         | otherwise             -> return ()
+      return x
+
+skipParens :: InstanceHead dom -> InstanceHead dom
+skipParens (ParenInstanceHead x) = skipParens x
+skipParens x = x
+
+chkStandaloneDeriving :: CheckNode Decl
+chkStandaloneDeriving d@(Refact.StandaloneDeriving strat _ (decompRule -> (cls,ty)))
+  | Just strat' <- strat = do
+    addOccurence_  Ext.DerivingStrategies d
+    addOccurence_  Ext.StandaloneDeriving d
+    chkSynonym ty
+    chkStrat strat' cls
+    return d
+  | otherwise = do
+    addOccurence_  Ext.StandaloneDeriving d
+    itIsNewType    <- isNewtype ty
+    itIsSynNewType <- isSynNewType ty
+    if itIsNewType || itIsSynNewType
+      then chkClassForNewtype cls
+      else chkClassForData    cls
+    return d
+chkStandaloneDeriving d = return d
+
+decompRule :: InstanceRule dom -> (InstanceHead dom, Type dom)
+decompRule instRule = (cls, ty)
+  where ihead = instRule  ^. irHead
+        cls   = getClassCon   ihead
+        ty    = rightmostType ihead
+
+getClassCon :: InstanceHead dom -> InstanceHead dom
+getClassCon (AppInstanceHead f _) = getClassCon f
+getClassCon (ParenInstanceHead x) = getClassCon x
+getClassCon x = x
+
+rightmostType :: InstanceHead dom -> Type dom
+rightmostType ihead
+  | AppInstanceHead _ tyvar <- skipParens ihead = tyvar
+
+{-
+  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
+  in which case GeneralizedNewtypeDeriving might be necessary.
+-}
+isSynNewType :: HasNameInfo dom => Type dom -> ExtMonad Bool
+isSynNewType t = do
+  mtycon <- runMaybeT . lookupType $ t
+  case mtycon of
+    Nothing    -> return True
+    Just tycon -> isSynNewType' tycon
+  where isSynNewType' x = case lookupSynDef x of
+                            Nothing  -> return False
+                            Just def -> do
+                                        addOccurence_ TypeSynonymInstances t
+                                        return (GHC.isNewTyCon def)
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/FlexibleInstancesChecker.hs view
@@ -0,0 +1,182 @@+{-# LANGUAGE FlexibleContexts, MultiWayIf, TypeFamilies #-}
+
+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 Control.Monad.Trans.Maybe (MaybeT(..))
+import Data.Data (Data(..))
+import Data.List (nub)
+
+import Name as GHC (isTyVarName, isTyConName, isWiredInName)
+
+{-# 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 :: ExtDomain dom => InstanceRule dom -> a -> ExtMonad a
+checkedReturn rule x = chkInstanceRule rule >> return x
+
+-- 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
+
+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
+
+
+-- 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)
+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
+
+-- 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
+
+  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
+                (addOccurence_ FlexibleInstances vars)
+            Nothing   -> error "chkTyVars: Couldn't look up something"
+          return vars
+
+        chkAll x =
+          ifM (chkTopLevel x) $
+            chkOnlyApp x
+
+        chkTopLevel x = -- NOTE: this resembles a monadic bind ... (Cont?)
+          ifM (chkListType x) .
+            ifM (chkTupleType x) .
+              ifM (chkUnitTyCon x) $
+                return False
+
+        ifM cond f = do b <- cond; if b then (return b) else f
+
+        chkUnitTyCon (VarType x) = do
+          sname <- tyVarSemNameM x
+          -- standalone top-level type variables are not accepted
+          -- 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
+        chkUnitTyCon _ = return False
+
+
+        chkSingleTyVar (VarType x) = do
+          sname <- tyVarSemNameM x
+          if (isTyVarName sname)
+            then addTyVarM x >> return True
+            else addTyConM x >> return False
+        chkSingleTyVar _ = return False
+
+
+        chkTupleType (TupleType args) = do
+          let xs  = args ^. annListElems
+          bs <- mapM chkSingleTyVar xs
+          return $! and bs
+        chkTupleType _ = return False
+
+        chkListType (ListType v) = chkSingleTyVar v
+        chkListType _            = return False
+
+        chkOnlyApp :: (MonadState ([Name dom],[Name dom]) (m1 m2),
+                       MonadTrans m1,
+                       MonadState ExtMap m2,
+                       ExtDomain dom) =>
+                       Type dom -> MaybeT (m1 m2) Bool
+        chkOnlyApp (TypeApp f v@(VarType _)) = do
+          isTyVar <- chkSingleTyVar v
+          if isTyVar
+            then case f of
+              (VarType c) -> addTyConM c >> return True
+              _           -> chkOnlyApp f
+            else return False
+        chkOnlyApp x@(InfixTypeApp lhs op rhs) = do
+          lift . lift $ addOccurence_ TypeOperators x
+          addTyConM . mkNormalName $ (op ^. operatorName)
+          lOK <- chkSingleTyVar lhs
+          rOK <- chkSingleTyVar rhs
+          return $! lOK && rOK
+        chkOnlyApp _ = return False
+
+        addTyCon  n (ctors, vars) = (n:ctors, vars)
+        addTyVar  n (ctors, vars) = (ctors, n:vars)
+        addTyConM n               = modify $ addTyCon n
+        addTyVarM n               = modify $ addTyVar  n
+
+        tyVarSemNameM x = MaybeT . return . semanticsName $ x ^. simpleName
+
+rmTypeMisc :: Type dom -> ExtMonad (Type dom)
+rmTypeMisc = rmTParens >=> rmTKinded
+
+rmTKinded :: Type dom -> ExtMonad (Type dom)
+rmTKinded kt@(KindedType t _) = addOccurence_ KindSignatures kt >> return t
+rmTKinded x                   = return x
+
+-- removes Parentheses from the AST
+-- the structure is reserved
+rmTParens :: Type dom -> ExtMonad (Type dom)
+rmTParens (ParenType x) = return x
+rmTParens x             = return x
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/LambdaCaseChecker.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
+
+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.LambdaCaseChecker where
+
+import Language.Haskell.Tools.Refactor as Refact
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad as Ext
+
+chkLambdaCase :: CheckNode Expr
+chkLambdaCase = conditional chkLambdaCase' Ext.LambdaCase
+
+chkLambdaCase' :: CheckNode Expr
+chkLambdaCase' e@(Refact.LambdaCase _) = addOccurence Ext.LambdaCase e
+chkLambdaCase' e = return e
+
+
+{-
+  TopLevelPragma,
+  Rule,
+
+  Splice,
+  Bracket,
+
+  Cmd,
+
+  Rhs DONE
+  RhsGuard DONE
+  Expr DONE
+  FieldUpdate DONE
+  TupSecElem DONE
+  CaseRhs DONE
+  Stmt DONE
+  CompStmt DONE
+  Pattern DONE
+-}
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/MagicHashChecker.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
+             
+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.MagicHashChecker where
+
+import Language.Haskell.Tools.Refactor
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+
+{-# ANN module "HLint: ignore Redundant bracket" #-}
+
+chkMagicHashLiteral :: CheckNode Literal
+chkMagicHashLiteral = conditional chkMagicHashLiteral' MagicHash
+
+chkMagicHashNamePart :: CheckNode NamePart
+chkMagicHashNamePart = conditional chkMagicHashNamePart' MagicHash
+
+chkMagicHashKind :: CheckNode Kind
+chkMagicHashKind = conditional chkMagicHashKind' MagicHash
+
+
+
+
+chkMagicHashLiteral' :: CheckNode Literal
+chkMagicHashLiteral' l@(PrimIntLit _)    = addOccurence MagicHash l
+chkMagicHashLiteral' l@(PrimWordLit _)   = addOccurence MagicHash l
+chkMagicHashLiteral' l@(PrimFloatLit _)  = addOccurence MagicHash l
+chkMagicHashLiteral' l@(PrimDoubleLit _) = addOccurence MagicHash l
+chkMagicHashLiteral' l@(PrimCharLit _)   = addOccurence MagicHash l
+chkMagicHashLiteral' l@(PrimStringLit _) = addOccurence MagicHash l
+chkMagicHashLiteral' l = return l
+
+
+chkMagicHashNamePart' :: CheckNode NamePart
+chkMagicHashNamePart' n@(NamePart name) =
+  if (last name == '#') then addOccurence MagicHash n
+                        else return n
+
+-- NOTE: is this really needed?
+chkMagicHashKind' :: CheckNode Kind
+chkMagicHashKind' k@UnboxKind = addOccurence MagicHash k
+chkMagicHashKind' k = return k
+
+{- Name can be reached from:
+  UIESpec
+  USubSpec
+  UInjectivityAnn
+  URuleVar
+  UTopLevelPragma
+  UAnnotationSubject
+  UMinimalFormula
+
+  UDecl  DONE
+  UClassElement DONE
+  UDeclHead DONE
+  UGadtConDecl DONE
+  UPatSynLhs  DONE
+  UPatternTypeSignature DONE
+  UFunDep DONE
+  UConDecl DONE
+  UFieldDecl DONE
+  UInstanceHead DONE
+  UTypeSignature DONE
+  UMatchLhs DONE
+  UTyVar DONE
+  UType DONE
+  UKind DONE
+  UAssertion DONE
+  UExpr DONE
+  UFieldUpdate DONE
+  UPattern DONE
+  UPatternField DONE
+  USplice
+  UQuasiQuote
+
+  UPromoted t
+-}
+
+{- QualifiedName can be reached from:
+  UDecl DONE
+  UOperator DONE
+  UName (obviously) DONE
+-}
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/PatternSynonymsChecker.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
+
+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.PatternSynonymsChecker where
+
+import Language.Haskell.Tools.Refactor (PatternSignature, PatternSynonym)
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+
+-- NOTE: Here we implicitly constrained the type with ExtDomain.
+--       but we don't really need any.
+
+chkPatternSynonymsSyn :: CheckNode PatternSynonym
+chkPatternSynonymsSyn = conditional chkPatternSynonymsSyn' PatternSynonyms
+
+chkPatternSynonymsSyn' :: CheckNode PatternSynonym
+chkPatternSynonymsSyn' = addOccurence PatternSynonyms
+
+chkPatternSynonymsTypeSig :: CheckNode PatternSignature
+chkPatternSynonymsTypeSig = conditional (addOccurence PatternSynonyms) PatternSynonyms
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/RecordWildCardsChecker.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
+
+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.RecordWildCardsChecker 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 contraint.
+
+chkRecordWildCardsPatField :: CheckNode PatternField
+chkRecordWildCardsPatField p@(FieldWildcardPattern {}) = addOccurence RecordWildCards p
+chkRecordWildCardsPatField p = return p
+
+chkRecordWildCardsFieldUpdate :: CheckNode FieldUpdate
+chkRecordWildCardsFieldUpdate e@(FieldWildcard {}) = addOccurence RecordWildCards e
+chkRecordWildCardsFieldUpdate e = return e
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/TemplateHaskellChecker.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
+
+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.TemplateHaskellChecker 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.
+
+-- can be reached from: Decl, Type, Expr, Pattern
+chkTemplateHaskellSplice :: CheckNode Splice
+chkTemplateHaskellSplice = addOccurence TemplateHaskell
+
+-- can be reached from: Type, Expr, Pattern
+chkTemplateHaskellQuasiQuote :: CheckNode QuasiQuote
+chkTemplateHaskellQuasiQuote = addOccurence QuasiQuotes
+
+-- can be reached from: Expr
+chkTemplateHaskellBracket :: CheckNode Bracket
+chkTemplateHaskellBracket = addOccurence TemplateHaskellQuotes
+
+chkTemplateHaskellhNamePart :: CheckNode NamePart
+chkTemplateHaskellhNamePart = conditional chkTemplateHaskellNamePart' TemplateHaskellQuotes
+
+
+-- should be THQuotes OR DataKinds
+chkTemplateHaskellNamePart' :: CheckNode NamePart
+chkTemplateHaskellNamePart' n@(NamePart name) =
+  if (head name == '\'') then addOccurence TemplateHaskellQuotes n
+                         else return n
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/TupleSectionsChecker.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
+
+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.TupleSectionsChecker where
+
+import Language.Haskell.Tools.Refactor
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+
+chkTupleSections :: CheckNode Expr
+chkTupleSections = conditional chkTupleSections' TupleSections
+
+chkTupleSections' :: CheckNode Expr
+chkTupleSections' e@(TupleSection        _) = addOccurence TupleSections e
+chkTupleSections' e@(UnboxedTupleSection _) = addOccurence TupleSections e
+                                           >> addOccurence UnboxedTuples e
+chkTupleSections' e = return e
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/UnboxedTuplesChecker.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
+
+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.UnboxedTuplesChecker where
+
+import Language.Haskell.Tools.Refactor
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+
+chkUnboxedTuplesExpr :: CheckNode Expr
+chkUnboxedTuplesExpr = conditional chkUnboxedTuplesExpr' UnboxedTuples
+
+chkUnboxedTuplesPat :: CheckNode Pattern
+chkUnboxedTuplesPat = conditional chkUnboxedTuplesPat' UnboxedTuples
+
+chkUnboxedTuplesType :: CheckNode Type
+chkUnboxedTuplesType = conditional chkUnboxedTuplesType' UnboxedTuples
+
+
+chkUnboxedTuplesExpr' :: CheckNode Expr
+chkUnboxedTuplesExpr' e@(UnboxedTuple        _) = addOccurence UnboxedTuples e
+chkUnboxedTuplesExpr' e@(UnboxedTupleSection _) = addOccurence UnboxedTuples e
+chkUnboxedTuplesExpr' e = return e
+
+chkUnboxedTuplesPat' :: CheckNode Pattern
+chkUnboxedTuplesPat' p@(UnboxTuplePat _) = addOccurence UnboxedTuples p
+chkUnboxedTuplesPat' p = return p
+
+chkUnboxedTuplesType' :: CheckNode Type
+chkUnboxedTuplesType' t@(UnboxedTupleType _) = addOccurence UnboxedTuples t
+chkUnboxedTuplesType' t = return t
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/ViewPatternsChecker.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
+
+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.ViewPatternsChecker where
+
+import Language.Haskell.Tools.Refactor
+import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+
+chkViewPatterns :: CheckNode Pattern
+chkViewPatterns = conditional chkViewPatterns' ViewPatterns
+
+chkViewPatterns' :: CheckNode Pattern
+chkViewPatterns' p@(ViewPat _ _) = addOccurence ViewPatterns p
+chkViewPatterns' p = return p
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/ExtMap.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE DeriveFunctor #-}
+
+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMap where
+
+import Language.Haskell.TH.LanguageExtensions (Extension)
+import SrcLoc (SrcSpan)
+
+import qualified Data.Map.Strict as SMap (Map)
+
+
+infix 6 :||:
+infix 7 :&&:
+
+data LogicalRelation a = LVar a
+                       | Not (LogicalRelation a)
+                       | LogicalRelation a :&&: LogicalRelation a
+                       | LogicalRelation a :||: LogicalRelation a
+  deriving (Eq, Show, Functor, Ord)
+
+type ExtMap = SMap.Map (LogicalRelation Extension) [SrcSpan]
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/ExtMonad.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE ConstraintKinds, FlexibleContexts, RankNTypes, StandaloneDeriving, TypeFamilies, TypeSynonymInstances #-}
+
+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.TH.LanguageExtensions
+  , module Control.Monad.State
+  , module Control.Monad.Reader
+  ) where
+
+import Language.Haskell.Tools.Refactor
+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
+import qualified Data.Map.Strict as SMap (Map(..), empty, insertWith)
+
+
+{-# 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 ExtDomain dom   = (HasNameInfo dom)
+
+type CheckNode  elem     = forall dom . CheckNode' elem dom
+type CheckNode' elem dom = ExtDomain dom => elem dom -> ExtMonad (elem dom)
+
+type CheckUNode  uelem     = forall dom . CheckUNode' uelem dom
+type CheckUNode' uelem dom = ExtDomain dom => Ann uelem dom SrcTemplateStage -> ExtMonad (Ann uelem dom SrcTemplateStage)
+
+addOccurence' :: (Ord k, HasRange a) =>
+                 k -> a -> SMap.Map k [SrcSpan] -> SMap.Map k [SrcSpan]
+addOccurence' key node = SMap.insertWith (++) key [getRange node]
+
+-- TODO: add isTurnedOn check
+addOccurence_ :: (MonadState ExtMap m, HasRange node) =>
+                  Extension -> node -> m ()
+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
+
+isTurnedOn :: Extension -> ExtMonad Bool
+isTurnedOn ext = do
+  defaults <- ask
+  return $! ext `elem` defaults
+
+conditional :: (node -> ExtMonad node) ->
+               Extension ->
+               node ->
+               ExtMonad node
+conditional checker ext = conditionalAny checker [ext]
+
+conditionalNot :: (node -> ExtMonad node) ->
+                  Extension ->
+                  node ->
+                  ExtMonad node
+conditionalNot checker ext node = do
+  b <-isTurnedOn ext
+  if b then return node else checker node
+
+conditionalAny :: (node -> ExtMonad node) ->
+                   [Extension] ->
+                   node ->
+                   ExtMonad node
+conditionalAny checker exts node = do
+  bs <- mapM isTurnedOn exts
+  if or bs then checker node else return node
+
+conditionalAdd :: HasRange node => Extension -> node -> ExtMonad node
+conditionalAdd ext = conditional (addOccurence ext) ext
+
+
+runExtMonadIO :: ExtMonad a -> IO a
+runExtMonadIO = runGhc (Just libdir) . runExtMonadGHC
+
+runExtMonadGHC :: ExtMonad a -> Ghc a
+runExtMonadGHC = liftM fst . flip runStateT SMap.empty . flip runReaderT []
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/TraverseAST.hs view
@@ -0,0 +1,592 @@+{-# LANGUAGE FlexibleContexts, RankNTypes, TypeFamilies #-}
+
+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
+
+chkKind :: CheckNode Kind
+chkKind = chkMagicHashKind
+
+
+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)
+traverseAlt f = (altPattern !~ traversePattern)
+               >=> (altRhs !~ traverseCaseRhs f)
+               >=> (altBinds & annJust !~ traverseLocalBinds)
+
+traverseCaseRhs :: CheckUNode uexpr -> CheckNode (CaseRhsG uexpr)
+traverseCaseRhs f = (rhsCaseExpr !~ f)
+                   >=> (rhsCaseGuards & annList !~ traverseGuardedCaseRhs f)
+
+traverseGuardedCaseRhs :: CheckUNode uexpr -> CheckNode (GuardedCaseRhsG uexpr)
+traverseGuardedCaseRhs f = (caseGuardStmts & annList !~ traverseRhsGuard)
+                          >=> (caseGuardExpr !~ f)
+
+traverseStmt :: CheckUNode uexpr -> CheckNode (StmtG uexpr)
+traverseStmt f = (stmtPattern !~ traversePattern)
+                >=> (stmtExpr !~ f)
+                >=> (stmtBinds & annList !~ traverseLocalBind)
+                >=> (cmdStmtBinds & annList !~ traverseStmt f)
+
+traversePromoted :: CheckUNode t -> CheckNode (PromotedG t)
+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
+ Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Utils/SupportedExtensions.hs view
@@ -0,0 +1,28 @@+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 view
@@ -0,0 +1,82 @@+{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
+
+module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Utils.TypeLookup where
+
+
+import Language.Haskell.Tools.AST (HasNameInfo'(..), HasNameInfo(..), 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 :: HasNameInfo dom => Type dom -> 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 :: HasNameInfo dom => Type dom -> ExtMonad Bool
+isNewtype t = do
+  tycon <- runMaybeT . lookupType $ t
+  return $! maybe True isNewtypeTyCon tycon
+
+
+
+lookupType :: HasNameInfo dom => Type dom -> 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 dom -> Maybe (Name dom)
+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 :: HasNameInfo dom => Name dom -> Maybe GHC.Name
+getSemName x = semanticsName (x ^. simpleName)
+ Language/Haskell/Tools/Refactor/Builtin/ExtractBinding.hs view
@@ -0,0 +1,228 @@+{-# LANGUAGE ConstraintKinds, FlexibleContexts, MultiWayIf, RankNTypes, ScopedTypeVariables, TypeApplications, TypeFamilies, ViewPatterns #-}
+module Language.Haskell.Tools.Refactor.Builtin.ExtractBinding
+  (extractBinding', ExtractBindingDomain, tryItOut, extractBindingRefactoring) where
+
+import qualified GHC
+import Name (nameModule_maybe)
+import qualified OccName as GHC (occNameString)
+import OccName (HasOccName(..))
+import PrelNames
+import RdrName (isOrig_maybe)
+import SrcLoc
+
+import Control.Monad.State
+import Control.Reference
+import Data.Generics.Uniplate.Data ()
+import Data.List (find, intersperse)
+import Data.Maybe
+
+import Language.Haskell.Tools.Refactor
+
+
+extractBindingRefactoring :: (ExtractBindingDomain dom, HasModuleInfo dom) => RefactoringChoice dom
+extractBindingRefactoring = NamingRefactoring "ExtractBinding" (\loc s -> localRefactoring (extractBinding' loc s))
+
+-- | We need name information to identify bindings, and scope information to check which
+-- entities must be directly passed as parameters.
+type ExtractBindingDomain dom = ( HasNameInfo dom, HasDefiningInfo dom, HasScopeInfo dom )
+
+tryItOut :: String -> String -> String -> IO ()
+tryItOut mod sp name = tryRefactor (localRefactoring . flip extractBinding' name) mod sp
+
+extractBinding' :: ExtractBindingDomain dom => RealSrcSpan -> String -> LocalRefactoring dom
+extractBinding' sp name mod
+  = if isNothing (isValidBindingName name)
+      then extractBinding sp (nodesContaining sp) (nodesContaining sp) name mod
+      else refactError $ "The given name is not a valid for the extracted binding: " ++ fromJust (isValidBindingName name)
+
+-- | Safely performs the transformation to introduce the local binding and replace the expression with the call.
+-- Checks if the introduction of the name causes a name conflict.
+extractBinding :: forall dom . ExtractBindingDomain dom
+               => RealSrcSpan -> Simple Traversal (Module dom) (ValueBind dom)
+                   -> Simple Traversal (ValueBind dom) (Expr dom)
+                   -> String -> LocalRefactoring dom
+extractBinding sp selectDecl selectExpr name mod
+  = let conflicting = filter (isConflicting name) ((take 1 $ reverse $ mod ^? selectDecl) ^? biplateRef :: [QualifiedName dom])
+        exprRanges = map getRange (mod ^? selectDecl & selectExpr)
+        decl = last (mod ^? selectDecl)
+        declPats = decl ^? valBindPat &+& funBindMatches & annList & matchLhs
+                                            & (matchLhsArgs & annList &+& matchLhsLhs &+& matchLhsRhs &+& matchLhsArgs & annList)
+     in case exprRanges of
+          (reverse -> exprRange:_) ->
+            if | not (null conflicting)
+               -> refactError $ "The given name causes name conflict with the definition(s) at: " ++ concat (intersperse "," (map (shortShowSpanWithFile . getRange) conflicting))
+               | any (`containsRange` exprRange) $ map getRange declPats
+               -> refactError "Extract binding cannot be applied to view pattern expressions."
+               | otherwise
+               -> case decl ^? actualContainingExpr exprRange of
+                    expr:_ -> do (res, st) <- runStateT (selectDecl&selectExpr !~ extractThatBind sp name expr $ mod) Nothing
+                                 case st of Just def -> return $ evalState (selectDecl !~ addLocalBinding exprRange def $ res) False
+                                            Nothing -> refactError "There is no applicable expression to extract."
+                    [] -> refactError $ "There is no applicable expression to extract."
+          [] -> refactError "There is no applicable expression to extract."
+  where RealSrcSpan sp1 `containsRange` RealSrcSpan sp2 = sp1 `containsSpan` sp2
+        _ `containsRange` _ = False
+
+-- | Decides if a new name defined to be the given string will conflict with the given AST element
+isConflicting :: ExtractBindingDomain dom => String -> QualifiedName dom -> Bool
+isConflicting name used
+  = semanticsDefining used
+      && (GHC.occNameString . GHC.getOccName <$> semanticsName used) == Just name
+
+-- Replaces the selected expression with a call and generates the called binding.
+extractThatBind :: ExtractBindingDomain dom
+                => RealSrcSpan -> String -> Expr dom -> Expr dom -> StateT (Maybe (ValueBind dom)) (LocalRefactor dom) (Expr dom)
+extractThatBind sp name cont e
+  = do ret <- get -- being in a state monad to only apply the
+       if (isJust ret) then return e
+          else case e of
+            -- only the expression inside the parameters should be extracted
+            Paren {} | hasParameter -> exprInner !~ doExtract name cont $ e
+                     | otherwise    -> doExtract name cont (fromJust $ e ^? exprInner)
+            -- a single variable cannot be extracted (would lead to precedence problems)
+            Var {} -> lift $ refactError "The selected expression is too simple to be extracted."
+            -- extract operator sections
+            InfixApp lhs op rhs
+               | (lhs `outside` sp) && (sp `encloses` op) && (sp `encloses` rhs)
+               -> do let params = getExternalBinds cont rhs ++ opName op
+                     put (Just (generateBind name (map mkVarPat params) (mkRightSection op (parenIfInfix rhs))))
+                     return (mkApp (generateCall name params) (parenIfInfix lhs))
+               | (sp `encloses` lhs) && (sp `encloses` op) && (rhs `outside` sp)
+               -> do let params = getExternalBinds cont lhs ++ opName op
+                     put (Just (generateBind name (map mkVarPat params) (mkLeftSection (parenIfInfix lhs) op)))
+                     return (mkApp (generateCall name params) (parenIfInfix rhs))
+              where parenIfInfix e@(InfixApp {}) = mkParen e
+                    parenIfInfix e = e
+            -- extract parts of known associative infix operators
+            InfixApp (InfixApp lhs lop mid) rop rhs -- correction for left-associative operators
+              | (Just lName, Just rName) <- (semanticsName (lop ^. operatorName), semanticsName (rop ^. operatorName))
+              , (lop `outside` sp) && (sp `encloses` mid) && (sp `encloses` rhs)
+                  && lName == rName && isKnownCommutativeOp lName
+              -> do let params = getExternalBinds cont mid ++ opName rop ++ getExternalBinds cont rhs
+                    put (Just (generateBind name (map mkVarPat params) (mkInfixApp mid rop rhs)))
+                    return (mkInfixApp lhs lop (generateCall name params))
+            InfixApp lhs lop (InfixApp mid rop rhs) -- correction for right-associative operators
+              | (Just lName, Just rName) <- (semanticsName (lop ^. operatorName), semanticsName (rop ^. operatorName))
+              , (sp `encloses` lhs) && (sp `encloses` mid) && (rop `outside` sp)
+                  && lName == rName && isKnownCommutativeOp lName
+              -> do let params = getExternalBinds cont lhs ++ opName lop ++ getExternalBinds cont mid
+                    put (Just (generateBind name (map mkVarPat params) (mkInfixApp lhs lop mid)))
+                    return (mkInfixApp (generateCall name params) rop rhs)
+            -- normal case
+            el | isParenLikeExpr el && hasParameter -> mkParen <$> doExtract name cont e
+               | otherwise -> doExtract name cont e
+  where hasParameter = not (null (getExternalBinds cont e))
+        -- True if the elem is completely inside the given source range
+        sp `encloses` elem = case getRange elem of RealSrcSpan enc -> sp `containsSpan` enc
+                                                   _               -> False
+        -- True if the elem is completely outside the given range (no overlapping)
+        elem `outside` sp = case getRange elem of RealSrcSpan out -> realSrcSpanStart sp > realSrcSpanEnd out
+                                                                       || realSrcSpanEnd sp < realSrcSpanStart out
+                                                  _ -> False
+        opName op = case semanticsName (op ^. operatorName) of
+                      Nothing -> []
+                      Just n -> [mkUnqualName' n | not $ n `inScope` semanticsScope cont]
+        isKnownCommutativeOp :: GHC.Name -> Bool
+        isKnownCommutativeOp n = isJust $ find (maybe False (\(mn, occ) -> (nameModule_maybe n) == Just mn && occName n == occ) . isOrig_maybe) ops
+          where ops = [plus_RDR, times_RDR, append_RDR, and_RDR, {- or_RDR, -} compose_RDR] -- somehow or is missing... WHY?
+
+-- | Adds a local binding to the where clause of the enclosing binding
+addLocalBinding :: SrcSpan -> ValueBind dom -> ValueBind dom -> State Bool (ValueBind dom)
+-- this uses the state monad to only add the local binding to the first selected element
+addLocalBinding exprRange local bind
+  = do done <- get
+       if not done then do put True
+                           return $ indentBody $ doAddBinding exprRange local bind
+                   else return bind
+  where
+    doAddBinding _ local sb@(SimpleBind {}) = valBindLocals .- insertLocalBind local $ sb
+    doAddBinding (RealSrcSpan rng) local fb@(FunctionBind {})
+      = funBindMatches & annList & filtered (isInside rng) & matchBinds
+          .- insertLocalBind local $ fb
+    doAddBinding _ _ _ = error "doAddBinding: invalid expression range"
+
+    indentBody = (valBindRhs .- updIndent) . (funBindMatches & annList & matchLhs .- updIndent) . (funBindMatches & annList & matchRhs .- updIndent)
+
+    updIndent :: SourceInfoTraversal elem => elem dom SrcTemplateStage -> elem dom SrcTemplateStage
+    updIndent = setMinimalIndent 4
+
+-- | Puts a value definition into a list of local binds
+insertLocalBind :: ValueBind dom -> MaybeLocalBinds dom -> MaybeLocalBinds dom
+insertLocalBind toInsert locals
+  | isAnnNothing locals = mkLocalBinds [mkLocalValBind toInsert]
+  | otherwise = annJust & localBinds .- insertWhere True (mkLocalValBind toInsert) (const True) isNothing $ locals
+
+-- | All expressions that are bound stronger than function application.
+isParenLikeExpr :: Expr dom -> Bool
+isParenLikeExpr (If {}) = True
+isParenLikeExpr (Paren {}) = True
+isParenLikeExpr (List {}) = True
+isParenLikeExpr (ParArray {}) = True
+isParenLikeExpr (LeftSection {}) = True
+isParenLikeExpr (RightSection {}) = True
+isParenLikeExpr (RecCon {}) = True
+isParenLikeExpr (RecUpdate {}) = True
+isParenLikeExpr (Enum {}) = True
+isParenLikeExpr (ParArrayEnum {}) = True
+isParenLikeExpr (ListComp {}) = True
+isParenLikeExpr (ParArrayComp {}) = True
+isParenLikeExpr (BracketExpr {}) = True
+isParenLikeExpr (SpliceExpr {}) = True
+isParenLikeExpr (QuasiQuoteExpr {}) = True
+isParenLikeExpr _ = False
+
+-- | Replaces the expression with the call and stores the binding of the call in its state
+doExtract :: ExtractBindingDomain dom
+          => String -> Expr dom -> Expr dom -> StateT (Maybe (ValueBind dom)) (LocalRefactor dom) (Expr dom)
+doExtract name cont e@(Lambda (AnnList bindings) inner)
+  = do let params = getExternalBinds cont e
+       put (Just (generateBind name (map mkVarPat params ++ bindings) inner))
+       return (generateCall name params)
+doExtract name cont e
+  = do let params = getExternalBinds cont e
+       put (Just (generateBind name (map mkVarPat params) e))
+       return (generateCall name params)
+
+-- | Gets the values that have to be passed to the extracted definition
+getExternalBinds :: ExtractBindingDomain dom => Expr dom -> Expr dom -> [Name dom]
+getExternalBinds cont expr = map exprToName $ keepFirsts $ filter isApplicableName (expr ^? uniplateRef)
+  where isApplicableName (getExprNameInfo -> Just nm) = inScopeForOriginal nm && notInScopeForExtracted nm
+        isApplicableName _ = False
+
+        getExprNameInfo :: ExtractBindingDomain dom => Expr dom -> Maybe GHC.Name
+        getExprNameInfo expr = semanticsName =<< (listToMaybe $ expr ^? (exprName&simpleName &+& exprOperator&operatorName))
+
+        -- | Creates the parameter value to pass the name (operators are passed in parentheses)
+        exprToName :: Expr dom -> Name dom
+        exprToName e | Just n <- e ^? exprName                     = n
+                     | Just op <- e ^? exprOperator & operatorName = mkParenName op
+                     | otherwise                                   = error "exprToName: name not found"
+
+        notInScopeForExtracted :: GHC.Name -> Bool
+        notInScopeForExtracted n = not $ n `inScope` semanticsScope cont
+
+        inScopeForOriginal :: GHC.Name -> Bool
+        inScopeForOriginal n = n `inScope` semanticsScope expr
+
+        keepFirsts (e:rest) = e : keepFirsts (filter (/= e) rest)
+        keepFirsts [] = []
+
+actualContainingExpr :: SrcSpan -> Simple Traversal (ValueBind dom) (Expr dom)
+actualContainingExpr (RealSrcSpan rng) = accessRhs & accessExpr
+  where accessRhs :: Simple Traversal (ValueBind dom) (Rhs dom)
+        accessRhs = valBindRhs &+& funBindMatches & annList & filtered (rng `isInside`) & matchRhs
+        accessExpr :: Simple Traversal (Rhs dom) (Expr dom)
+        accessExpr = rhsExpr &+& rhsGuards & annList & filtered (rng `isInside`) & guardExpr
+actualContainingExpr _ = error "actualContainingExpr: not a real range"
+
+-- | Generates the expression that calls the local binding
+generateCall :: String -> [Name dom] -> Expr dom
+generateCall name args = foldl (\e a -> mkApp e (mkVar a)) (mkVar $ mkNormalName $ mkSimpleName name) args
+
+-- | Generates the local binding for the selected expression
+generateBind :: String -> [Pattern dom] -> Expr dom -> ValueBind dom
+generateBind name [] e = mkSimpleBind (mkVarPat $ mkNormalName $ mkSimpleName name) (mkUnguardedRhs e) Nothing
+generateBind name args e = mkFunctionBind [mkMatch (mkMatchLhs (mkNormalName $ mkSimpleName name) args) (mkUnguardedRhs e) Nothing]
+
+isValidBindingName :: String -> Maybe String
+isValidBindingName = nameValid Variable
+ Language/Haskell/Tools/Refactor/Builtin/FloatOut.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE ConstraintKinds, FlexibleContexts, LambdaCase, ScopedTypeVariables, TypeApplications, TypeFamilies #-}
+module Language.Haskell.Tools.Refactor.Builtin.FloatOut
+  (floatOut, FloatOutDefinition, floatOutRefactoring) where
+
+import Control.Monad.State
+import Control.Reference
+import Data.List
+import Data.Maybe (Maybe(..), catMaybes)
+
+import Language.Haskell.Tools.Refactor
+
+import Name as GHC (Name, NamedThing(..), occNameString)
+import SrcLoc (RealSrcSpan)
+
+floatOutRefactoring :: (FloatOutDefinition dom, HasModuleInfo dom) => RefactoringChoice dom
+floatOutRefactoring = SelectionRefactoring "FloatOut" (localRefactoring . floatOut)
+
+type FloatOutDefinition dom = (HasNameInfo dom, HasScopeInfo dom)
+
+floatOut :: FloatOutDefinition dom => RealSrcSpan -> LocalRefactoring dom
+floatOut sp mod
+  = do (mod', st) <- runStateT (nodesContaining sp !~ extractAndInsert sp $ mod) NotEncountered
+       case st of NotEncountered -> refactError "No definition is selected. The selection range must be inside the definition."
+                  Extracted bnds -> -- insert it to the global definition list
+                                    return $ modDecl & annListElems .- (++ map toTopLevel bnds) $ removeEmpties mod'
+                  Inserted -> -- already inserted to a local scope
+                               return (removeEmpties mod')
+  where toTopLevel :: LocalBind dom -> Decl dom
+        toTopLevel (LocalValBind vb) = mkValueBinding vb
+        toTopLevel (LocalTypeSig sg) = mkTypeSigDecl sg
+        toTopLevel (LocalFixity fx) = mkFixityDecl fx
+
+        removeEmpties = removeEmptyBnds (nodesContaining sp) (nodesContaining sp)
+
+data FloatState dom = NotEncountered | Extracted [LocalBind dom] | Inserted
+
+extractAndInsert :: FloatOutDefinition dom => RealSrcSpan -> LocalBindList dom -> StateT (FloatState dom) (LocalRefactor dom) (LocalBindList dom)
+extractAndInsert sp locs
+  | hasSharedSig = refactError "Cannot float out a definition, since it has a signature shared with other bindings that stay in the scope."
+  | not (null nameConflicts) = refactError $ "Cannot float out a definition, since it would cause a name conflicts in the target scope: "
+                                                ++ concat (intersperse ", " nameConflicts)
+  | not (null implicitConflicts) = refactError $ "Cannot float out a definition, since it uses the implicit parameters: "
+                                                   ++ concat (intersperse ", " implicitConflicts)
+  | otherwise = get >>= \case NotEncountered -> put (Extracted floated) >> return filteredLocs
+                              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
+                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
+        conflicts = map checkConflict selected
+
+        nameConflicts = concat $ map fst conflicts
+        implicitConflicts = concat $ map snd conflicts
+
+checkConflict :: forall dom . FloatOutDefinition dom => LocalBind dom -> ([String], [String])
+checkConflict bnd = (concatMap @[] getConflict bndNames, implicits)
+  where bndNames = bnd ^? elementName
+        getConflict bndName = filter ((== nameStr) . Just) $ map (occNameString . getOccName) outerScope
+          where outerScope = map (^. _1) $ concat $ take 1 $ drop 2 $ semanticsScope bndName
+                nameStr = fmap (occNameString . getOccName) $ semanticsName bndName
+        implicits = map (occNameString . getOccName)
+                        (concatMap getPossibleImplicits bndNames `intersect` getQNames (bnd ^? biplateRef))
+
+        getQNames :: [QualifiedName dom] -> [GHC.Name]
+        getQNames = catMaybes . map semanticsName
+
+        getPossibleImplicits :: QualifiedName dom -> [GHC.Name]
+        getPossibleImplicits qn = concat (map (map (^. _1)) $ take 2 $ semanticsScope qn) \\ catMaybes (map semanticsName bndNames)
+ Language/Haskell/Tools/Refactor/Builtin/GenerateExports.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE ConstraintKinds, FlexibleContexts, LambdaCase, TupleSections, TypeFamilies #-}
+module Language.Haskell.Tools.Refactor.Builtin.GenerateExports
+  (generateExports, DomGenerateExports, generateExportsRefactoring) where
+
+import Control.Reference ((^?), (.=), (&))
+import Language.Haskell.Tools.Refactor
+
+import qualified GHC (NamedThing(..), Name)
+
+import Control.Applicative ((<|>))
+import Data.Maybe (Maybe(..), catMaybes)
+
+generateExportsRefactoring :: (DomGenerateExports dom, HasModuleInfo dom) => RefactoringChoice dom
+generateExportsRefactoring = ModuleRefactoring "GenerateExports" (localRefactoring generateExports)
+
+-- | We need name information to generate exports
+type DomGenerateExports dom = (Domain dom, HasNameInfo dom)
+
+-- | Creates an export list that imports standalone top-level definitions with all of their contained definitions
+generateExports :: DomGenerateExports dom => LocalRefactoring dom
+generateExports mod = return (modHead & annJust & mhExports & annMaybe
+                                .= Just (createExports (getTopLevels mod)) $ mod)
+
+-- | Get all the top-level definitions with flags that mark if they can contain other top-level definitions
+-- (classes and data declarations).
+getTopLevels :: DomGenerateExports dom => Module dom -> [(GHC.Name, Bool)]
+getTopLevels mod = catMaybes $ map (\d -> fmap (,exportContainOthers d)
+                                               (foldl (<|>) Nothing $ map semanticsName $ d ^? elementName))
+                                   (filter (\case TypeSigDecl{} -> False; _ -> True)
+                                      $ mod ^? modDecl & annList)
+  where exportContainOthers :: Decl dom -> Bool
+        exportContainOthers (DataDecl {}) = True
+        exportContainOthers (ClassDecl {}) = True
+        exportContainOthers _ = False
+
+-- | Create the export for a give name.
+createExports :: [(GHC.Name, Bool)] -> ExportSpecs dom
+createExports elems = mkExportSpecs $ map (mkExportSpec . createExport) elems
+  where createExport (n, False) = mkIESpec (mkUnqualName' (GHC.getName n)) Nothing
+        createExport (n, True)  = mkIESpec (mkUnqualName' (GHC.getName n)) (Just mkSubAll)
+ Language/Haskell/Tools/Refactor/Builtin/GenerateTypeSignature.hs view
@@ -0,0 +1,176 @@+{-# LANGUAGE ConstraintKinds, FlexibleContexts, RankNTypes, ScopedTypeVariables, TupleSections, TypeApplications, TypeFamilies, ViewPatterns #-}
+module Language.Haskell.Tools.Refactor.Builtin.GenerateTypeSignature
+  ( generateTypeSignature, generateTypeSignature', GenerateSignatureDomain, tryItOut
+  , generateTypeSignatureRefactoring) where
+
+import GHC hiding (Module)
+import Id as GHC
+import OccName as GHC (isSymOcc)
+import Outputable as GHC (Outputable(..), showSDocUnsafe)
+import TyCon as GHC (TyCon(..), isTupleTyCon)
+import Type as GHC
+import TysWiredIn as GHC (listTyCon, charTyCon)
+
+import Control.Monad
+import Control.Monad.State
+import Control.Reference
+import Data.Generics.Uniplate.Data (universeBi)
+import Data.List
+import Data.Maybe (Maybe(..), catMaybes)
+
+import Language.Haskell.Tools.Refactor as AST
+
+type GenerateSignatureDomain dom = ( HasModuleInfo dom, HasIdInfo dom, HasImportInfo dom, HasScopeInfo dom )
+
+generateTypeSignatureRefactoring :: GenerateSignatureDomain dom => RefactoringChoice dom
+generateTypeSignatureRefactoring = SelectionRefactoring "GenerateSignature" (localRefactoring . generateTypeSignature')
+
+tryItOut :: String -> String -> IO ()
+tryItOut = tryRefactor (localRefactoring . generateTypeSignature')
+
+generateTypeSignature' :: GenerateSignatureDomain dom => RealSrcSpan -> LocalRefactoring dom
+generateTypeSignature' sp = generateTypeSignature (nodesContaining sp) (nodesContaining sp) (getValBindInList sp)
+
+-- | Perform the refactoring on either local or top-level definition
+generateTypeSignature :: GenerateSignatureDomain dom => Simple Traversal (Module dom) (DeclList dom)
+                                -- ^ Access for a top-level definition if it is the selected definition
+                           -> Simple Traversal (Module dom) (LocalBindList dom)
+                                -- ^ Access for a definition list if it contains the selected definition
+                           -> (forall d . (BindingElem d) => AnnList d dom -> Maybe (ValueBind dom))
+                                -- ^ Selector for either local or top-level declaration in the definition list
+                           -> LocalRefactoring dom
+generateTypeSignature topLevelRef localRef vbAccess mod
+  = let typeSigs = universeBi mod
+        bindings = universeBi mod
+        findTypeSigFor id = find (\ts -> any (id ==) $ map semanticsId (ts ^? tsName & annList & simpleName))
+        bindsWithSigs = catMaybes $ concatMap (\b -> map (\n -> let id = semanticsId n in fmap (id,,b) (findTypeSigFor id typeSigs)) (b ^? bindingName)) bindings
+        scopedSigs = hasScopedTypeSignatures mod
+     in do (mod', done) <- flip runStateT False .
+                             (topLevelRef !~ genTypeSig scopedSigs bindsWithSigs vbAccess
+                                <=< localRef !~ genTypeSig scopedSigs bindsWithSigs vbAccess) $ mod
+           if done
+             then return mod'
+             else refactError "No binding without type signature is found at the selection."
+
+
+hasScopedTypeSignatures :: Module dom -> Bool
+hasScopedTypeSignatures mod = "ScopedTypeVariables" `elem` (mod ^? filePragmas & annList & lpPragmas & annList & langExt :: [String])
+
+genTypeSig :: forall dom d . (GenerateSignatureDomain dom, BindingElem d) => Bool -> [(GHC.Var, TypeSignature dom, ValueBind dom)] -> (AnnList d dom -> Maybe (ValueBind dom))
+                -> AnnList d dom -> StateT Bool (LocalRefactor dom) (AnnList d dom)
+genTypeSig scopedSigs sigBinds vbAccess ls
+  | Just vb <- vbAccess ls
+  , not (typeSignatureAlreadyExist ls vb)
+    = if isSimpleBinding vb
+        then
+          do let id = getBindingName vb
+                 isTheBind (Just decl)
+                   = isBinding decl && map semanticsId (decl ^? elementName) == map semanticsId (vb ^? bindingName)
+                 isTheBind _ = False
+
+             alreadyGenerated <- get
+             if alreadyGenerated
+               then return ls
+               else do put True
+                       -- checking for possible situations when we cannot generate signature because of
+                       -- an implicitly passed value
+                       let dangerousTypeVars = dangerousTVs scopedSigs sigBinds
+                           myTvs = concatMap @[] (getExternalTVs . idType . semanticsId) (vb ^? bindingName)
+                       if not $ null @[] $ myTvs `intersect` dangerousTypeVars
+                         then refactError $ "Could not generate type signature: the type variable(s) "
+                                              ++ concat (intersperse ", " $ map (showSDocUnsafe . ppr) (myTvs `intersect` dangerousTypeVars))
+                                              ++ " cannot be captured. (Use ScopedTypeVariables and forall-ed type signatures)"
+                         else do
+                           typeSig <- lift $ generateTSFor (getName id) (idType id)
+                           return $ insertWhere True (createTypeSig typeSig) (const True) isTheBind ls
+        else refactError "Signature can only be generated for simple value bindings."
+  | otherwise = return ls
+  where isSimpleBinding vb = case vb of SimpleBind (AST.VarPat {}) _ _ -> True
+                                        SimpleBind _ _ _ -> False
+                                        _ -> True
+        dangerousTVs scopedSigs sigBinds
+          = let dangerousDecls = if scopedSigs then filter (\(_,ts,_) -> not $ isForalledTS ts) sigBinds else sigBinds
+                dangerousNames = map (\(_,_,bn) -> bn ^? (valBindPats & biplateRef &+& bindingName)) dangerousDecls
+             in concatMap (concatMap @[] (getExternalTVs . idType .  semanticsId @(QualifiedName dom))) dangerousNames
+
+generateTSFor :: GenerateSignatureDomain dom => GHC.Name -> GHC.Type -> LocalRefactor dom (TypeSignature dom)
+generateTSFor n t = mkTypeSignature (mkUnqualName' n) <$> generateTypeFor (-1) (dropForAlls t)
+
+-- | Generates the source-level type for a GHC internal type
+generateTypeFor :: GenerateSignatureDomain dom => Int -> GHC.Type -> LocalRefactor dom (AST.Type dom)
+generateTypeFor prec t
+  -- context
+  | (break (not . isPredTy) -> (preds, other), rt) <- splitFunTys t
+  , not (null preds)
+  = do ctx <- case preds of [pred] -> mkContext <$> generateAssertionFor pred
+                            _      -> mkContext <$> (mkTupleAssertion <$> mapM generateAssertionFor preds)
+       wrapParen 0 <$> (mkCtxType ctx <$> generateTypeFor 0 (mkFunTys other rt))
+  -- function
+  | Just (at, rt) <- splitFunTy_maybe t
+  = wrapParen 0 <$> (mkFunctionType <$> generateTypeFor 10 at <*> generateTypeFor 0 rt)
+  -- type operator (we don't know the precedences, so always use parentheses)
+  | (op, [at,rt]) <- splitAppTys t
+  , Just tc <- tyConAppTyCon_maybe op
+  , isSymOcc (getOccName (getName tc))
+  = wrapParen 0 <$> (mkInfixTypeApp <$> generateTypeFor 10 at <*> referenceOperator (idName $ getTCId tc) <*> generateTypeFor 10 rt)
+  -- tuple types
+  | Just (tc, tas) <- splitTyConApp_maybe t
+  , isTupleTyCon tc
+  = mkTupleType <$> mapM (generateTypeFor (-1)) tas
+  -- string type
+  | Just (ls, [et]) <- splitTyConApp_maybe t
+  , Just ch <- tyConAppTyCon_maybe et
+  , listTyCon == ls
+  , charTyCon == ch
+  = return $ mkVarType (mkNormalName $ mkSimpleName "String")
+  -- list types
+  | Just (tc, [et]) <- splitTyConApp_maybe t
+  , listTyCon == tc
+  = mkListType <$> generateTypeFor (-1) et
+  -- type application
+  | Just (tf, ta) <- splitAppTy_maybe t
+  = wrapParen 10 <$> (mkTypeApp <$> generateTypeFor 10 tf <*> generateTypeFor 11 ta)
+  -- type constructor
+  | Just tc <- tyConAppTyCon_maybe t
+  = mkVarType <$> referenceName (idName $ getTCId tc)
+  -- type variable
+  | Just tv <- getTyVar_maybe t
+  = mkVarType <$> referenceName (idName tv)
+  -- forall type
+  | (tvs@(_:_), t') <- splitForAllTys t
+  = wrapParen (-1) <$> (mkForallType (map (mkTypeVar' . getName) tvs) <$> generateTypeFor 0 t')
+  | otherwise = error ("Cannot represent type: " ++ showSDocUnsafe (ppr t))
+  where wrapParen :: Int -> AST.Type dom -> AST.Type dom
+        wrapParen prec' node = if prec' < prec then mkParenType node else node
+
+        getTCId :: GHC.TyCon -> GHC.Id
+        getTCId tc = GHC.mkVanillaGlobal (GHC.tyConName tc) (tyConKind tc)
+
+        generateAssertionFor :: GenerateSignatureDomain dom => GHC.Type -> LocalRefactor dom (Assertion dom)
+        generateAssertionFor t
+          | Just (tc, types) <- splitTyConApp_maybe t
+          = mkClassAssert <$> referenceName (idName $ getTCId tc) <*> mapM (generateTypeFor 0) types
+          | otherwise = error "generateAssertionFor: type not supported yet."
+
+-- | Check whether the definition already has a type signature
+typeSignatureAlreadyExist :: (GenerateSignatureDomain dom, BindingElem d) => AnnList d dom -> ValueBind dom -> Bool
+typeSignatureAlreadyExist ls vb =
+  getBindingName vb `elem` (map semanticsId $ concatMap (^? elementName) (filter isTypeSig $ ls ^? annList))
+
+getBindingName :: GenerateSignatureDomain dom => ValueBind dom -> GHC.Id
+getBindingName vb = case nub $ map semanticsId $ vb ^? bindingName of
+  [n] -> n
+  [] -> error "Trying to generate a signature for a binding with no name"
+  _ -> error "Trying to generate a signature for a binding with multiple names"
+
+-- * Checking for type variable constraints
+
+getExternalTVs :: GHC.Type -> [GHC.Var]
+getExternalTVs t
+  | Just tv <- getTyVar_maybe t = [tv]
+  | Just (op, arg) <- splitAppTy_maybe t = getExternalTVs op `union` getExternalTVs arg
+  | Just (tv, t') <- splitForAllTy_maybe t = delete tv $ getExternalTVs t'
+  | otherwise = []
+
+isForalledTS :: TypeSignature dom -> Bool
+isForalledTS ts = not $ null @[] $ ts ^? tsType & typeBounded & annList
+ Language/Haskell/Tools/Refactor/Builtin/InlineBinding.hs view
@@ -0,0 +1,243 @@+{-# LANGUAGE ConstraintKinds, FlexibleContexts, LambdaCase, MultiWayIf, RankNTypes, ScopedTypeVariables, TypeApplications, TypeFamilies #-}
+-- | 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
+  (inlineBinding, InlineBindingDomain, tryItOut, inlineBindingRefactoring) where
+
+import Control.Monad.State
+import Control.Reference
+import Data.Generics.Uniplate.Data ()
+import Data.Generics.Uniplate.Operations (Uniplate(..), Biplate(..))
+import Data.List (nub)
+import Data.Maybe (Maybe(..), catMaybes)
+
+import Name as GHC (NamedThing(..), Name, occNameString)
+import SrcLoc as GHC (SrcSpan(..), RealSrcSpan)
+
+import Language.Haskell.Tools.Refactor as AST
+
+inlineBindingRefactoring :: InlineBindingDomain dom => RefactoringChoice dom
+inlineBindingRefactoring = SelectionRefactoring "InlineBinding" inlineBinding
+
+tryItOut :: String -> String -> IO ()
+tryItOut = tryRefactor inlineBinding
+
+type InlineBindingDomain dom = ( HasNameInfo dom, HasDefiningInfo dom, HasScopeInfo dom, HasModuleInfo dom )
+
+inlineBinding :: forall dom . InlineBindingDomain dom => RealSrcSpan -> Refactoring dom
+inlineBinding span namedMod@(_,mod) mods
+  = let topLevel :: Simple Traversal (Module dom) (DeclList dom)
+        topLevel = nodesContaining span
+        local :: Simple Traversal (Module dom) (LocalBindList dom)
+        local = nodesContaining span
+        exprs :: Simple Traversal (Module dom) (Expr dom)
+        exprs = nodesContaining span
+        elemAccess :: (BindingElem d) => AnnList d dom -> Maybe (ValueBind dom)
+        elemAccess = getValBindInList span
+        removed = catMaybes $ map elemAccess (mod ^? topLevel) ++ map elemAccess (mod ^? local)
+     in case reverse removed of
+          [] -> refactError "No binding is selected."
+          removedBinding:_ ->
+           let [removedBindingName] = nub $ catMaybes $ map semanticsName (removedBinding ^? bindingName)
+            in if | any (containInlined removedBindingName) mods
+                    -> refactError "Cannot inline the definition, it is used in other modules."
+                  | _:_ <- mod ^? modHead & annJust & mhExports & annJust & biplateRef
+                                          & filtered (\n -> semanticsName (n :: QualifiedName dom) == Just removedBindingName)
+                    -> refactError "Cannot inline the definition, it is present in the export list."
+                  | otherwise -> localRefactoring (inlineBinding' topLevel local exprs removedBinding removedBindingName) namedMod mods
+
+-- | Performs the inline binding on a single module.
+inlineBinding' :: InlineBindingDomain dom
+                    => Simple Traversal (Module dom) (DeclList dom)
+                    -> Simple Traversal (Module dom) (LocalBindList dom)
+                    -> Simple Traversal (Module dom) (Expr dom)
+                    -> ValueBind dom -> GHC.Name
+                    -> LocalRefactoring dom
+inlineBinding' topLevelRef localRef exprRef removedBinding removedBindingName mod
+  = do replacement <- createReplacement removedBinding
+       let RealSrcSpan bindingSpan = getRange removedBinding
+       mod' <- removeBindingAndSig topLevelRef localRef exprRef removedBindingName mod
+       (mod'', used) <- runStateT (descendBiM (replaceInvocations bindingSpan removedBindingName replacement) mod') False
+       if not used
+         then refactError "The selected definition is not used, it can be safely deleted."
+         else return mod''
+
+-- | True if the given module contains the name of the inlined definition.
+containInlined :: forall dom . InlineBindingDomain dom => GHC.Name -> ModuleDom dom -> Bool
+containInlined name (_,mod)
+  = any (\qn -> semanticsName qn == Just name) $ (mod ^? biplateRef :: [QualifiedName dom])
+
+-- | Removes the inlined binding and the accompanying type and fixity signatures.
+removeBindingAndSig :: InlineBindingDomain dom
+                         => Simple Traversal (Module dom) (DeclList dom)
+                         -> Simple Traversal (Module dom) (LocalBindList dom)
+                         -> Simple Traversal (Module dom) (Expr dom)
+                         -> GHC.Name
+                         -> LocalRefactoring dom
+removeBindingAndSig topLevelRef localRef exprRef name
+  = (return . removeEmptyBnds (topLevelRef & annList & declValBind &+& localRef & annList & localVal) exprRef)
+      <=< (topLevelRef !~ removeBindingAndSig' name)
+      <=< (localRef !~ removeBindingAndSig' name)
+
+removeBindingAndSig' :: (SourceInfoTraversal d, InlineBindingDomain dom, BindingElem d)
+                     => GHC.Name -> AnnList d dom -> LocalRefactor dom (AnnList d dom)
+removeBindingAndSig' name ls = do
+   bnds <- mapM notThatBindOrSig (ls ^? annList)
+   return $ (annList .- removeNameFromSigBind) (filterListIndexed (\i _ -> bnds !! i) ls)
+  where notThatBindOrSig e
+          | Just sb <- e ^? sigBind = return $ nub (map semanticsName (sb ^? tsName & annList & simpleName)) /= [Just name]
+          | Just vb <- e ^? valBind = do
+             let isThat = nub (map semanticsName (vb ^? bindingName)) == [Just name]
+             when isThat (void $ accessRhs !| checkForRecursion name $ vb)
+             return $ not isThat
+          | Just fs <- e ^? fixitySig = return $ nub (map semanticsName (fs ^? fixityOperators & annList & operatorName)) /= [Just name]
+          | otherwise = return True
+
+        removeNameFromSigBind
+          = (sigBind & tsName .- filterList (\n -> semanticsName (n ^. simpleName) /= Just name))
+             . (fixitySig & fixityOperators .- filterList (\n -> semanticsName (n ^. operatorName) /= Just name))
+
+        accessRhs = valBindRhs
+                      &+& valBindLocals & accessLocalRhs
+                      &+& funBindMatches & annList & matchRhs
+                      &+& funBindMatches & annList & (matchRhs &+& matchBinds & accessLocalRhs)
+        accessLocalRhs = annJust & localBinds & annList & localVal & accessRhs
+
+-- | Check the extracted bindings right-hand-side for possible recursion
+checkForRecursion :: InlineBindingDomain dom
+                  => GHC.Name -> Rhs dom -> LocalRefactor dom ()
+checkForRecursion n = void . (biplateRef !| checkNameForRecursion n)
+
+checkNameForRecursion :: InlineBindingDomain dom
+                      => GHC.Name -> AST.Name dom -> LocalRefactor dom ()
+checkNameForRecursion name n
+  | semanticsName (n ^. simpleName) == Just name
+  = refactError $ "Cannot inline definitions containing direct recursion. Recursive call at: "
+                    ++ shortShowSpanWithFile (getRange n)
+  | otherwise = return ()
+
+-- | As a top-down transformation, replaces the occurrences of the binding with generated expressions. This method passes
+-- the captured arguments of the function call to generate simpler results.
+replaceInvocations :: InlineBindingDomain dom
+                   => RealSrcSpan -> GHC.Name -> ([[GHC.Name]] -> [Expr dom] -> Expr dom) -> Expr dom -> StateT Bool (LocalRefactor dom) (Expr dom)
+replaceInvocations bindingRange name replacement expr
+  | (Var n, args) <- splitApps expr
+  , semanticsName (n ^. simpleName) == Just name
+  = do put True
+       replacement (map (map (^. _1)) $ semanticsScope expr)
+         <$> mapM (descendM (replaceInvocations bindingRange name replacement)) args
+  | otherwise
+  = descendM (replaceInvocations bindingRange name replacement) expr
+
+-- | Splits an application into function and arguments. Works also for operators.
+splitApps :: Expr dom -> (Expr dom, [Expr dom])
+splitApps (App f a) = case splitApps f of (fun, args) -> (fun, args ++ [a])
+splitApps (InfixApp l (NormalOp qn) r) = (mkVar (mkParenName qn), [l,r])
+splitApps (InfixApp l (BacktickOp qn) r) = (mkVar (mkNormalName qn), [l,r])
+splitApps (Paren expr) = splitApps expr
+splitApps expr = (expr, [])
+
+-- | Rejoins the function and the arguments as an expression.
+joinApps :: Expr dom -> [Expr dom] -> Expr dom
+joinApps f [] = f
+joinApps f args = parenIfNeeded (foldl mkApp f args)
+
+-- | Create an expression that is equivalent to calling the given bind.
+createReplacement :: InlineBindingDomain dom => ValueBind dom -> LocalRefactor dom ([[GHC.Name]] -> [Expr dom] -> Expr dom)
+createReplacement (SimpleBind (VarPat _) (UnguardedRhs e) locals)
+  = return $ \_ args -> joinApps (parenIfNeeded $ wrapLocals locals e) args
+createReplacement (SimpleBind _ _ _)
+  = refactError "Cannot inline, illegal simple bind. Only variable left-hand sides and unguarded right-hand sides are accepted."
+createReplacement (FunctionBind (AnnList [Match lhs (UnguardedRhs expr) locals]))
+  = return $ \_ args -> let (argReplacement, matchedPats, appliedArgs) = matchArguments (getArgsOf lhs) args
+                         in joinApps (parenIfNeeded (createLambda matchedPats (wrapLocals locals (replaceExprs argReplacement expr)))) appliedArgs
+  where getArgsOf (MatchLhs _ (AnnList args)) = args
+        getArgsOf (InfixLhs lhs _ rhs (AnnList more)) = lhs:rhs:more
+createReplacement (FunctionBind matches)
+                                                 -- function bind has at least one match
+  = return $ \sc args -> let numArgs = getArgNum (head (matches ^? annList & matchLhs)) - length args
+                             newArgs = take numArgs $ map mkName $ filter notInScope $ map (("x" ++ ) . show @Int) [1..]
+                             notInScope str = not $ any (any ((== str) . occNameString . getOccName)) sc
+                          in parenIfNeeded $ createLambda (map mkVarPat newArgs)
+                                           $ mkCase (mkTuple $ map mkVar newArgs ++ args)
+                                           $ map replaceMatch (matches ^? annList)
+  where getArgNum (MatchLhs _ (AnnList args)) = length args
+        getArgNum (InfixLhs _ _ _ (AnnList more)) = length more + 2
+
+-- | Replaces names with expressions according to a mapping.
+replaceExprs :: InlineBindingDomain dom => [(GHC.Name, Expr dom)] -> Expr dom -> Expr dom
+replaceExprs [] = id
+replaceExprs replaces = (uniplateRef .-) $ \case
+    Var n | Just name <- semanticsName (n ^. simpleName)
+          , Just replace <- lookup name replaces
+          -> replace
+    e -> e
+
+-- | Matches a pattern list with an expression list and generates bindings. Matches until an argument cannot be matched.
+matchArguments :: InlineBindingDomain dom => [Pattern dom] -> [Expr dom] -> ([(GHC.Name, Expr dom)], [Pattern dom], [Expr dom])
+matchArguments (ParenPat p : pats) exprs = matchArguments (p:pats) exprs
+matchArguments (p:pats) (e:exprs)
+  | Just replacement <- staticPatternMatch p e
+  = case matchArguments pats exprs of (replacements, patterns, expressions) -> (replacement ++ replacements, patterns, expressions)
+  | otherwise
+  = ([], p:pats, e:exprs)
+matchArguments pats [] = ([], pats, [])
+matchArguments [] exprs = ([], [], exprs)
+
+-- | Matches a pattern with an expression. Generates a mapping of names to expressions.
+staticPatternMatch :: InlineBindingDomain dom => Pattern dom -> Expr dom -> Maybe [(GHC.Name, Expr dom)]
+staticPatternMatch (VarPat n) e
+  | Just name <- semanticsName $ n ^. simpleName
+  = Just [(name, e)]
+staticPatternMatch (AppPat n (AnnList args)) e
+  | (Var n', exprs) <- splitApps e
+  , length args == length exprs
+      && semanticsName (n ^. simpleName) == semanticsName (n' ^. simpleName)
+  , Just subs <- sequence $ zipWith staticPatternMatch args exprs
+  = Just $ concat subs
+staticPatternMatch (TuplePat (AnnList pats)) (Tuple (AnnList args))
+  | length pats == length args
+  , Just subs <- sequence $ zipWith staticPatternMatch pats args
+  = Just $ concat subs
+staticPatternMatch _ _ = Nothing
+
+replaceMatch :: Match dom -> Alt dom
+replaceMatch (Match lhs rhs locals) = mkAlt (toPattern lhs) (toAltRhs rhs) (locals ^? annJust)
+  where toPattern (MatchLhs _ (AnnList pats)) = mkTuplePat pats
+        toPattern (InfixLhs lhs _ rhs (AnnList more)) = mkTuplePat (lhs:rhs:more)
+
+        toAltRhs (UnguardedRhs expr) = mkCaseRhs expr
+        toAltRhs (GuardedRhss (AnnList rhss)) = mkGuardedCaseRhss (map toAltGuardedRhs rhss)
+
+        toAltGuardedRhs (GuardedRhs (AnnList guards) expr) = mkGuardedCaseRhs guards expr
+
+wrapLocals :: MaybeLocalBinds dom -> Expr dom -> Expr dom
+wrapLocals bnds = case bnds ^? annJust & localBinds & annList of
+                    [] -> id
+                    localBinds -> mkLet localBinds
+
+-- | True for patterns that need to be parenthesized if in a lambda
+compositePat :: Pattern dom -> Bool
+compositePat (AppPat {}) = True
+compositePat (InfixAppPat {}) = True
+compositePat (TypeSigPat {}) = True
+compositePat (ViewPat {}) = True
+compositePat _ = False
+
+parenIfNeeded :: Expr dom -> Expr dom
+parenIfNeeded e = if compositeExprs e then mkParen e else e
+
+-- | True for expresssions that need to be parenthesized if in application
+compositeExprs :: Expr dom -> Bool
+compositeExprs (App {}) = True
+compositeExprs (InfixApp {}) = True
+compositeExprs (Lambda {}) = True
+compositeExprs (Let {}) = True
+compositeExprs (If {}) = True
+compositeExprs (Case {}) = True
+compositeExprs (Do {}) = True
+compositeExprs _ = False
+
+createLambda :: [Pattern dom] -> Expr dom -> Expr dom
+createLambda [] = id
+createLambda pats = mkLambda (map (\p -> if compositePat p then mkParenPat p else p) pats)
+ Language/Haskell/Tools/Refactor/Builtin/OrganizeExtensions.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE ConstraintKinds, FlexibleContexts, RankNTypes, TupleSections, TypeFamilies, LambdaCase #-}
+
+module Language.Haskell.Tools.Refactor.Builtin.OrganizeExtensions
+  ( module Language.Haskell.Tools.Refactor.Builtin.OrganizeExtensions
+  , module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
+  ) where
+
+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 hiding (LambdaCase)
+import Language.Haskell.Tools.Refactor.Utils.Extensions (expandExtension)
+
+import GHC (Ghc(..))
+
+import Control.Reference
+import Data.Char (isAlpha)
+import Data.Function (on)
+import Data.List
+import qualified Data.Map.Strict as SMap (keys, empty)
+
+-- NOTE: When working on the entire AST, we should build a monad,
+--       that will will avoid unnecessary checks.
+--       For example if it already found a record wildcard, it won't check again
+
+--       Pretty easy now. Chcek wheter it is already in the ExtMap.
+
+type OrganizeExtensionsDomain dom = (HasModuleInfo dom, ExtDomain dom)
+
+organizeExtensionsRefactoring :: OrganizeExtensionsDomain dom => RefactoringChoice dom
+organizeExtensionsRefactoring = ModuleRefactoring "OrganizeExtensions" (localRefactoring organizeExtensions)
+
+projectOrganizeExtensionsRefactoring :: OrganizeExtensionsDomain dom => RefactoringChoice dom
+projectOrganizeExtensionsRefactoring = ProjectRefactoring "ProjectOrganizeExtensions" projectOrganizeExtensions
+
+projectOrganizeExtensions :: forall dom . OrganizeExtensionsDomain dom => ProjectRefactoring dom
+projectOrganizeExtensions =
+  mapM (\(k, m) -> ContentChanged . (k,) <$> localRefactoringRes id m (organizeExtensions m))
+
+tryOut :: String -> String -> IO ()
+tryOut = tryRefactor (localRefactoring . const organizeExtensions)
+
+organizeExtensions :: ExtDomain dom => LocalRefactoring dom
+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
+
+  -- remove unused extensions (only those that are fully handled)
+  filePragmas & annList & lpPragmas !~ filterListSt (not . isRedundant)
+        -- remove empty {-# LANGUAGE #-} pragmas
+    >=> filePragmas !~ filterListSt (\case LanguagePragma (AnnList []) -> False; _ -> True)
+    $ moduleAST
+
+-- | Reduces default extension list (keeps unsupported extensions)
+reduceExtensions :: ExtDomain dom => UnnamedModule dom -> Ghc [Extension]
+reduceExtensions = \moduleAST -> do
+  let expanded = expandDefaults moduleAST
+      (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
+
+
+-- | Collects extensions induced by the source code (with location info)
+collectExtensions :: ExtDomain dom => UnnamedModule dom -> Ghc ExtMap
+collectExtensions moduleAST = do
+  let expanded = expandDefaults moduleAST
+  flip execStateT SMap.empty . flip runReaderT expanded . traverseModule $ moduleAST
+
+-- | Collects default extension list, and expands each extension
+expandDefaults :: UnnamedModule dom -> [Extension]
+expandDefaults = nub . concatMap expandExtension . collectDefaultExtensions
+
+-- | Collects extensions enabled by default
+collectDefaultExtensions :: UnnamedModule dom -> [Extension]
+collectDefaultExtensions = map toExt . getExtensions
+  where
+  getExtensions :: UnnamedModule dom -> [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."
+ Language/Haskell/Tools/Refactor/Builtin/OrganizeImports.hs view
@@ -0,0 +1,229 @@+{-# LANGUAGE ConstraintKinds, FlexibleContexts, LambdaCase, ScopedTypeVariables, TupleSections, TypeApplications, TypeFamilies #-}
+module Language.Haskell.Tools.Refactor.Builtin.OrganizeImports
+  ( organizeImports, OrganizeImportsDomain, projectOrganizeImports
+  , organizeImportsRefactoring, projectOrganizeImportsRefactoring
+  ) where
+
+import ConLike (ConLike(..))
+import DataCon (dataConTyCon)
+import DynFlags (xopt)
+import FamInstEnv (FamInst(..))
+import GHC (TyThing(..), lookupName)
+import qualified GHC
+import Id
+import IdInfo (RecSelParent(..))
+import InstEnv (ClsInst(..))
+import Language.Haskell.TH.LanguageExtensions as GHC (Extension(..))
+import Name (NamedThing(..))
+import OccName (HasOccName(..), isSymOcc)
+import qualified PrelNames as GHC (fromStringName, coerceKey)
+import SrcLoc (SrcSpan(..), noSrcSpan)
+import TyCon (TyCon(..), tyConFamInst_maybe)
+import Unique (getUnique)
+
+import Control.Applicative ((<$>), Alternative(..))
+import Control.Monad
+import Control.Reference hiding (element)
+import Data.Function hiding ((&))
+import Data.Generics.Uniplate.Data (universeBi)
+import Data.List
+import Data.Maybe (Maybe(..), maybe, catMaybes)
+
+import Language.Haskell.Tools.Refactor as AST
+
+organizeImportsRefactoring :: OrganizeImportsDomain dom => RefactoringChoice dom
+organizeImportsRefactoring = ModuleRefactoring "OrganizeImports" (localRefactoring organizeImports)
+
+projectOrganizeImportsRefactoring :: OrganizeImportsDomain dom => RefactoringChoice dom
+projectOrganizeImportsRefactoring = ProjectRefactoring "ProjectOrganizeImports" projectOrganizeImports
+
+type OrganizeImportsDomain dom = ( HasNameInfo dom, HasImportInfo dom, HasModuleInfo dom, HasImplicitFieldsInfo dom )
+
+projectOrganizeImports :: forall dom . OrganizeImportsDomain dom => ProjectRefactoring dom
+projectOrganizeImports mods
+  = mapM (\(k, m) -> ContentChanged . (k,) <$> localRefactoringRes id m (organizeImports m)) mods
+
+organizeImports :: forall dom . OrganizeImportsDomain dom => LocalRefactoring dom
+organizeImports mod
+  = do usedTyThings <- catMaybes <$> mapM lookupName usedNames
+       let dfs = semanticsDynFlags mod
+           noNarrowingImports
+             = xopt TemplateHaskell dfs -- no narrowing if TH is present (we don't know what will be used)
+                || xopt QuasiQuotes dfs -- no narrowing if TH quotes are present (we don't know what will be used)
+                || (xopt FlexibleInstances dfs && noNarrowingSubspecs) -- arbitrary ctors might be needed when using imported data families
+                || hasCoerce -- the presence of coerce implicitely requires the constructors to be present
+           noNarrowingSubspecs
+             = -- both standalone deriving and FFI marshalling can cause constructors to be used in the generated code
+               xopt GHC.StandaloneDeriving dfs || hasMarshalling
+                   -- while pattern synonyms are not handled correctly, we disable subspec narrowing to be safe
+                || patternSynonymAreUsed usedTyThings
+       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
+        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
+                        -- the declarations (used), both from the module head (re-exported) will count as usage
+                      (universeBi (mod ^. modHead) ++ universeBi (mod ^. modDecl) :: [QualifiedName dom]))
+                        ++ concatMap (map fst . semanticsImplicitFlds) (universeBi (mod ^. modDecl) :: [FieldWildcard dom])
+        -- Prelude is not actually exported, but we don't want to remove it if it is explicitly there
+        -- otherwise, we might add new imported elements that cause conflicts.
+        exportedModules = "Prelude" : (mod ^? modHead & annJust & mhExports & annJust
+                                                & espExports & annList & exportModuleName & moduleNameString)
+
+        -- Exported definitions must be kept imported
+        exports = mod ^? modHead & annJust & mhExports & annJust & espExports & annList & exportDecl
+        exportedNames = catMaybes $ map getExported exports
+        getExported e = fmap (,hasChild) name
+          where name = semanticsName (e ^. ieName & simpleName)
+                hasChild = (case e ^? ieSubspec & annJust of Just SubAll -> True; _ -> False)
+                             || not (null @[] (e ^? ieSubspec & annJust & essList & annList))
+
+        -- Checks if the module uses foreign import/export that requires marshalling. In this case no
+        -- subspecifiers could be narrowed because constructors might be needed.
+        hasMarshalling = not $ null @[] (mod ^? modDecl & annList & declForeignType)
+        hasCoerce = GHC.coerceKey `elem` map getUnique usedNames
+
+        -- Can this name be part of the source code?
+        -- isSourceName n = ':' `notElem` occNameString (occName n)
+        patternSynonymAreUsed tts = any (\case AConLike (PatSynCon _) -> True; _ -> False) tts
+
+-- | Sorts the imports in alphabetical order
+sortImports :: forall dom . ImportDeclList dom -> ImportDeclList dom
+sortImports ls = srcInfo & srcTmpSeparators .= filter (not . null . fst) (concatMap (\(sep,elems) -> sep : map fst elems) reordered)
+                   $ annListElems .= concatMap (map snd . snd) reordered
+                   $ ls
+  where reordered :: [(([SourceTemplateTextElem], SrcSpan), [(([SourceTemplateTextElem], SrcSpan), ImportDecl dom)])]
+        reordered = map (_2 .- sortBy (compare `on` (^. _2 & importModule & AST.moduleNameString))) parts
+
+        parts = map (_2 .- reverse) $ reverse $ breakApart [] imports
+
+        -- break up the list of imports to import groups
+        breakApart :: [(([SourceTemplateTextElem], SrcSpan), [(([SourceTemplateTextElem], SrcSpan), ImportDecl dom)])]
+                        -> [(([SourceTemplateTextElem], SrcSpan), ImportDecl dom)]
+                        -> [(([SourceTemplateTextElem], SrcSpan), [(([SourceTemplateTextElem], SrcSpan), ImportDecl dom)])]
+        breakApart res [] = res
+        breakApart res ((sep, e) : rest) | length (filter ('\n' ==) (sep ^? _1 & traversal & sourceTemplateText & traversal)) > 1
+                                            || "\n#" `isInfixOf` (sep ^? _1 & traversal & sourceTemplateText & traversal)
+          = breakApart ((sep, [(([], noSrcSpan),e)]) : res) rest
+        breakApart ((lastSep, lastRes) : res) (elem : rest)
+          = breakApart ((lastSep, elem : lastRes) : res) rest
+        breakApart [] ((sep, e) : rest)
+          = breakApart [(sep, [(([], noSrcSpan),e)])] rest
+
+        imports = zipWithSeparators ls
+
+-- | Modify an import to only import  names that are used.
+narrowImports :: forall dom . OrganizeImportsDomain dom
+              => Bool -> [String] -> [GHC.Name] -> [(GHC.Name, Bool)] -> [ClsInst] -> [FamInst] -> ImportDeclList dom -> LocalRefactor dom (ImportDeclList dom)
+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)
+
+-- | Reduces the number of definitions used from an import
+narrowImport :: OrganizeImportsDomain dom
+             => Bool -> [String] -> [GHC.Name] -> [(GHC.Name, Bool)] -> ImportDecl dom -> LocalRefactor dom (ImportDecl dom)
+narrowImport noNarrowSubspecs exportedModules usedNames exportedNames imp
+  | (imp ^. importModule & moduleNameString) `elem` exportedModules
+      || maybe False (`elem` exportedModules) (imp ^? importAs & annJust & importRename & moduleNameString)
+  = return imp -- dont change an import if it is exported as-is (module export)
+  | importIsExact imp
+  = importSpec&annJust&importSpecList !~ narrowImportSpecs noNarrowSubspecs usedNames exportedNames $ imp
+  | importIsHiding imp
+  = return imp -- a hiding import is not changed, because the wildcard importing of class and datatype
+               -- members could bring into scope the exact definition that was hidden
+  | otherwise
+  = do namedThings <- mapM lookupName actuallyImported
+       let -- to explicitly import pattern synonyms or type operators we need to enable an extension, and the user might not expect this
+           hasRiskyDef = any isRiskyDef namedThings
+           groups = groupThings noNarrowSubspecs (semanticsImported imp)
+                      (filter ((`elem` semanticsImported imp) . fst) exportedNames) (catMaybes namedThings)
+       return $ if not hasRiskyDef && length groups < 4
+         then importSpec .- replaceWithJust (createImportSpec groups) $ imp
+         else imp
+  where actuallyImported = semanticsImported imp `intersect` usedNames
+        isRiskyDef (Just (AConLike (PatSynCon _))) = True
+        isRiskyDef (Just (ATyCon tc)) = isSymOcc (occName (tyConName tc))
+        isRiskyDef _ = False
+
+-- | Group things as importable definitions. The second member of the pair will be true, when there is a sub-name
+-- that should be imported apart from the name of the importable definition.
+groupThings :: Bool -> [GHC.Name] -> [(GHC.Name, Bool)] -> [TyThing] -> [(GHC.Name, Bool)]
+groupThings noNarrowSubspecs importable exported
+  = map last . groupBy ((==) `on` fst) . sort . (exported ++) . map createImportFromTyThing
+  where createImportFromTyThing :: TyThing -> (GHC.Name, Bool)
+        createImportFromTyThing tt | Just (td, isDataType) <- getTopDef tt
+          = if (td `elem` importable || isDataType) then (td, True)
+                                                    else (getName tt, False)
+        createImportFromTyThing tt@(ATyCon {}) = (getName tt, noNarrowSubspecs)
+        createImportFromTyThing tt = (getName tt, False)
+
+-- | Gets the importable definition for a (looked up) name. The bool flag tells if it is from
+-- a data type.
+getTopDef :: TyThing -> Maybe (GHC.Name, Bool)
+getTopDef (AnId id) | isRecordSelector id
+  = case recordSelectorTyCon id of RecSelData tc -> Just (getName tc, True)
+                                   RecSelPatSyn ps -> Just (getName ps, False)
+getTopDef (AnId id)
+  | Just n <- fmap (getName . dataConTyCon) (isDataConWorkId_maybe id <|> isDataConId_maybe id)
+  = Just (n, True)
+getTopDef (AnId id) = fmap ((,False) . getName) (isClassOpId_maybe id)
+getTopDef (AConLike (RealDataCon dc))
+  = case tyConFamInst_maybe (dataConTyCon dc) of
+      Just (dataFam, _) -> Just (getName dataFam, True)
+      _                 -> Just (getName $ dataConTyCon dc, True)
+getTopDef (AConLike (PatSynCon _)) = error "getTopDef: should not be called with pattern synonyms"
+getTopDef (ATyCon _) = Nothing
+
+createImportSpec :: [(GHC.Name, Bool)] -> ImportSpec dom
+createImportSpec elems = mkImportSpecList $ map createIESpec elems
+  where createIESpec (n, False) = mkIESpec (mkUnqualName' (GHC.getName n)) Nothing
+        createIESpec (n, True)  = mkIESpec (mkUnqualName' (GHC.getName n)) (Just mkSubAll)
+
+-- | Check each import if it is actually needed
+neededImports :: OrganizeImportsDomain dom
+              => [String] -> [GHC.Name] -> [ClsInst] -> [FamInst] -> [ImportDecl dom] -> [Bool]
+neededImports exportedModules usedNames prelInsts prelFamInsts imps = neededImports' usedNames [] imps
+  where neededImports' _ _ [] = []
+        -- keep the import if any definition is needed from it
+        neededImports' usedNames kept (imp : rest)
+          | not (null actuallyImported)
+               || (imp ^. importModule & moduleNameString) `elem` exportedModules
+               || maybe False (`elem` exportedModules) (imp ^? importAs & annJust & importRename & moduleNameString)
+            = True : neededImports' usedNames (imp : kept) 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)
+
+-- | Narrows the import specification (explicitly imported elements)
+narrowImportSpecs :: forall dom . OrganizeImportsDomain dom
+                  => Bool -> [GHC.Name] -> [(GHC.Name, Bool)] -> IESpecList dom -> LocalRefactor dom (IESpecList dom)
+narrowImportSpecs noNarrowSubspecs usedNames exportedNames
+  = (if noNarrowSubspecs then return else annList !~ narrowImportSubspecs neededNames exportedNames)
+       >=> filterListSt isNeededSpec
+  where neededNames = usedNames ++ map fst exportedNames
+
+        isNeededSpec :: IESpec dom -> Bool
+        isNeededSpec ie =
+          (semanticsName (ie ^. ieName&simpleName)) `elem` map Just neededNames
+          -- if the name is not used, but some of its constructors are used, it is needed
+            || ((ie ^? ieSubspec&annJust&essList&annList) /= [])
+            -- its a bit hard to decide if there is an element inside (for example bundled pattern synonyms)
+            || (case ie ^? ieSubspec&annJust of Just SubAll -> True; _ -> False)
+
+-- | Reduces the number of definitions imported from a sub-specifier.
+narrowImportSubspecs :: OrganizeImportsDomain dom => [GHC.Name] -> [(GHC.Name, Bool)] -> IESpec dom -> LocalRefactor dom (IESpec dom)
+narrowImportSubspecs neededNames exportedNames ss | noNarrowingForThis = return ss
+  | otherwise
+  = ieSubspec & annJust & essList !~ filterListSt (\n -> (semanticsName (n ^. simpleName)) `elem` map Just neededNames) $ ss
+  where noNarrowingForThis = case semanticsName (ss ^. ieName&simpleName) of
+                               Just name -> lookup name exportedNames == Just True
+                               _ -> False
+ Language/Haskell/Tools/Refactor/Builtin/RenameDefinition.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE ConstraintKinds, FlexibleContexts, MultiWayIf, ScopedTypeVariables, TupleSections, TypeApplications, TypeFamilies, ViewPatterns #-}
+module Language.Haskell.Tools.Refactor.Builtin.RenameDefinition
+  (renameDefinition, renameDefinition', DomainRenameDefinition, renameDefinitionRefactoring) where
+
+import DataCon (dataConFieldLabels, FieldLbl(..), dataConFieldType)
+import qualified GHC
+import Id
+import IdInfo (RecSelParent(..))
+import Name (OccName(..), NamedThing(..), occNameString)
+import SrcLoc (RealSrcSpan)
+import TyCon (tyConDataCons)
+import Type (funResultTy, eqType)
+
+import Control.Monad.State
+import Control.Reference as Ref
+import Data.Generics.Uniplate.Data ()
+import Data.List
+import Data.List.Split (splitOn)
+import Data.Maybe
+import Language.Haskell.Tools.Refactor
+
+renameDefinitionRefactoring :: DomainRenameDefinition dom => RefactoringChoice dom
+renameDefinitionRefactoring = NamingRefactoring "RenameDefinition" renameDefinition'
+
+type DomainRenameDefinition dom = ( HasNameInfo dom, HasScopeInfo dom, HasDefiningInfo dom
+                                  , HasImplicitFieldsInfo dom, HasModuleInfo dom )
+
+renameDefinition' :: forall dom . DomainRenameDefinition dom => RealSrcSpan -> String -> Refactoring dom
+renameDefinition' sp str mod mods
+  = case (getNodeContaining sp (snd mod) :: Maybe (QualifiedName dom)) >>= (fmap getName . semanticsName) of
+      Just name -> do let sameNames = bindsWithSameName name (snd mod ^? biplateRef)
+                      renameDefinition name sameNames str mod mods
+        where bindsWithSameName :: GHC.Name -> [FieldWildcard dom] -> [GHC.Name]
+              bindsWithSameName name wcs = catMaybes $ map ((lookup name) . semanticsImplicitFlds) wcs
+      Nothing -> case getNodeContaining sp (snd mod) of
+                   Just modName -> renameModule (any @[] (sp `isInside`) ((snd mod) ^? modImports&annList&importAs))
+                                                (modName ^. moduleNameString) str mod mods
+                   Nothing -> refactError "No name is selected"
+
+renameModule :: forall dom . DomainRenameDefinition dom => Bool -> String -> String -> Refactoring dom
+renameModule isAlias from to m mods
+    | any (nameConflict to) (map snd $ m:mods) = refactError "Name conflict when renaming module"
+    | isJust (validModuleName to) = refactError $ "The given name is not a valid module name: " ++ fromJust (validModuleName to)
+    | otherwise = -- here it is important that the delete is the last, because rename
+                  -- can still use the info about the deleted module
+                  (if isAlias then id else (fmap (\ls -> map (alterChange from to) ls ++ [ModuleRemoved from])))
+                    $ mapM (\(name,mod) -> ContentChanged . (name,) <$> localRefactoringRes id mod (replaceModuleNames =<< alterNormalNames mod)) (m:mods)
+  where alterChange from to (ContentChanged (mod,res))
+          | (mod ^. sfkModuleName) == from
+          = ModuleCreated to res mod
+        alterChange _ _ c = c
+
+        replaceModuleNames :: LocalRefactoring dom
+        replaceModuleNames = modNames & filtered (\e -> (e ^. moduleNameString) == from) != mkModuleName to
+          where modNames = modHead & annJust & (mhName &+& mhExports & annJust & espExports & annList & exportModuleName)
+                             &+& modImports & annList & ( importModule
+                                                            &+& importAs & annJust & importRename )
+
+        alterNormalNames :: LocalRefactoring dom
+        alterNormalNames mod =
+           biplateRef @_ @(QualifiedName dom) & filtered (\e -> concat (intersperse "." (e ^? qualifiers&annList&simpleNameStr)) == from)
+             !- (\e -> mkQualifiedName (splitOn "." to) (e ^. unqualifiedName&simpleNameStr)) $ mod
+
+        nameConflict :: String -> Module dom -> Bool
+        nameConflict to mod
+          = let modName = mod ^? modHead&annJust&mhName&moduleNameString
+                imports = mod ^? modImports&annList
+                importNames = map (\imp -> fromMaybe (imp ^. importModule) (imp ^? importAs&annJust&importRename) ^. moduleNameString) imports
+             in modName == Just to || to `elem` importNames
+
+renameDefinition :: DomainRenameDefinition dom => GHC.Name -> [GHC.Name] -> String -> Refactoring dom
+renameDefinition toChangeOrig toChangeWith newName mod mods
+    = do nameCls <- classifyName toChangeOrig
+         (changedModules,defFound) <- runStateT (catMaybes <$> mapM (renameInAModule toChangeOrig toChangeWith newName) (mod:mods)) False
+         if | isJust (nameValid nameCls newName) -> refactError $ "The new name is not valid: " ++ fromJust (nameValid nameCls newName)
+            | not defFound -> refactError "The definition to rename was not found. Maybe it is in another package."
+            | otherwise -> return $ map ContentChanged changedModules
+  where
+    renameInAModule :: DomainRenameDefinition dom => GHC.Name -> [GHC.Name] -> String -> ModuleDom dom -> StateT Bool Refactor (Maybe (ModuleDom dom))
+    renameInAModule toChangeOrig toChangeWith newName (name, mod)
+      = mapStateT (localRefactoringRes (\f (a,s) -> (fmap (\(n,r) -> (n, f r)) a,s)) mod) $
+          do origTT <- GHC.lookupName toChangeOrig
+             let origId = case origTT of
+                            Just (GHC.AnId id) -> Just id
+                            _ -> Nothing
+             (res, isChanged) <- runStateT (biplateRef !~ changeName toChangeOrig origId toChangeWith newName $ mod) False
+             if isChanged then return $ Just (name, res)
+                          else return Nothing
+
+    changeName :: DomainRenameDefinition dom => GHC.Name -> Maybe Id -> [GHC.Name] -> String -> QualifiedName dom
+                                                         -> StateT Bool (StateT Bool (LocalRefactor dom)) (QualifiedName dom)
+    changeName toChangeOrig origId toChangeWith str name
+      | maybe False (`elem` toChange) actualName
+          && semanticsDefining name == False
+          && any @[] (\n -> str == occNameString (getOccName (n ^. _1)) && not (mergeableFields origId (n ^. _1))
+                              && notQualified (n ^. _2))
+                     (scopeUpToDef (semanticsScope name) ^? traversal & traversal & filtered (sameNamespace toChangeOrig . (^. _1)))
+      = refactError $ "The definition clashes with an existing one at: " ++ shortShowSpanWithFile (getRange name) -- name clash with an external definition
+      | maybe False (`elem` toChange) actualName
+      = do put True -- state that something is changed in the local state
+           when (actualName == Just toChangeOrig)
+             $ lift $ modify (|| semanticsDefining name) -- state that the definition is renamed in the global state
+           return $ unqualifiedName .= mkNamePart str $ name -- found the changed name (or a name that have to be changed too)
+      | let namesInScope = map (map (^. _1)) $ semanticsScope name
+         in case semanticsName name of
+              Just (getName -> exprName) -> str == occNameString (getOccName exprName)
+                                              && sameNamespace toChangeOrig exprName
+                                              && conflicts toChangeOrig exprName namesInScope
+                                              && not (mergeableFields origId exprName)
+              Nothing -> False -- ambiguous names
+      = refactError $ "The definition clashes with an existing one: " ++ shortShowSpanWithFile (getRange name) -- local name clash
+      | otherwise = return name -- not the changed name, leave as before
+      where toChange = toChangeOrig : toChangeWith
+            actualName = fmap getName (semanticsName name)
+            scopeUpToDef sc = let (inside, outside) = span (null . (toChange `intersect`) . map (^. _1)) sc
+                               in inside ++ take 1 outside
+            mergeableFields (Just orig) conflict
+              | isRecordSelector orig
+              , RecSelData tc <- recordSelectorTyCon orig
+              = let selectorsWithTypes = concatMap (\dc -> map (\fld -> (flSelector fld, dataConFieldType dc (flLabel fld))) (dataConFieldLabels dc))
+                                                   (filter (\dc -> toChangeOrig `notElem` map flSelector (dataConFieldLabels dc)) (tyConDataCons tc))
+                 in maybe False (`eqType` funResultTy (idType orig)) (lookup conflict selectorsWithTypes)
+            mergeableFields _ _ = False
+            notQualified usage = isNothing usage || any @[] (not . usageQualified) (usage ^? just & traversal)
+
+conflicts :: GHC.Name -> GHC.Name -> [[GHC.Name]] -> Bool
+conflicts overwrites overwritten (scopeBlock : scope)
+  | overwritten `elem` scopeBlock && overwrites `notElem` scopeBlock = False
+  | overwrites `elem` scopeBlock = True
+  | otherwise = conflicts overwrites overwritten scope
+conflicts _ _ [] = False
+
+sameNamespace :: GHC.Name -> GHC.Name -> Bool
+sameNamespace n1 n2 = occNameSpace (getOccName n1) == occNameSpace (getOccName n2)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain
+ examples/CPP/BetweenImports.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
+module CPP.BetweenImports where
+
+import Data.List
+#if !(MIN_VERSION_text(1,2,1))
+#endif
+import Data.Maybe
+
+x = Just
+ examples/CPP/BetweenImports_res.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
+module CPP.BetweenImports where
+
+import Data.Maybe (Maybe(..))
+#if !(MIN_VERSION_text(1,2,1))
+#endif
+
+
+x = Just
+ examples/CPP/ConditionalCode.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE CPP #-}
+module CPP.ConditionalCode where
+
+#if __GLASGOW_HASKELL__ >= 800
+version = "GHC 8"
+#else
+version = "not GHC 8"
+#endif
+ examples/CPP/ConditionalImport.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE CPP #-}
+module CPP.ConditionalImport where
+
+import Data.List
+#ifndef USE_DATA_LIST
+import Control.Monad (Monad(..))
+#endif
+import Data.List
+
+a = Nothing >> Nothing
+ examples/CPP/ConditionalImportBegin.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE CPP #-}
+module CPP.ConditionalImportBegin where
+
+#ifndef USE_DATA_LIST
+import Control.Monad ((>>))
+#endif
+import Data.List
+import Data.List
+
+a = Nothing >> Nothing
+ examples/CPP/ConditionalImportBegin_res.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE CPP #-}
+module CPP.ConditionalImportBegin where
+
+#ifndef USE_DATA_LIST
+import Control.Monad ((>>))
+#endif
+
+
+a = Nothing >> Nothing
+ examples/CPP/ConditionalImportEnd.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE CPP #-}
+module CPP.ConditionalImportEnd where
+
+import Data.List
+import Data.List
+#ifndef USE_DATA_LIST
+import Control.Monad ((>>))
+#endif
+
+a = Nothing >> Nothing
+ examples/CPP/ConditionalImportEnd_res.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE CPP #-}
+module CPP.ConditionalImportEnd where
+
+
+#ifndef USE_DATA_LIST
+import Control.Monad ((>>))
+#endif
+
+a = Nothing >> Nothing
+ examples/CPP/ConditionalImportHalfRemoved.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE CPP #-}
+module CPP.ConditionalImportHalfRemoved where
+
+import Data.List
+#ifndef USE_DATA_LIST
+import Control.Monad ((>>))
+#endif
+import Control.Applicative ((<$>))
+
+a = id <$> (Nothing >> Nothing)
+ examples/CPP/ConditionalImportHalfRemoved_res.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE CPP #-}
+module CPP.ConditionalImportHalfRemoved where
+
+
+#ifndef USE_DATA_LIST
+import Control.Monad ((>>))
+#endif
+import Control.Applicative ((<$>))
+
+a = id <$> (Nothing >> Nothing)
+ examples/CPP/ConditionalImportMulti.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE CPP #-}
+module CPP.ConditionalImportMulti where
+
+import Data.List
+#ifndef USE_DATA_LIST
+import Control.Applicative ((<$>))
+import Control.Monad ((>>))
+#endif
+import Data.List
+
+a = id <$> (Nothing >> Nothing)
+ examples/CPP/ConditionalImportMulti_res.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE CPP #-}
+module CPP.ConditionalImportMulti where
+
+
+#ifndef USE_DATA_LIST
+import Control.Applicative ((<$>))
+import Control.Monad ((>>))
+#endif
+
+
+a = id <$> (Nothing >> Nothing)
+ examples/CPP/ConditionalImportOrder.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE CPP #-}
+module CPP.ConditionalImportOrder where
+
+import Data.List (intersperse)
+#ifndef USE_DATA_LIST
+import Control.Monad (Monad(..))
+#endif
+import Control.Applicative ((<$>))
+
+a = Nothing >> Nothing
+
+b = id <$> Nothing
+c = intersperse "," ["a","b"]
+ examples/CPP/ConditionalImportOrder_res.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE CPP #-}
+module CPP.ConditionalImportOrder where
+
+import Data.List (intersperse)
+#ifndef USE_DATA_LIST
+import Control.Monad (Monad(..))
+#endif
+import Control.Applicative ((<$>))
+
+a = Nothing >> Nothing
+
+b = id <$> Nothing
+c = intersperse "," ["a","b"]
+ examples/CPP/ConditionalImport_res.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE CPP #-}
+module CPP.ConditionalImport where
+
+
+#ifndef USE_DATA_LIST
+import Control.Monad (Monad(..))
+#endif
+
+
+a = Nothing >> Nothing
+ examples/CPP/ConditionalSubImport.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE CPP #-}
+module CPP.ConditionalSubImport where
+
+import Data.List(findIndex,intersperse,nub,sort,sortBy
+#if __GLASGOW_HASKELL__ >= 710
+                , sortOn
+#endif
+                )
+
+a = sortOn fst [("a","x")]
+ examples/CPP/ConditionalSubImport_res.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE CPP #-}
+module CPP.ConditionalSubImport where
+
+import Data.List(
+#if __GLASGOW_HASKELL__ >= 710
+
+                sortOn
+#endif
+                )
+
+a = sortOn fst [("a","x")]
+ examples/CPP/JustEnabled.hs view
@@ -0,0 +1,2 @@+{-# LANGUAGE CPP #-}
+module CPP.JustEnabled where
+ examples/CppHs/Language/Preprocessor/Cpphs.hs view
@@ -0,0 +1,34 @@+-----------------------------------------------------------------------------
+-- |
+-- 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 view
@@ -0,0 +1,416 @@+-----------------------------------------------------------------------------
+-- |
+-- 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 view
@@ -0,0 +1,129 @@+-----------------------------------------------------------------------------
+-- |
+-- 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 view
@@ -0,0 +1,184 @@+-----------------------------------------------------------------------------
+-- |
+-- 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 view
@@ -0,0 +1,156 @@+-----------------------------------------------------------------------------
+-- |
+-- 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 view
@@ -0,0 +1,106 @@+-----------------------------------------------------------------------------
+-- |
+-- 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 view
@@ -0,0 +1,55 @@+-----------------------------------------------------------------------------
+-- |
+-- 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 view
@@ -0,0 +1,82 @@+{-
+-- 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 view
@@ -0,0 +1,92 @@+-----------------------------------------------------------------------------
+-- |
+-- 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 view
@@ -0,0 +1,281 @@+-----------------------------------------------------------------------------
+-- |
+-- 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 view
@@ -0,0 +1,72 @@+-- | 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 view
@@ -0,0 +1,9 @@+{-# 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 view
@@ -0,0 +1,8 @@+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 view
@@ -0,0 +1,10 @@+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 view
@@ -0,0 +1,9 @@+{-# 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 view
@@ -0,0 +1,16 @@+{-# 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 view
@@ -0,0 +1,10 @@+{-# 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 view
@@ -0,0 +1,6 @@+{-# LANGUAGE TypeFamilies #-}
+module Decl.DataFamily where
+
+data family Array :: * -> *
+
+data instance Array () = UnitArray Int deriving Show
+ examples/Decl/DataInstanceGADT.hs view
@@ -0,0 +1,6 @@+{-# 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 view
@@ -0,0 +1,5 @@+module Decl.DataType where
+
+data EmptyData
+
+data A = B Int | C
+ examples/Decl/DataTypeDerivings.hs view
@@ -0,0 +1,5 @@+module Decl.DataTypeDerivings where
+
+data A = A deriving (Eq, Show)
+data B = B deriving (Eq)
+data C = C deriving Eq
+ examples/Decl/DefaultDecl.hs view
@@ -0,0 +1,3 @@+module Decl.DefaultDecl where
+
+default ()
+ examples/Decl/FunBind.hs view
@@ -0,0 +1,4 @@+module Decl.FunBind where
+
+f 0 = 1
+f x = x
+ examples/Decl/FunFixity.hs view
@@ -0,0 +1,5 @@+module Decl.FunFixity where
+
+infixl `snoc`
+snoc :: [a] -> a -> [a]
+snoc xs x = xs ++ [x]
+ examples/Decl/FunGuards.hs view
@@ -0,0 +1,5 @@+module Decl.FunGuards where
+
+f 0 = 1
+f x | even x = 0
+    | otherwise = 2
+ examples/Decl/FunctionalDeps.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE FunctionalDependencies, MultiParamTypeClasses #-}
+module Decl.FunctionalDeps where
+
+class C a b | a -> b, b -> a where
+  trf :: a -> b
+
+ examples/Decl/GADT.hs view
@@ -0,0 +1,9 @@+{-# 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 view
@@ -0,0 +1,5 @@+{-# LANGUAGE GADTs #-}
+module Decl.GadtConWithCtx where
+
+data Concurrently m a where
+  Concurrently :: Monad m => { runConcurrently :: m a } -> Concurrently m a
+ examples/Decl/InfixAssertion.hs view
@@ -0,0 +1,9 @@+{-# 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 view
@@ -0,0 +1,8 @@+{-# 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 view
@@ -0,0 +1,10 @@+{-# 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 view
@@ -0,0 +1,6 @@+{-# LANGUAGE TypeFamilies, TypeFamilyDependencies #-}
+module Decl.InjectiveTypeFamily where
+
+type family Array a = r | r -> a
+
+type instance Array () = Int
+ examples/Decl/InlinePragma.hs view
@@ -0,0 +1,5 @@+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 view
@@ -0,0 +1,10 @@+{-# 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 view
@@ -0,0 +1,11 @@+{-# 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 view
@@ -0,0 +1,7 @@+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 view
@@ -0,0 +1,7 @@+module Decl.LocalBindingInDo where
+
+x :: Maybe ()
+x = do let y = f a
+             where a = ()
+       return y
+    where f = id
+ examples/Decl/LocalBindings.hs view
@@ -0,0 +1,9 @@+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 view
@@ -0,0 +1,6 @@+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 view
@@ -0,0 +1,23 @@+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 view
@@ -0,0 +1,11 @@+{-# 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 view
@@ -0,0 +1,12 @@+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 view
@@ -0,0 +1,6 @@+module Decl.MultipleSigs where
+
+f, g :: Int -> Int -> Int
+f a b = a + b
+
+g = f
+ examples/Decl/OperatorBind.hs view
@@ -0,0 +1,6 @@+module Decl.OperatorBind where
+
+a >< b = a ++ b
+
+(<+>) :: Int -> Int -> Int -> Int
+(a <+> b) c = a + b + c
+ examples/Decl/OperatorDecl.hs view
@@ -0,0 +1,6 @@+module Decl.OperatorDecl where
+
+(-!-) :: Int -> Int -> Int
+(-!-) a b = a + b
+
+test = (-!-) (1 -!- 2) 3
+ examples/Decl/ParamDataType.hs view
@@ -0,0 +1,5 @@+module Decl.ParamDataType where
+
+data A a = B Int | C a
+
+data X a = X a
+ examples/Decl/PatternBind.hs view
@@ -0,0 +1,3 @@+module Decl.PatternBind where
+
+(x,y) | 1 == 1 = (1,2)
+ examples/Decl/PatternSynonym.hs view
@@ -0,0 +1,28 @@+{-# 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 view
@@ -0,0 +1,8 @@+{-# 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 view
@@ -0,0 +1,3 @@+module Decl.RecordType where
+
+data A = B { valB, extra :: Int, qq :: Double } | C
+ examples/Decl/RewriteRule.hs view
@@ -0,0 +1,3 @@+module Decl.RewriteRule where
+
+{-# RULES "map/map" forall f g xs . map f (map g xs) = map (f . g) xs #-}
+ examples/Decl/SpecializePragma.hs view
@@ -0,0 +1,5 @@+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 view
@@ -0,0 +1,6 @@+{-# LANGUAGE StandaloneDeriving #-}
+module Decl.StandaloneDeriving where
+
+data WrapStr = WrapStr String 
+
+deriving instance Eq WrapStr
+ examples/Decl/TypeClass.hs view
@@ -0,0 +1,13 @@+{-# 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 view
@@ -0,0 +1,8 @@+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 view
@@ -0,0 +1,6 @@+{-# LANGUAGE TypeFamilies #-}
+module Decl.TypeFamily where
+
+type family Array a :: *
+
+type instance Array () = Int
+ examples/Decl/TypeFamilyKindSig.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE TypeFamilies #-}
+module Decl.TypeFamilyKindSig where
+
+type family Array (a :: *) :: *
+
+type instance Array () = Int
+ examples/Decl/TypeInstance.hs view
@@ -0,0 +1,14 @@+{-# 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 view
@@ -0,0 +1,5 @@+{-# LANGUAGE RoleAnnotations #-}
+module Decl.TypeRole where
+
+type role Foo representational representational
+data Foo a b = Foo Int
+ examples/Decl/TypeSynonym.hs view
@@ -0,0 +1,3 @@+module Decl.TypeSynonym where
+
+type List = Int
+ examples/Decl/ValBind.hs view
@@ -0,0 +1,3 @@+module Decl.ValBind where
+
+x = 1
+ examples/Decl/ViewPatternSynonym.hs view
@@ -0,0 +1,8 @@+{-# 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 view
@@ -0,0 +1,10 @@+{-# 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 view
@@ -0,0 +1,8 @@+module Expr.Case where
+
+x = 12
+
+a = case x of 1 -> 0
+              _ -> 1
+
+b = case x of { 1 -> 0; _ -> 1 }
+ examples/Expr/DoNotation.hs view
@@ -0,0 +1,15 @@+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 view
@@ -0,0 +1,8 @@+{-# LANGUAGE EmptyCase #-}
+module Expr.EmptyCase where
+
+x = 12
+
+a = case x of 
+
+b = case x of {}
+ examples/Expr/EmptyLet.hs view
@@ -0,0 +1,6 @@+module Expr.EmptyLet where
+
+a = let in ()
+
+m = do let
+       putStrLn "hello"
+ examples/Expr/FunSection.hs view
@@ -0,0 +1,6 @@+module Expr.FunSection where
+
+data Rule = Rule {
+    rulePath :: String -> Bool }
+
+f r = filter (`rulePath` r)
+ examples/Expr/GeneralizedListComp.hs view
@@ -0,0 +1,31 @@+{-# 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 view
@@ -0,0 +1,4 @@+module Expr.If where
+
+b = 12
+a = if b > 3 then 1 else 0
+ examples/Expr/LambdaCase.hs view
@@ -0,0 +1,11 @@+{-# 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 view
@@ -0,0 +1,3 @@+module Expr.ListComp where
+
+ls = [ x+y | x <- [1..5], y <- [1..5]]
+ examples/Expr/MultiwayIf.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE MultiWayIf #-}
+module Expr.MultiwayIf where
+
+b = 12
+a = if | b > 3     -> 1
+       | b < -5    -> 2
+       | otherwise -> 3
+ examples/Expr/Negate.hs view
@@ -0,0 +1,4 @@+module Expr.Negate where
+
+y = 1
+x = -y
+ examples/Expr/Operator.hs view
@@ -0,0 +1,5 @@+module Expr.Operator where
+
+x = 1 + 2
+y = (+) 1 2
+z = 1 `mod` 2
+ examples/Expr/ParListComp.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE ParallelListComp #-}
+module Expr.ParListComp where
+
+ls = [ x+y | x <- [1..5] | y <- [1..5]]
+ examples/Expr/ParenName.hs view
@@ -0,0 +1,3 @@+module Expr.ParenName where
+
+a x y = (mod) x y
+ examples/Expr/PatternAndDo.hs view
@@ -0,0 +1,10 @@+{-# 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 view
@@ -0,0 +1,6 @@+{-# LANGUAGE NamedFieldPuns #-}
+module Expr.RecordPuns where
+
+data Point = Point { x :: Int, y :: Int }
+
+f (Point {y}) = y
+ examples/Expr/RecordWildcards.hs view
@@ -0,0 +1,6 @@+{-# 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 view
@@ -0,0 +1,9 @@+{-# 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 view
@@ -0,0 +1,4 @@+module Expr.SccPragma where
+
+f x = {-# SCC "drawComponent" #-}
+        case x of () -> ()
+ examples/Expr/Sections.hs view
@@ -0,0 +1,4 @@+module Expr.Sections where
+
+x = (1+)
+y = (+1)
+ examples/Expr/SemicolonDo.hs view
@@ -0,0 +1,7 @@+module Expr.SemicolonDo where
+
+import Control.Monad.Identity
+
+a = do { n <- Identity ()
+            ; return ()
+            }
+ examples/Expr/StaticPtr.hs view
@@ -0,0 +1,16 @@+{-# 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 view
@@ -0,0 +1,7 @@+{-# LANGUAGE TupleSections #-}
+module Expr.TupleSections where
+
+f1 = (1,,)
+f2 = (,1)
+
+x = (,("x", []))
+ examples/Expr/UnboxedSum.hs view
@@ -0,0 +1,13 @@+{-# 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 view
@@ -0,0 +1,7 @@+{-# 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 view
@@ -0,0 +1,149 @@+{-# 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 view
@@ -0,0 +1,69 @@+{-# 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 view
@@ -0,0 +1,23 @@+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 view
@@ -0,0 +1,88 @@+{-# 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 view
@@ -0,0 +1,1 @@+module Module.DeprecatedPragma {-# DEPRECATED "this module is deprecated" #-} where
+ examples/Module/Export.hs view
@@ -0,0 +1,2 @@+module Module.Export (maybe, Maybe(..), Either(Left)) where
+-- this module reexports Maybe from Prelude
+ examples/Module/ExportModifiers.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE ExplicitNamespaces, PatternSynonyms #-}
+module Module.ExportModifiers (type Maybe, pattern Maybe) where
+
+pattern Maybe = 42
+ examples/Module/ExportSubs.hs view
@@ -0,0 +1,3 @@+module Module.ExportSubs (T(Cons, name)) where
+
+data T = Cons { name :: String }
+ examples/Module/GhcOptionsPragma.hs view
@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+module Module.GhcOptionsPragma where
+ examples/Module/Import.hs view
@@ -0,0 +1,11 @@+{-# 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 view
@@ -0,0 +1,3 @@+module Module.ImportOp where
+
+import Module.Imported ((:-)(..))
+ examples/Module/Imported.hs view
@@ -0,0 +1,6 @@+{-# 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 view
@@ -0,0 +1,4 @@+{-# LANGUAGE LambdaCase #-}
+{-#LANGUAGE LambdaCase #-}
+{-# LANGUAGE LambdaCase#-}
+module Module.LangPragmas where
+ examples/Module/NamespaceExport.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE TypeOperators #-}
+module Module.NamespaceExport (type (++)) where
+
+data a ++ b = Ctor
+ examples/Module/PatternImport.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE PatternSynonyms #-}
+module Module.PatternImport where
+
+import Decl.PatternSynonym (pattern Arrow)
+ examples/Module/Simple.hs view
@@ -0,0 +1,1 @@+module Module.Simple where
+ examples/Module/WarningPragma.hs view
@@ -0,0 +1,1 @@+module Module.WarningPragma {-# WARNING "this module is dangerous" #-} where
+ examples/Pattern/Backtick.hs view
@@ -0,0 +1,5 @@+module Pattern.Backtick where
+
+data Point = Point { x :: Prelude.Int, y :: Int }
+
+f (x `Point` y) = 0
+ examples/Pattern/Constructor.hs view
@@ -0,0 +1,3 @@+module Pattern.Constructor where
+
+Just x = Just 1
+ examples/Pattern/ImplicitParams.hs view
@@ -0,0 +1,9 @@+{-# 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 view
@@ -0,0 +1,5 @@+module Pattern.Infix where
+
+--(a:b:c:d) = ["1","2","3","4"]
+
+Nothing:_ = undefined
+ examples/Pattern/NPlusK.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE NPlusKPatterns #-}
+module Pattern.NPlusK where
+
+factorial :: Integer -> Integer
+factorial 0 = 1
+factorial (n+1) = (*) (n+1) (factorial n)
+ examples/Pattern/NestedWildcard.hs view
@@ -0,0 +1,7 @@+{-# 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 view
@@ -0,0 +1,3 @@+module Pattern.OperatorPattern where
+
+child r (_:ps) = r ps
+ examples/Pattern/Record.hs view
@@ -0,0 +1,11 @@+{-# 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 view
@@ -0,0 +1,6 @@+{-# LANGUAGE UnboxedSums #-}
+module Pattern.UnboxedSum where
+
+f :: (# Int | Bool #) -> ()
+f (# i | #) = ()
+f (# | b #) = ()
+ examples/Refactor/CommentHandling/BlockComments.hs view
@@ -0,0 +1,10 @@+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 view
@@ -0,0 +1,10 @@+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 view
@@ -0,0 +1,6 @@+module Refactor.CommentHandling.Crosslinking where
+
+import Control.Monad
+-- | forward
+-- ^ back
+import Control.Monad as Monad
+ examples/Refactor/CommentHandling/FunctionArgs.hs view
@@ -0,0 +1,6 @@+module Refactor.CommentHandling.FunctionArgs where
+
+f :: Int -- something
+  -> {-| result -} Int
+  -> Int  -- ^ other thing
+f = undefined
+ examples/Refactor/ExtractBinding/AddToExisting.hs view
@@ -0,0 +1,4 @@+module Refactor.ExtractBinding.AddToExisting where
+
+x = a ++ []
+  where a = []
+ examples/Refactor/ExtractBinding/AddToExisting_res.hs view
@@ -0,0 +1,5 @@+module Refactor.ExtractBinding.AddToExisting where
+
+x = a ++ b
+  where a = []
+        b = []
+ examples/Refactor/ExtractBinding/AssocOp.hs view
@@ -0,0 +1,3 @@+module Refactor.ExtractBinding.AssocOp where
+
+a = 1 + 2 + 3
+ examples/Refactor/ExtractBinding/AssocOpMiddle.hs view
@@ -0,0 +1,3 @@+module Refactor.ExtractBinding.AssocOpMiddle where
+
+a = 1 * 2 * 3 * 4
+ examples/Refactor/ExtractBinding/AssocOpMiddle_res.hs view
@@ -0,0 +1,4 @@+module Refactor.ExtractBinding.AssocOpMiddle where
+
+a = 1 * b * 4
+  where b = 2 * 3
+ examples/Refactor/ExtractBinding/AssocOpRightAssoc.hs view
@@ -0,0 +1,3 @@+module Refactor.ExtractBinding.AssocOpRightAssoc where
+
+f = id . id . id
+ examples/Refactor/ExtractBinding/AssocOpRightAssoc_res.hs view
@@ -0,0 +1,4 @@+module Refactor.ExtractBinding.AssocOpRightAssoc where
+
+f = g . id
+  where g = id . id
+ examples/Refactor/ExtractBinding/AssocOp_res.hs view
@@ -0,0 +1,4 @@+module Refactor.ExtractBinding.AssocOp where
+
+a = 1 + b
+  where b = 2 + 3
+ examples/Refactor/ExtractBinding/Case.hs view
@@ -0,0 +1,3 @@+module Refactor.ExtractBinding.Case where
+
+f a = case a of (x,y) -> x + y
+ examples/Refactor/ExtractBinding/Case_res.hs view
@@ -0,0 +1,4 @@+module Refactor.ExtractBinding.Case where
+
+f a = case a of (x,y) -> g x y
+  where g x y = x + y
+ examples/Refactor/ExtractBinding/ClassInstance.hs view
@@ -0,0 +1,6 @@+module Refactor.ExtractBinding.ClassInstance where
+
+data Better a = Better a
+
+instance Functor Better where
+  fmap f (Better a) = Better (f a)
+ examples/Refactor/ExtractBinding/ClassInstance_res.hs view
@@ -0,0 +1,7 @@+module Refactor.ExtractBinding.ClassInstance where
+
+data Better a = Better a
+
+instance Functor Better where
+  fmap f (Better a) = Better g
+    where g = f a
+ examples/Refactor/ExtractBinding/ExistingLocalDef.hs view
@@ -0,0 +1,4 @@+module Refactor.ExtractBinding.ExistingLocalDef where
+
+f = 1 + 2 + 3
+  where
+ examples/Refactor/ExtractBinding/ExistingLocalDef_res.hs view
@@ -0,0 +1,4 @@+module Refactor.ExtractBinding.ExistingLocalDef where
+
+f = a + 3
+  where a = 1 + 2
+ examples/Refactor/ExtractBinding/ExtractedFormatting.hs view
@@ -0,0 +1,5 @@+module Refactor.ExtractBinding.ExtractedFormatting where
+
+stms 
+  = id
+  . id
+ examples/Refactor/ExtractBinding/ExtractedFormatting_res.hs view
@@ -0,0 +1,6 @@+module Refactor.ExtractBinding.ExtractedFormatting where
+
+stms 
+  = extracted
+  where extracted = id
+                  . id
+ examples/Refactor/ExtractBinding/Indentation.hs view
@@ -0,0 +1,5 @@+module Refactor.ExtractBinding.Indentation where
+
+f a = case Just a of 
+  Nothing -> 0
+  Just x -> x
+ examples/Refactor/ExtractBinding/IndentationMultiLine.hs view
@@ -0,0 +1,7 @@+module Refactor.ExtractBinding.IndentationMultiLine where
+
+f a = case Just a of 
+  Nothing 
+    -> 0
+  Just x 
+    -> x
+ examples/Refactor/ExtractBinding/IndentationMultiLine_res.hs view
@@ -0,0 +1,8 @@+module Refactor.ExtractBinding.IndentationMultiLine where
+
+f a = case extracted of 
+    Nothing 
+      -> 0
+    Just x 
+      -> x
+  where extracted = Just a
+ examples/Refactor/ExtractBinding/IndentationOperator.hs view
@@ -0,0 +1,5 @@+module Refactor.ExtractBinding.IndentationOperator where
+
+f aaa bbb = id . id $
+  aaa
+    ++ bbb
+ examples/Refactor/ExtractBinding/IndentationOperator_res.hs view
@@ -0,0 +1,6 @@+module Refactor.ExtractBinding.IndentationOperator where
+
+f aaa bbb = extracted $
+    aaa
+      ++ bbb
+  where extracted = id . id
+ examples/Refactor/ExtractBinding/Indentation_res.hs view
@@ -0,0 +1,6 @@+module Refactor.ExtractBinding.Indentation where
+
+f a = case extracted of 
+    Nothing -> 0
+    Just x -> x
+  where extracted = Just a
+ examples/Refactor/ExtractBinding/LeftSection.hs view
@@ -0,0 +1,3 @@+module Refactor.ExtractBinding.LeftSection where
+
+a = 1 + 2
+ examples/Refactor/ExtractBinding/LeftSection_res.hs view
@@ -0,0 +1,4 @@+module Refactor.ExtractBinding.LeftSection where
+
+a = f 2
+  where f = (1 +)
+ examples/Refactor/ExtractBinding/ListComprehension.hs view
@@ -0,0 +1,5 @@+module Refactor.ExtractBinding.ListComprehension where
+
+filterPrime (p:xs) = 
+  p : filterPrime [ x | x <- xs
+                      , x `mod` p /= 0 ]
+ examples/Refactor/ExtractBinding/ListComprehension_res.hs view
@@ -0,0 +1,6 @@+module Refactor.ExtractBinding.ListComprehension where
+
+filterPrime (p:xs) = 
+    p : filterPrime [ x | x <- xs
+                        , notDivisible x ]
+  where notDivisible x = x `mod` p /= 0
+ examples/Refactor/ExtractBinding/LocalDefinition.hs view
@@ -0,0 +1,4 @@+module Refactor.ExtractBinding.LocalDefinition where
+
+stms = x
+  where x = "s"
+ examples/Refactor/ExtractBinding/LocalDefinition_res.hs view
@@ -0,0 +1,5 @@+module Refactor.ExtractBinding.LocalDefinition where
+
+stms = x
+  where x = y
+          where y = "s"
+ examples/Refactor/ExtractBinding/NameConflict.hs view
@@ -0,0 +1,4 @@+module Refactor.ExtractBinding.NameConflict where
+
+stms = map (\s -> s ++ bang) ["a", "b"]
+  where bang = "!"
+ examples/Refactor/ExtractBinding/Parentheses.hs view
@@ -0,0 +1,6 @@+module Refactor.ExtractBinding.Parentheses where
+
+distance p1 p2 = sqrt ((x p1 - x p2) ^ 2 + (y p1 - y p2) ^ 2)
+
+-- try to rename the type, the constructor or the fields
+data Point = Point { x :: Double, y :: Double }
+ examples/Refactor/ExtractBinding/Parentheses_res.hs view
@@ -0,0 +1,7 @@+module Refactor.ExtractBinding.Parentheses where
+
+distance p1 p2 = sqrt sqDistance
+  where sqDistance = (x p1 - x p2) ^ 2 + (y p1 - y p2) ^ 2
+
+-- try to rename the type, the constructor or the fields
+data Point = Point { x :: Double, y :: Double }
+ examples/Refactor/ExtractBinding/RecordWildcards.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE RecordWildCards #-}
+module Refactor.ExtractBinding.RecordWildcards where
+
+data Point = Point { x :: Double, y :: Double }
+
+d = (\(Point {..}) -> x + y) (Point 1 2)
+ examples/Refactor/ExtractBinding/RecordWildcards_res.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE RecordWildCards #-}
+module Refactor.ExtractBinding.RecordWildcards where
+
+data Point = Point { x :: Double, y :: Double }
+
+d = plus (Point 1 2)
+  where plus (Point {..}) = x + y
+ examples/Refactor/ExtractBinding/Records.hs view
@@ -0,0 +1,5 @@+module Refactor.ExtractBinding.Records where
+
+data Point = Point { x :: Double, y :: Double }
+
+d = (\(Point {x = x, y = y}) -> x + y) (Point 1 2)
+ examples/Refactor/ExtractBinding/Records_res.hs view
@@ -0,0 +1,6 @@+module Refactor.ExtractBinding.Records where
+
+data Point = Point { x :: Double, y :: Double }
+
+d = plus (Point 1 2)
+  where plus (Point {x = x, y = y}) = x + y
+ examples/Refactor/ExtractBinding/RightSection.hs view
@@ -0,0 +1,3 @@+module Refactor.ExtractBinding.RightSection where
+
+a = 1 + 2
+ examples/Refactor/ExtractBinding/RightSection_res.hs view
@@ -0,0 +1,4 @@+module Refactor.ExtractBinding.RightSection where
+
+a = f 1
+  where f = (+ 2)
+ examples/Refactor/ExtractBinding/SectionInfix.hs view
@@ -0,0 +1,3 @@+module Refactor.ExtractBinding.SectionInfix where
+
+a = 1 + 2 + 3
+ examples/Refactor/ExtractBinding/SectionInfix_res.hs view
@@ -0,0 +1,4 @@+module Refactor.ExtractBinding.SectionInfix where
+
+a = f 3
+  where f = ((1 + 2) +)
+ examples/Refactor/ExtractBinding/SectionWithLocals.hs view
@@ -0,0 +1,6 @@+module Refactor.ExtractBinding.SectionWithLocals where
+
+a x = let y = 2
+          z = 3
+          (<->) = (-)
+       in x <-> (y + z)
+ examples/Refactor/ExtractBinding/SectionWithLocals_res.hs view
@@ -0,0 +1,7 @@+module Refactor.ExtractBinding.SectionWithLocals where
+
+a x = let y = 2
+          z = 3
+          (<->) = (-)
+       in f y z (<->) x
+  where f y z (<->) = (<-> (y + z))
+ examples/Refactor/ExtractBinding/SiblingDefs.hs view
@@ -0,0 +1,7 @@+module Refactor.ExtractBinding.SiblingDefs where
+
+f = 1
+  where
+    g = a
+      where a = 1
+    h = 2
+ examples/Refactor/ExtractBinding/SiblingDefs_res.hs view
@@ -0,0 +1,8 @@+module Refactor.ExtractBinding.SiblingDefs where
+
+f = 1
+  where
+    g = a
+      where a = 1
+    h = a
+      where a = 2
+ examples/Refactor/ExtractBinding/Simple.hs view
@@ -0,0 +1,3 @@+module Refactor.ExtractBinding.Simple where
+
+stms = map (\s -> s ++ "!") ["a", "b"]
+ examples/Refactor/ExtractBinding/Simple_res.hs view
@@ -0,0 +1,4 @@+module Refactor.ExtractBinding.Simple where
+
+stms = map (\s -> exaggerate s) ["a", "b"]
+  where exaggerate s = s ++ "!"
+ examples/Refactor/ExtractBinding/TooSimple.hs view
@@ -0,0 +1,3 @@+module Refactor.ExtractBinding.TooSimple where
+
+stms = map (\s -> s ++ "!") ["a", "b"]
+ examples/Refactor/ExtractBinding/ViewPattern.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE ViewPatterns #-}
+module Refactor.ExtractBinding.ViewPattern where
+
+f (id . id -> x) = x
+ examples/Refactor/FloatOut/FloatLocals.hs view
@@ -0,0 +1,5 @@+module Refactor.FloatOut.FloatLocals where
+
+f = g
+  where g = h
+          where h = id
+ examples/Refactor/FloatOut/FloatLocals_res.hs view
@@ -0,0 +1,5 @@+module Refactor.FloatOut.FloatLocals where
+
+f = g
+  where g = h
+        h = id
+ examples/Refactor/FloatOut/ImplicitLocal.hs view
@@ -0,0 +1,5 @@+module Refactor.FloatOut.ImplicitLocal where
+
+f = g
+  where g = h
+        h = ()
+ examples/Refactor/FloatOut/ImplicitParam.hs view
@@ -0,0 +1,4 @@+module Refactor.FloatOut.ImplicitParam where
+
+f a = g
+  where g = a
+ examples/Refactor/FloatOut/MoveFixity.hs view
@@ -0,0 +1,5 @@+module Refactor.FloatOut.MoveFixity where
+
+f = 3 <+> 4
+  where infixl 6 <+>
+        a <+> b = a + b
+ examples/Refactor/FloatOut/MoveFixity_res.hs view
@@ -0,0 +1,5 @@+module Refactor.FloatOut.MoveFixity where
+
+f = 3 <+> 4
+infixl 6 <+>
+a <+> b = a + b
+ examples/Refactor/FloatOut/MoveSignature.hs view
@@ -0,0 +1,5 @@+module Refactor.FloatOut.MoveSignature where
+
+f = g
+  where g :: a -> a
+        g = id
+ examples/Refactor/FloatOut/MoveSignature_res.hs view
@@ -0,0 +1,5 @@+module Refactor.FloatOut.MoveSignature where
+
+f = g
+g :: a -> a
+g = id
+ examples/Refactor/FloatOut/NameCollosion.hs view
@@ -0,0 +1,6 @@+module Refactor.FloatOut.NameCollosion where
+
+f = g
+  where g = id
+
+g = ()
+ examples/Refactor/FloatOut/NameCollosionWithImport.hs view
@@ -0,0 +1,4 @@+module Refactor.FloatOut.NameCollosionWithImport where
+
+f = id
+  where id = ()
+ examples/Refactor/FloatOut/NameCollosionWithLocal.hs view
@@ -0,0 +1,6 @@+module Refactor.FloatOut.NameCollosionWithLocal where
+
+f = g
+  where g = h
+          where h = id
+        h = ()
+ examples/Refactor/FloatOut/NoCollosion.hs view
@@ -0,0 +1,7 @@+module Refactor.FloatOut.NoCollosion where
+
+f = g
+  where g = h
+          where h = id
+
+h = ()
+ examples/Refactor/FloatOut/NoCollosion_res.hs view
@@ -0,0 +1,7 @@+module Refactor.FloatOut.NoCollosion where
+
+f = g
+  where g = h
+        h = id
+
+h = ()
+ examples/Refactor/FloatOut/SharedSignature.hs view
@@ -0,0 +1,6 @@+module Refactor.FloatOut.SharedSignature where
+
+f = g
+  where g, h :: a -> a
+        g = id
+        h = id
+ examples/Refactor/FloatOut/ToTopLevel.hs view
@@ -0,0 +1,4 @@+module Refactor.FloatOut.ToTopLevel where
+
+f = g
+  where g = id
+ examples/Refactor/FloatOut/ToTopLevel_res.hs view
@@ -0,0 +1,4 @@+module Refactor.FloatOut.ToTopLevel where
+
+f = g
+g = id
+ examples/Refactor/GenerateExports/Normal.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE TypeFamilies #-}
+module Refactor.GenerateExports.Normal where
+
+function :: Int -> Int
+function a = a
+
+data TypeCtor = DataCtor { recordName :: Int }
+
+class TypeClass a where
+  classFunction :: a -> a
+
+type family TypeFamily a :: *
+
+data family DataFamily a :: *
+
+foreign import ccall "exp" c_exp :: Double -> Double 
+
+ examples/Refactor/GenerateExports/Normal_res.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE TypeFamilies #-}
+module Refactor.GenerateExports.Normal (function, TypeCtor(..), TypeClass(..), TypeFamily, DataFamily, c_exp) where
+
+function :: Int -> Int
+function a = a
+
+data TypeCtor = DataCtor { recordName :: Int }
+
+class TypeClass a where
+  classFunction :: a -> a
+
+type family TypeFamily a :: *
+
+data family DataFamily a :: *
+
+foreign import ccall "exp" c_exp :: Double -> Double 
+
+ examples/Refactor/GenerateExports/Operators.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE TypeOperators #-}
+module Refactor.GenerateExports.Operators where
+
+(|=>|) :: Int -> Int -> Int
+a |=>| b = a + b
+
+data a :+: b = a :+: b
+ examples/Refactor/GenerateExports/Operators_res.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE TypeOperators #-}
+module Refactor.GenerateExports.Operators ((|=>|), (:+:)(..)) where
+
+(|=>|) :: Int -> Int -> Int
+a |=>| b = a + b
+
+data a :+: b = a :+: b
+ examples/Refactor/GenerateTypeSignature/BringToScope/A.hs view
@@ -0,0 +1,4 @@+module Refactor.GenerateTypeSignature.BringToScope.A where
+
+data T = T
+data S = S
+ examples/Refactor/GenerateTypeSignature/BringToScope/AlreadyQualImport.hs view
@@ -0,0 +1,6 @@+module Refactor.GenerateTypeSignature.BringToScope.AlreadyQualImport where
+
+import Refactor.GenerateTypeSignature.BringToScope.B
+import qualified Refactor.GenerateTypeSignature.BringToScope.A as AAA (S)
+
+g = f
+ examples/Refactor/GenerateTypeSignature/BringToScope/AlreadyQualImport_res.hs view
@@ -0,0 +1,8 @@+module Refactor.GenerateTypeSignature.BringToScope.AlreadyQualImport where
+
+import Refactor.GenerateTypeSignature.BringToScope.B
+import qualified Refactor.GenerateTypeSignature.BringToScope.A as AAA (S)
+import qualified Refactor.GenerateTypeSignature.BringToScope.A(T)
+
+g :: Refactor.GenerateTypeSignature.BringToScope.A.T -> AAA.S
+g = f
+ examples/Refactor/GenerateTypeSignature/BringToScope/B.hs view
@@ -0,0 +1,6 @@+module Refactor.GenerateTypeSignature.BringToScope.B where 
+
+import Refactor.GenerateTypeSignature.BringToScope.A
+
+f :: T -> S
+f = const S
+ examples/Refactor/GenerateTypeSignature/CanCaptureVariable.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE ScopedTypeVariables #-}
+module Refactor.GenerateTypeSignature.CanCaptureVariable where
+
+import qualified Data.Map as Map
+
+insertMany :: forall k v . (Ord k) => (v -> v -> v) -> [(k,v)] -> Map.Map k v -> Map.Map k v
+insertMany accf vs m = foldr f1 m vs
+  where f1 (k,v) m = Map.insertWith accf k v m
+ examples/Refactor/GenerateTypeSignature/CanCaptureVariableHasOtherDef.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE ScopedTypeVariables #-}
+module Refactor.GenerateTypeSignature.CanCaptureVariableHasOtherDef where
+
+import qualified Data.Map as Map
+
+insertMany :: forall k v . (Ord k) => (v -> v -> v) -> [(k,v)] -> Map.Map k v -> Map.Map k v
+insertMany accf vs m = foldr f1 m vs
+  where f1 (k,v) m = Map.insertWith accf k v m
+
+someOtherFun :: (k,v) -> (k,v)
+someOtherFun = id
+ examples/Refactor/GenerateTypeSignature/CanCaptureVariableHasOtherDef_res.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE ScopedTypeVariables #-}
+module Refactor.GenerateTypeSignature.CanCaptureVariableHasOtherDef where
+
+import qualified Data.Map as Map
+
+insertMany :: forall k v . (Ord k) => (v -> v -> v) -> [(k,v)] -> Map.Map k v -> Map.Map k v
+insertMany accf vs m = foldr f1 m vs
+  where f1 :: Ord k => (k, v) -> Map.Map k v -> Map.Map k v
+        f1 (k,v) m = Map.insertWith accf k v m
+
+someOtherFun :: (k,v) -> (k,v)
+someOtherFun = id
+ examples/Refactor/GenerateTypeSignature/CanCaptureVariable_res.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE ScopedTypeVariables #-}
+module Refactor.GenerateTypeSignature.CanCaptureVariable where
+
+import qualified Data.Map as Map
+
+insertMany :: forall k v . (Ord k) => (v -> v -> v) -> [(k,v)] -> Map.Map k v -> Map.Map k v
+insertMany accf vs m = foldr f1 m vs
+  where f1 :: Ord k => (k, v) -> Map.Map k v -> Map.Map k v
+        f1 (k,v) m = Map.insertWith accf k v m
+ examples/Refactor/GenerateTypeSignature/CannotCaptureVariable.hs view
@@ -0,0 +1,7 @@+module Refactor.GenerateTypeSignature.CannotCaptureVariable where
+
+import qualified Data.Map as Map
+
+insertMany :: (Ord k) => (v -> v -> v) -> [(k,v)] -> Map.Map k v -> Map.Map k v
+insertMany accf vs m = foldr f1 m vs
+  where f1 (k,v) m = Map.insertWith accf k v m
+ examples/Refactor/GenerateTypeSignature/CannotCaptureVariableNoExt.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE RankNTypes #-}
+module Refactor.GenerateTypeSignature.CannotCaptureVariableNoExt where
+
+import qualified Data.Map as Map
+
+insertMany :: forall k v . (Ord k) => (v -> v -> v) -> [(k,v)] -> Map.Map k v -> Map.Map k v
+insertMany accf vs m = foldr f1 m vs
+  where f1 (k,v) m = Map.insertWith accf k v m
+ examples/Refactor/GenerateTypeSignature/Complex.hs view
@@ -0,0 +1,3 @@+module Refactor.GenerateTypeSignature.Complex where
+
+app f x = f (Just x)
+ examples/Refactor/GenerateTypeSignature/ComplexLhs.hs view
@@ -0,0 +1,6 @@+module Refactor.GenerateTypeSignature.ComplexLhs where
+
+(x) = 3
+Just y = Just 4
+(a,b) = (1,2)
+[c,d,e] = [1,2,3]
+ examples/Refactor/GenerateTypeSignature/Complex_res.hs view
@@ -0,0 +1,4 @@+module Refactor.GenerateTypeSignature.Complex where
+
+app :: (Maybe a -> t) -> a -> t
+app f x = f (Just x)
+ examples/Refactor/GenerateTypeSignature/Function.hs view
@@ -0,0 +1,3 @@+module Refactor.GenerateTypeSignature.Function where
+
+identity x = x
+ examples/Refactor/GenerateTypeSignature/Function_res.hs view
@@ -0,0 +1,4 @@+module Refactor.GenerateTypeSignature.Function where
+
+identity :: p -> p
+identity x = x
+ examples/Refactor/GenerateTypeSignature/HigherOrder.hs view
@@ -0,0 +1,3 @@+module Refactor.GenerateTypeSignature.HigherOrder where
+
+app f x = f x
+ examples/Refactor/GenerateTypeSignature/HigherOrder_res.hs view
@@ -0,0 +1,4 @@+module Refactor.GenerateTypeSignature.HigherOrder where
+
+app :: (t1 -> t2) -> t1 -> t2
+app f x = f x
+ examples/Refactor/GenerateTypeSignature/Let.hs view
@@ -0,0 +1,4 @@+module Refactor.GenerateTypeSignature.Let where
+
+x = let unit = ()
+     in ()
+ examples/Refactor/GenerateTypeSignature/Let_res.hs view
@@ -0,0 +1,5 @@+module Refactor.GenerateTypeSignature.Let where
+
+x = let unit :: ()
+        unit = ()
+     in ()
+ examples/Refactor/GenerateTypeSignature/Local.hs view
@@ -0,0 +1,4 @@+module Refactor.GenerateTypeSignature.Local where
+
+x = () where
+  unit = ()
+ examples/Refactor/GenerateTypeSignature/Local_res.hs view
@@ -0,0 +1,5 @@+module Refactor.GenerateTypeSignature.Local where
+
+x = () where
+  unit :: ()
+  unit = ()
+ examples/Refactor/GenerateTypeSignature/Placement.hs view
@@ -0,0 +1,5 @@+module Refactor.GenerateTypeSignature.Placement where
+
+otherThing = ()
+unit = ()
+anotherThing = ()
+ examples/Refactor/GenerateTypeSignature/Placement_res.hs view
@@ -0,0 +1,6 @@+module Refactor.GenerateTypeSignature.Placement where
+
+otherThing = ()
+unit :: ()
+unit = ()
+anotherThing = ()
+ examples/Refactor/GenerateTypeSignature/Polymorph.hs view
@@ -0,0 +1,6 @@+module Refactor.GenerateTypeSignature.Polymorph where
+
+three = 3
+
+four :: Int
+four = three + 1
+ examples/Refactor/GenerateTypeSignature/PolymorphSub.hs view
@@ -0,0 +1,5 @@+module Refactor.GenerateTypeSignature.PolymorphSub where
+
+f :: Num a => a -> a
+f a = g a where
+  g a = a + 1
+ examples/Refactor/GenerateTypeSignature/PolymorphSubMulti.hs view
@@ -0,0 +1,5 @@+module Refactor.GenerateTypeSignature.PolymorphSubMulti where
+
+f :: (Num a, Ord a) => a -> a
+f a = g a where
+  g a = if a > 0 then a + 1 else a
+ examples/Refactor/GenerateTypeSignature/PolymorphSubMulti_res.hs view
@@ -0,0 +1,6 @@+module Refactor.GenerateTypeSignature.PolymorphSubMulti where
+
+f :: (Num a, Ord a) => a -> a
+f a = g a where
+  g :: (Num p, Ord p) => p -> p
+  g a = if a > 0 then a + 1 else a
+ examples/Refactor/GenerateTypeSignature/PolymorphSub_res.hs view
@@ -0,0 +1,6 @@+module Refactor.GenerateTypeSignature.PolymorphSub where
+
+f :: Num a => a -> a
+f a = g a where
+  g :: Num a => a -> a
+  g a = a + 1
+ examples/Refactor/GenerateTypeSignature/Polymorph_res.hs view
@@ -0,0 +1,7 @@+module Refactor.GenerateTypeSignature.Polymorph where
+
+three :: Int
+three = 3
+
+four :: Int
+four = three + 1
+ examples/Refactor/GenerateTypeSignature/Simple.hs view
@@ -0,0 +1,3 @@+module Refactor.GenerateTypeSignature.Simple where
+
+unit = ()
+ examples/Refactor/GenerateTypeSignature/Simple_res.hs view
@@ -0,0 +1,4 @@+module Refactor.GenerateTypeSignature.Simple where
+
+unit :: ()
+unit = ()
+ examples/Refactor/GenerateTypeSignature/Tuple.hs view
@@ -0,0 +1,3 @@+module Refactor.GenerateTypeSignature.Tuple where
+
+tuple x y = (x,y)
+ examples/Refactor/GenerateTypeSignature/Tuple_res.hs view
@@ -0,0 +1,4 @@+module Refactor.GenerateTypeSignature.Tuple where
+
+tuple :: a -> b -> (a, b)
+tuple x y = (x,y)
+ examples/Refactor/GenerateTypeSignature/TypeDefinedInModule.hs view
@@ -0,0 +1,6 @@+module Refactor.GenerateTypeSignature.TypeDefinedInModule where
+
+distance p1 p2 = sqrt ((x p1 - x p2) ^ 2 + (y p1 - y p2) ^ 2)
+
+data Point = Point { x :: Double, y :: Double }
+
+ examples/Refactor/GenerateTypeSignature/TypeDefinedInModule_res.hs view
@@ -0,0 +1,7 @@+module Refactor.GenerateTypeSignature.TypeDefinedInModule where
+
+distance :: Point -> Point -> Double
+distance p1 p2 = sqrt ((x p1 - x p2) ^ 2 + (y p1 - y p2) ^ 2)
+
+data Point = Point { x :: Double, y :: Double }
+
+ examples/Refactor/InlineBinding/AlreadyApplied.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.AlreadyApplied where
+
+b u v = a u v
+a x y = x ++ y
+ examples/Refactor/InlineBinding/AlreadyApplied_res.hs view
@@ -0,0 +1,3 @@+module Refactor.InlineBinding.AlreadyApplied where
+
+b u v = (u ++ v)
+ examples/Refactor/InlineBinding/AppearsInAnother/A.hs view
@@ -0,0 +1,3 @@+module A where
+
+a = ()
+ examples/Refactor/InlineBinding/AppearsInAnother/B.hs view
@@ -0,0 +1,5 @@+module B where
+
+import A
+
+b = a
+ examples/Refactor/InlineBinding/AutoNaming.hs view
@@ -0,0 +1,5 @@+module Refactor.InlineBinding.Simplest where
+
+b = a
+a x = x
+x1 = ()
+ examples/Refactor/InlineBinding/AutoNaming_res.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.Simplest where
+
+b = (\x2 -> x2)
+x1 = ()
+ examples/Refactor/InlineBinding/FilterSignatures.hs view
@@ -0,0 +1,7 @@+module Refactor.InlineBinding.FilterSignatures where
+
+b u v = u <++> v
+(<++>), (<**>) :: String -> String -> String
+x <++> y = x ++ y
+x <**> y = y ++ x
+infixl 7 <++>, <**>
+ examples/Refactor/InlineBinding/FilterSignatures_res.hs view
@@ -0,0 +1,6 @@+module Refactor.InlineBinding.FilterSignatures where
+
+b u v = (u ++ v)
+(<**>) :: String -> String -> String
+x <**> y = y ++ x
+infixl 7 <**>
+ examples/Refactor/InlineBinding/InExportList.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.InExportList (a) where
+
+b = a
+a = ()
+ examples/Refactor/InlineBinding/LetBind.hs view
@@ -0,0 +1,3 @@+module Refactor.InlineBinding.LetBind where
+
+a = let x = () in x
+ examples/Refactor/InlineBinding/LetBind_res.hs view
@@ -0,0 +1,3 @@+module Refactor.InlineBinding.LetBind where
+
+a = ()
+ examples/Refactor/InlineBinding/LetGuard.hs view
@@ -0,0 +1,5 @@+module Refactor.InlineBinding.LetGuard where
+
+a | let x = 3
+  , x == 3
+  = ()
+ examples/Refactor/InlineBinding/LetGuard_res.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.LetGuard where
+
+a | 3 == 3
+  = ()
+ examples/Refactor/InlineBinding/LetStmt.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.LetStmt where
+
+a = do let x = () 
+       putStrLn (show x)
+ examples/Refactor/InlineBinding/LetStmt_res.hs view
@@ -0,0 +1,3 @@+module Refactor.InlineBinding.LetStmt where
+
+a = do putStrLn (show ())
+ examples/Refactor/InlineBinding/Local.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.Local where
+
+b = a
+  where a = ()
+ examples/Refactor/InlineBinding/LocalNested.hs view
@@ -0,0 +1,5 @@+module Refactor.InlineBinding.LocalNested where
+
+a = b
+  where b = c
+          where c = ()
+ examples/Refactor/InlineBinding/LocalNested_res.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.LocalNested where
+
+a = b
+  where b = ()
+ examples/Refactor/InlineBinding/Local_res.hs view
@@ -0,0 +1,3 @@+module Refactor.InlineBinding.Local where
+
+b = ()
+ examples/Refactor/InlineBinding/MultiApplied.hs view
@@ -0,0 +1,6 @@+module Refactor.InlineBinding.MultiApplied where
+
+b u v = a u v
+a x "a" = x
+a "a" y = y
+a x y = x ++ y
+ examples/Refactor/InlineBinding/MultiApplied_res.hs view
@@ -0,0 +1,5 @@+module Refactor.InlineBinding.MultiApplied where
+
+b u v = (case (u, v) of (x, "a") -> x
+                        ("a", y) -> y
+                        (x, y) -> x ++ y)
+ examples/Refactor/InlineBinding/MultiMatch.hs view
@@ -0,0 +1,6 @@+module Refactor.InlineBinding.MultiMatch where
+
+b = a
+a x "a" = x
+a "a" y = y
+a x y = x ++ y
+ examples/Refactor/InlineBinding/MultiMatchGuarded.hs view
@@ -0,0 +1,6 @@+module Refactor.InlineBinding.MultiMatchGuarded where
+
+b u v = a u v
+a x y | x == y
+      = x
+a x y = x ++ y
+ examples/Refactor/InlineBinding/MultiMatchGuarded_res.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.MultiMatchGuarded where
+
+b u v = (case (u, v) of (x, y) | x == y -> x
+                        (x, y) -> x ++ y)
+ examples/Refactor/InlineBinding/MultiMatch_res.hs view
@@ -0,0 +1,5 @@+module Refactor.InlineBinding.MultiMatch where
+
+b = (\x1 x2 -> case (x1, x2) of (x, "a") -> x
+                                ("a", y) -> y
+                                (x, y) -> x ++ y)
+ examples/Refactor/InlineBinding/Nested.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.Nested where
+
+b = f (f ())
+f a = a
+ examples/Refactor/InlineBinding/Nested_res.hs view
@@ -0,0 +1,3 @@+module Refactor.InlineBinding.Nested where
+
+b = (())
+ examples/Refactor/InlineBinding/NotOccurring.hs view
@@ -0,0 +1,3 @@+module Refactor.InlineBinding.NotOccurring where
+
+a = ()
+ examples/Refactor/InlineBinding/Operator.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.Operator where
+
+b u v = u <++> v
+x <++> y = x ++ y
+ examples/Refactor/InlineBinding/Operator_res.hs view
@@ -0,0 +1,3 @@+module Refactor.InlineBinding.Operator where
+
+b u v = (u ++ v)
+ examples/Refactor/InlineBinding/PatternMatched.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.PatternMatched where
+
+b u v = a (Just u) v
+a (Just x) (Just y) = x ++ y
+ examples/Refactor/InlineBinding/PatternMatched_res.hs view
@@ -0,0 +1,3 @@+module Refactor.InlineBinding.PatternMatched where
+
+b u v = ((\(Just y) -> u ++ y) v)
+ examples/Refactor/InlineBinding/Recursive.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.Recursive where
+
+b = f ()
+f a = f a
+ examples/Refactor/InlineBinding/RemoveSignatures.hs view
@@ -0,0 +1,6 @@+module Refactor.InlineBinding.RemoveSignatures where
+
+b u v = u <++> v
+(<++>) :: String -> String -> String
+x <++> y = x ++ y
+infixl 7 <++>
+ examples/Refactor/InlineBinding/RemoveSignatures_res.hs view
@@ -0,0 +1,3 @@+module Refactor.InlineBinding.RemoveSignatures where
+
+b u v = (u ++ v)
+ examples/Refactor/InlineBinding/SimpleMultiMatch.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.SimpleMultiMatch where
+
+b = a
+a x y = x ++ y
+ examples/Refactor/InlineBinding/SimpleMultiMatch_res.hs view
@@ -0,0 +1,3 @@+module Refactor.InlineBinding.SimpleMultiMatch where
+
+b = (\x y -> x ++ y)
+ examples/Refactor/InlineBinding/Simplest.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.Simplest where
+
+b = a
+a = ()
+ examples/Refactor/InlineBinding/Simplest_res.hs view
@@ -0,0 +1,3 @@+module Refactor.InlineBinding.Simplest where
+
+b = ()
+ examples/Refactor/InlineBinding/WithLocals.hs view
@@ -0,0 +1,6 @@+module Refactor.InlineBinding.WithLocals where
+
+b = a
+a = x y
+  where x = id
+        y = ()
+ examples/Refactor/InlineBinding/WithLocals_res.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.WithLocals where
+
+b = (let x = id
+         y = () in x y)
+ examples/Refactor/OrganizeImports/Class.hs view
@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.Class where
+
+import Decl.TypeClass (C(f))
+import Decl.TypeInstance
+
+test = f A
+ examples/Refactor/OrganizeImports/Class_res.hs view
@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.Class where
+
+import Decl.TypeClass (C(f))
+import Decl.TypeInstance (A(..))
+
+test = f A
+ examples/Refactor/OrganizeImports/Coerce.hs view
@@ -0,0 +1,11 @@+module Refactor.OrganizeImports.Coerce where
+
+import Prelude ()
+import Data.Maybe (Maybe(Just, Nothing))
+import Data.List
+import Data.Coerce (coerce)
+
+newtype Mayb' a = Mayb' (Maybe a)
+
+a :: Mayb' a -> Maybe a
+a = coerce
+ examples/Refactor/OrganizeImports/Coerce_res.hs view
@@ -0,0 +1,11 @@+module Refactor.OrganizeImports.Coerce where
+
+import Data.Coerce (coerce)
+import Data.List
+import Data.Maybe (Maybe(Just, Nothing))
+import Prelude ()
+
+newtype Mayb' a = Mayb' (Maybe a)
+
+a :: Mayb' a -> Maybe a
+a = coerce
+ examples/Refactor/OrganizeImports/Ctor.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.Ctor where
+
+import Data.Maybe (Maybe(Nothing, Just))
+
+test = Just 3
+ examples/Refactor/OrganizeImports/Ctor_res.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.Ctor where
+
+import Data.Maybe (Maybe(Just))
+
+test = Just 3
+ examples/Refactor/OrganizeImports/Fields.hs view
@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.Fields where
+
+import Control.Monad.Trans (MonadTrans(..))
+import Control.Monad.State (Monad(..), StateT(runStateT))
+
+x = runStateT (lift putStrLn >> return ()) ()
+ examples/Refactor/OrganizeImports/Fields_res.hs view
@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.Fields where
+
+import Control.Monad.State (Monad(..), StateT(runStateT))
+import Control.Monad.Trans (MonadTrans(..))
+
+x = runStateT (lift putStrLn >> return ()) ()
+ examples/Refactor/OrganizeImports/InstanceCarry/DataType.hs view
@@ -0,0 +1,3 @@+module Refactor.OrganizeImports.InstanceCarry.DataType where
+
+data A = A
+ examples/Refactor/OrganizeImports/InstanceCarry/ImportNonOrphan.hs view
@@ -0,0 +1,3 @@+module Refactor.OrganizeImports.InstanceCarry.ImportNonOrphan where
+
+import Refactor.OrganizeImports.InstanceCarry.TCWithInst ()
+ examples/Refactor/OrganizeImports/InstanceCarry/ImportNonOrphan_res.hs view
@@ -0,0 +1,2 @@+module Refactor.OrganizeImports.InstanceCarry.ImportNonOrphan where
+
+ examples/Refactor/OrganizeImports/InstanceCarry/ImportOrphan.hs view
@@ -0,0 +1,3 @@+module Refactor.OrganizeImports.InstanceCarry.ImportOrphan where
+
+import Refactor.OrganizeImports.InstanceCarry.OrphanInstance ()
+ examples/Refactor/OrganizeImports/InstanceCarry/ImportOrphan_res.hs view
@@ -0,0 +1,3 @@+module Refactor.OrganizeImports.InstanceCarry.ImportOrphan where
+
+import Refactor.OrganizeImports.InstanceCarry.OrphanInstance ()
+ examples/Refactor/OrganizeImports/InstanceCarry/OrphanInstance.hs view
@@ -0,0 +1,7 @@+module Refactor.OrganizeImports.InstanceCarry.OrphanInstance where
+
+import Refactor.OrganizeImports.InstanceCarry.DataType
+import Refactor.OrganizeImports.InstanceCarry.TypeClass
+
+instance C A where
+  f = id
+ examples/Refactor/OrganizeImports/InstanceCarry/TCWithInst.hs view
@@ -0,0 +1,9 @@+module Refactor.OrganizeImports.InstanceCarry.TCWithInst where
+
+import Refactor.OrganizeImports.InstanceCarry.DataType
+
+class D t where
+  g :: t -> t
+
+instance D A where
+  g = id
+ examples/Refactor/OrganizeImports/InstanceCarry/TypeClass.hs view
@@ -0,0 +1,4 @@+module Refactor.OrganizeImports.InstanceCarry.TypeClass where
+
+class C t where
+  f :: t -> t
+ examples/Refactor/OrganizeImports/KeepCtorOfMarshalled.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.KeepCtorOfMarshalled where
+
+import Foreign.C.String
+
+foreign import ccall unsafe "abc" abc :: CString -> IO ()
+ examples/Refactor/OrganizeImports/KeepCtorOfMarshalled_res.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.KeepCtorOfMarshalled where
+
+import Foreign.C.String (CString(..))
+
+foreign import ccall unsafe "abc" abc :: CString -> IO ()
+ examples/Refactor/OrganizeImports/KeepExplicit.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.KeepExplicit where
+
+import Data.Functor.Identity (Identity (runIdentity))
+
+x = runIdentity
+ examples/Refactor/OrganizeImports/KeepExplicit_res.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.KeepExplicit where
+
+import Data.Functor.Identity (Identity (runIdentity))
+
+x = runIdentity
+ examples/Refactor/OrganizeImports/KeepHiding.hs view
@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.KeepHiding where
+
+import Data.Map hiding (map)
+
+m :: Map Int String
+m = empty
+ examples/Refactor/OrganizeImports/KeepHiding_res.hs view
@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.KeepHiding where
+
+import Data.Map hiding (map)
+
+m :: Map Int String
+m = empty
+ examples/Refactor/OrganizeImports/KeepPrelude.hs view
@@ -0,0 +1,3 @@+module Refactor.OrganizeImports.KeepPrelude where
+
+import Prelude ()
+ examples/Refactor/OrganizeImports/KeepPrelude_res.hs view
@@ -0,0 +1,3 @@+module Refactor.OrganizeImports.KeepPrelude where
+
+import Prelude ()
+ examples/Refactor/OrganizeImports/KeepReexported.hs view
@@ -0,0 +1,3 @@+module Refactor.OrganizeImports.KeepReexported (module Control.Monad) where
+
+import Control.Monad
+ examples/Refactor/OrganizeImports/KeepReexported_res.hs view
@@ -0,0 +1,3 @@+module Refactor.OrganizeImports.KeepReexported (module Control.Monad) where
+
+import Control.Monad
+ examples/Refactor/OrganizeImports/KeepRenamedReexported.hs view
@@ -0,0 +1,4 @@+module Refactor.OrganizeImports.KeepRenamedReexported (module X) where
+
+import Control.Monad as X
+import Data.Maybe as X
+ examples/Refactor/OrganizeImports/KeepRenamedReexported_res.hs view
@@ -0,0 +1,4 @@+module Refactor.OrganizeImports.KeepRenamedReexported (module X) where
+
+import Control.Monad as X
+import Data.Maybe as X
+ examples/Refactor/OrganizeImports/MakeExplicit/ClassSource.hs view
@@ -0,0 +1,11 @@+module Refactor.OrganizeImports.MakeExplicit.ClassSource where
+
+class D a where
+  f :: a
+
+instance D () where 
+  f = ()
+
+g :: D a => a
+g = f
+
+ examples/Refactor/OrganizeImports/MakeExplicit/ConSourceHiddenType.hs view
@@ -0,0 +1,3 @@+module Refactor.OrganizeImports.MakeExplicit.ConSourceHiddenType (A(B)) where
+
+import Refactor.OrganizeImports.MakeExplicit.Source
+ examples/Refactor/OrganizeImports/MakeExplicit/FunSource.hs view
@@ -0,0 +1,3 @@+module Refactor.OrganizeImports.MakeExplicit.FunSource (f) where
+
+import Refactor.OrganizeImports.MakeExplicit.ClassSource
+ examples/Refactor/OrganizeImports/MakeExplicit/ImportClassFun.hs view
@@ -0,0 +1,7 @@+module Refactor.OrganizeImports.MakeExplicit.ImportClassFun where
+
+import Refactor.OrganizeImports.MakeExplicit.Source
+
+x :: ()
+x = f
+
+ examples/Refactor/OrganizeImports/MakeExplicit/ImportClassFun_res.hs view
@@ -0,0 +1,7 @@+module Refactor.OrganizeImports.MakeExplicit.ImportClassFun where
+
+import Refactor.OrganizeImports.MakeExplicit.Source (D(..))
+
+x :: ()
+x = f
+
+ examples/Refactor/OrganizeImports/MakeExplicit/ImportCon.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.MakeExplicit.ImportCon where
+
+import Refactor.OrganizeImports.MakeExplicit.ConSourceHiddenType
+
+x = B
+ examples/Refactor/OrganizeImports/MakeExplicit/ImportCon_res.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.MakeExplicit.ImportCon where
+
+import Refactor.OrganizeImports.MakeExplicit.ConSourceHiddenType (A(..))
+
+x = B
+ examples/Refactor/OrganizeImports/MakeExplicit/ImportFour.hs view
@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.MakeExplicit.ImportFour where
+
+import Refactor.OrganizeImports.MakeExplicit.Source
+
+x = (a,b,e,g)
+
+ examples/Refactor/OrganizeImports/MakeExplicit/ImportFour_res.hs view
@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.MakeExplicit.ImportFour where
+
+import Refactor.OrganizeImports.MakeExplicit.Source
+
+x = (a,b,e,g)
+
+ examples/Refactor/OrganizeImports/MakeExplicit/ImportFunHiddenClass.hs view
@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.MakeExplicit.ImportFunHiddenClass where
+
+import Refactor.OrganizeImports.MakeExplicit.FunSource
+
+h :: ()
+h = f
+ examples/Refactor/OrganizeImports/MakeExplicit/ImportFunHiddenClass_res.hs view
@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.MakeExplicit.ImportFunHiddenClass where
+
+import Refactor.OrganizeImports.MakeExplicit.FunSource (f)
+
+h :: ()
+h = f
+ examples/Refactor/OrganizeImports/MakeExplicit/ImportFunOutOfClass.hs view
@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.MakeExplicit.ImportFunOutOfClass where
+
+import Refactor.OrganizeImports.MakeExplicit.ClassSource
+
+h :: ()
+h = g
+ examples/Refactor/OrganizeImports/MakeExplicit/ImportFunOutOfClass_res.hs view
@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.MakeExplicit.ImportFunOutOfClass where
+
+import Refactor.OrganizeImports.MakeExplicit.ClassSource (g)
+
+h :: ()
+h = g
+ examples/Refactor/OrganizeImports/MakeExplicit/ImportOne.hs view
@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.MakeExplicit.ImportOne where
+
+import Refactor.OrganizeImports.MakeExplicit.Source
+
+x = a
+
+ examples/Refactor/OrganizeImports/MakeExplicit/ImportOne_res.hs view
@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.MakeExplicit.ImportOne where
+
+import Refactor.OrganizeImports.MakeExplicit.Source (a)
+
+x = a
+
+ examples/Refactor/OrganizeImports/MakeExplicit/ImportRecordSel.hs view
@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.MakeExplicit.ImportRecordSel where
+
+import Refactor.OrganizeImports.MakeExplicit.Source
+
+x = b
+
+ examples/Refactor/OrganizeImports/MakeExplicit/ImportRecordSel_res.hs view
@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.MakeExplicit.ImportRecordSel where
+
+import Refactor.OrganizeImports.MakeExplicit.Source (A(..))
+
+x = b
+
+ examples/Refactor/OrganizeImports/MakeExplicit/ImportThree.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.MakeExplicit.ImportThree where
+
+import Refactor.OrganizeImports.MakeExplicit.Source
+
+x = (a,e,g)
+ examples/Refactor/OrganizeImports/MakeExplicit/ImportThree_res.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.MakeExplicit.ImportThree where
+
+import Refactor.OrganizeImports.MakeExplicit.Source (g, e, a)
+
+x = (a,e,g)
+ examples/Refactor/OrganizeImports/MakeExplicit/ImportUnited.hs view
@@ -0,0 +1,7 @@+module Refactor.OrganizeImports.MakeExplicit.ImportUnited where
+
+import Refactor.OrganizeImports.MakeExplicit.Source
+
+x = B ()
+y = b x
+
+ examples/Refactor/OrganizeImports/MakeExplicit/ImportUnitedCount.hs view
@@ -0,0 +1,8 @@+module Refactor.OrganizeImports.MakeExplicit.ImportUnitedCount where
+
+import Refactor.OrganizeImports.MakeExplicit.Source
+
+x = B ()
+y = b x
+z = a
+w = e
+ examples/Refactor/OrganizeImports/MakeExplicit/ImportUnitedCount_res.hs view
@@ -0,0 +1,8 @@+module Refactor.OrganizeImports.MakeExplicit.ImportUnitedCount where
+
+import Refactor.OrganizeImports.MakeExplicit.Source (A(..), e, a)
+
+x = B ()
+y = b x
+z = a
+w = e
+ examples/Refactor/OrganizeImports/MakeExplicit/ImportUnited_res.hs view
@@ -0,0 +1,7 @@+module Refactor.OrganizeImports.MakeExplicit.ImportUnited where
+
+import Refactor.OrganizeImports.MakeExplicit.Source (A(..))
+
+x = B ()
+y = b x
+
+ examples/Refactor/OrganizeImports/MakeExplicit/Renamed.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.MakeExplicit.Renamed where
+
+import Refactor.OrganizeImports.MakeExplicit.Source as Src
+
+x = B
+ examples/Refactor/OrganizeImports/MakeExplicit/Renamed_res.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.MakeExplicit.Renamed where
+
+import Refactor.OrganizeImports.MakeExplicit.Source as Src (A(..))
+
+x = B
+ examples/Refactor/OrganizeImports/MakeExplicit/Source.hs view
@@ -0,0 +1,15 @@+module Refactor.OrganizeImports.MakeExplicit.Source where
+
+a = ()
+e = ()
+g = ()
+
+data A = B { b :: () } 
+       | C
+
+class D a where
+  f :: a
+
+instance D () where
+  f = ()
+
+ examples/Refactor/OrganizeImports/Narrow.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.Narrow where
+
+import Data.List (map, null)
+
+test = map (+1) [1..10]
+ examples/Refactor/OrganizeImports/NarrowQual.hs view
@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.NarrowQual where
+
+import Data.List
+import Data.List as L
+
+test = intersperse 0 $ L.map (+1) [1..10]
+ examples/Refactor/OrganizeImports/NarrowQual_res.hs view
@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.NarrowQual where
+
+import Data.List (map, intersperse)
+import Data.List as L (map, intersperse)
+
+test = intersperse 0 $ L.map (+1) [1..10]
+ examples/Refactor/OrganizeImports/NarrowSpec.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.NarrowSpec where
+
+import Control.Monad.State (State(..))
+
+type St = State ()
+ examples/Refactor/OrganizeImports/NarrowSpec_res.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.NarrowSpec where
+
+import Control.Monad.State (State(..))
+
+type St = State ()
+ examples/Refactor/OrganizeImports/NarrowType.hs view
@@ -0,0 +1,8 @@+module Refactor.OrganizeImports.NarrowType where
+
+import Control.Monad.State
+
+type St = State ()
+type StT = StateT () IO
+
+f = runStateT
+ examples/Refactor/OrganizeImports/NarrowType_res.hs view
@@ -0,0 +1,8 @@+module Refactor.OrganizeImports.NarrowType where
+
+import Control.Monad.State (StateT(..), State)
+
+type St = State ()
+type StT = StateT () IO
+
+f = runStateT
+ examples/Refactor/OrganizeImports/Narrow_res.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.Narrow where
+
+import Data.List (map)
+
+test = map (+1) [1..10]
+ examples/Refactor/OrganizeImports/Operator.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.Operator where
+
+import Data.List ((\\), intersect)
+
+test = [1,2,3] \\ [1,2]
+ examples/Refactor/OrganizeImports/Operator_res.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.Operator where
+
+import Data.List ((\\))
+
+test = [1,2,3] \\ [1,2]
+ examples/Refactor/OrganizeImports/Removed.hs view
@@ -0,0 +1,3 @@+module Refactor.OrganizeImports.Removed where
+
+import Control.Monad ()
+ examples/Refactor/OrganizeImports/Removed_res.hs view
@@ -0,0 +1,2 @@+module Refactor.OrganizeImports.Removed where
+
+ examples/Refactor/OrganizeImports/Reorder.hs view
@@ -0,0 +1,7 @@+module Refactor.OrganizeImports.Reorder where
+
+import Data.List (intersperse)
+import Control.Monad ((>>=))
+
+x = intersperse '-' "abc"
+y = Just () >>= \_ -> Nothing
+ examples/Refactor/OrganizeImports/ReorderComment.hs view
@@ -0,0 +1,12 @@+module Refactor.OrganizeImports.ReorderComment where
+
+import Data.List (intersperse)
+import Control.Monad ((>>=))
+-- some comment
+import Data.Tuple (swap)
+import Data.Maybe (catMaybes)
+
+a = intersperse '-' "abc"
+b = Just () >>= \_ -> Nothing
+c = catMaybes [Just ()]
+d = swap ("a","b")
+ examples/Refactor/OrganizeImports/ReorderComment_res.hs view
@@ -0,0 +1,12 @@+module Refactor.OrganizeImports.ReorderComment where
+
+import Control.Monad ((>>=))
+import Data.List (intersperse)
+import Data.Maybe (catMaybes)
+-- some comment
+import Data.Tuple (swap)
+
+a = intersperse '-' "abc"
+b = Just () >>= \_ -> Nothing
+c = catMaybes [Just ()]
+d = swap ("a","b")
+ examples/Refactor/OrganizeImports/ReorderGroups.hs view
@@ -0,0 +1,12 @@+module Refactor.OrganizeImports.ReorderGroups where
+
+import Data.List (intersperse)
+import Control.Monad ((>>=))
+
+import Data.Tuple (swap)
+import Data.Maybe (catMaybes)
+
+a = intersperse '-' "abc"
+b = Just () >>= \_ -> Nothing
+c = catMaybes [Just ()]
+d = swap ("a","b")
+ examples/Refactor/OrganizeImports/ReorderGroups_res.hs view
@@ -0,0 +1,12 @@+module Refactor.OrganizeImports.ReorderGroups where
+
+import Control.Monad ((>>=))
+import Data.List (intersperse)
+
+import Data.Maybe (catMaybes)
+import Data.Tuple (swap)
+
+a = intersperse '-' "abc"
+b = Just () >>= \_ -> Nothing
+c = catMaybes [Just ()]
+d = swap ("a","b")
+ examples/Refactor/OrganizeImports/Reorder_res.hs view
@@ -0,0 +1,7 @@+module Refactor.OrganizeImports.Reorder where
+
+import Control.Monad ((>>=))
+import Data.List (intersperse)
+
+x = intersperse '-' "abc"
+y = Just () >>= \_ -> Nothing
+ examples/Refactor/OrganizeImports/SameName.hs view
@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.SameName where
+
+import Data.List (map, null)
+
+test = map (+1) [1..null]
+  where null = 10
+ examples/Refactor/OrganizeImports/SameName_res.hs view
@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.SameName where
+
+import Data.List (map)
+
+test = map (+1) [1..null]
+  where null = 10
+ examples/Refactor/OrganizeImports/StandaloneDeriving.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE StandaloneDeriving #-}
+module Refactor.OrganizeImports.StandaloneDeriving where
+
+import Control.Monad.State (State(..), StateT)
+
+type St = State ()
+ examples/Refactor/OrganizeImports/StandaloneDeriving_res.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE StandaloneDeriving #-}
+module Refactor.OrganizeImports.StandaloneDeriving where
+
+import Control.Monad.State (State(..))
+
+type St = State ()
+ examples/Refactor/OrganizeImports/TemplateHaskell.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE TemplateHaskell #-}
+module Refactor.OrganizeImports.TemplateHaskell where
+
+import Control.Monad.Writer
+import Control.Monad.State (State(..))
+ examples/Refactor/OrganizeImports/TemplateHaskell_res.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE TemplateHaskell #-}
+module Refactor.OrganizeImports.TemplateHaskell where
+
+import Control.Monad.State (State(..))
+import Control.Monad.Writer
+ examples/Refactor/RenameDefinition/AccentName.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.AccentName where
+
+f :: Int -> Int
+f x = x
+
+g = f
+ examples/Refactor/RenameDefinition/AccentName_res.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.AccentName where
+
+á :: Int -> Int
+á x = x
+
+g = á
+ examples/Refactor/RenameDefinition/AmbiguousFields.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE DuplicateRecordFields #-}
+module Refactor.RenameDefinition.AmbiguousFields where
+
+data A = A { x, y :: Int }
+data B = B { x, y :: Int }
+
+f :: A -> Int
+f = x
+
+g :: B -> Int
+g = x
+ examples/Refactor/RenameDefinition/AmbiguousFields_res.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE DuplicateRecordFields #-}
+module Refactor.RenameDefinition.AmbiguousFields where
+
+data A = A { xx, y :: Int }
+data B = B { x, y :: Int }
+
+f :: A -> Int
+f = xx
+
+g :: B -> Int
+g = x
+ examples/Refactor/RenameDefinition/Arg.hs view
@@ -0,0 +1,4 @@+module Refactor.RenameDefinition.Arg where
+
+f :: Int -> Int
+f x = x
+ examples/Refactor/RenameDefinition/Arg_res.hs view
@@ -0,0 +1,4 @@+module Refactor.RenameDefinition.Arg where
+
+f :: Int -> Int
+f y = y
+ examples/Refactor/RenameDefinition/BacktickName.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.BacktickName where
+
+f :: Int -> Int -> Int
+f = (+)
+
+x = 3 `f` 4
+ examples/Refactor/RenameDefinition/BacktickName_res.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.BacktickName where
+
+g :: Int -> Int -> Int
+g = (+)
+
+x = 3 `g` 4
+ examples/Refactor/RenameDefinition/ClassMember.hs view
@@ -0,0 +1,7 @@+module Refactor.RenameDefinition.ClassMember where
+
+class C t where
+  f :: t -> t
+
+instance C Int where
+  f i = i
+ examples/Refactor/RenameDefinition/ClassMember_res.hs view
@@ -0,0 +1,7 @@+module Refactor.RenameDefinition.ClassMember where
+
+class C t where
+  q :: t -> t
+
+instance C Int where
+  q i = i
+ examples/Refactor/RenameDefinition/ClassTypeVar.hs view
@@ -0,0 +1,4 @@+module Refactor.RenameDefinition.ClassTypeVar where
+
+class C t where
+  f :: t -> t
+ examples/Refactor/RenameDefinition/ClassTypeVar_res.hs view
@@ -0,0 +1,4 @@+module Refactor.RenameDefinition.ClassTypeVar where
+
+class C f where
+  f :: f -> f
+ examples/Refactor/RenameDefinition/Constructor.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.Constructor where
+
+data Point = Point Double Double
+
+distance :: Point -> Point -> Double
+distance (Point x1 y1) (Point x2 y2) = sqrt ((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
+ examples/Refactor/RenameDefinition/Constructor_res.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.Constructor where
+
+data Point = Point2D Double Double
+
+distance :: Point -> Point -> Double
+distance (Point2D x1 y1) (Point2D x2 y2) = sqrt ((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
+ examples/Refactor/RenameDefinition/CrossRename.hs view
@@ -0,0 +1,8 @@+module Refactor.RenameDefinition.CrossRename where
+
+-- Renaming f to g should fail
+f x = x
+
+ff x = g
+  where
+    g = f 'g'
+ examples/Refactor/RenameDefinition/DefineSplices.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/FormattingAware.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/FormattingAware_res.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/FunTypeVar.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/FunTypeVarLocal.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/FunTypeVarLocal_res.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/FunTypeVar_res.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/Function.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/Function_res.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/FunnyDo.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/FunnyDo_res.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/IllegalQualRename.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/LayoutAware.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/LayoutAware_res.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/LibraryFunction.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/LocalFunction.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/LocalFunction_res.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/MergeFields.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/MergeFields_RenameY.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/MergeFields_RenameY_res.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/MergeFields_res.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/MultiModule/A.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/MultiModule/B.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/MultiModule_res/A.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/MultiModule_res/B.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/NameClash.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/NoPrelude.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/NoPrelude_res.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/ParenName.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/ParenName_res.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/PatternSynonym.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/PatternSynonymTypeSig.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/PatternSynonymTypeSig_res.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/PatternSynonym_res.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/QualImport.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/QualImportAlso.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/QualImport_res.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/QualName.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/QualName_res.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/RecordField.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/RecordField_res.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/RecordPatternSynonyms.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/RecordPatternSynonyms_res.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/RecordWildcards.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/RecordWildcards_res.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/RenameModule/A.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/RenameModule/B.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/RenameModuleAlias.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/RenameModuleAlias_res.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/RenameModule_res/A.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/RenameModule_res/C.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/RoleAnnotation.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/RoleAnnotation_res.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/SameCtorAndType.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/SameCtorAndType_res.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/SpliceDecls/Define.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/SpliceDecls/Use.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/SpliceDecls_res/Define.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/SpliceDecls_res/Use.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/SpliceExpr/Define.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/SpliceExpr/Use.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/SpliceExpr_res/Define.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/SpliceExpr_res/Use.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/SpliceType/Define.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/SpliceType/Use.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/SpliceType_res/Define.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/SpliceType_res/Use.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/Type.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/TypeBracket.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/TypeBracket_res.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/TypeOperators.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/TypeOperators_res.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/Type_res.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/UnusedDef.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/UnusedDef_res.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/ValBracket.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/ValBracket_res.hs view

file too large to diff

+ examples/Refactor/RenameDefinition/WrongName.hs view

file too large to diff

+ examples/TH/Brackets.hs view

file too large to diff

+ examples/TH/ClassUse.hs view

file too large to diff

+ examples/TH/CrossDef.hs view

file too large to diff

+ examples/TH/DoubleSplice.hs view

file too large to diff

+ examples/TH/GADTFields.hs view

file too large to diff

+ examples/TH/LocalDefinition.hs view

file too large to diff

+ examples/TH/MultiImport.hs view

file too large to diff

+ examples/TH/NestedSplices.hs view

file too large to diff

+ examples/TH/QuasiQuote/Define.hs view

file too large to diff

+ examples/TH/QuasiQuote/Use.hs view

file too large to diff

+ examples/TH/Quoted.hs view

file too large to diff

+ examples/TH/Splice/Define.hs view

file too large to diff

+ examples/TH/Splice/Names.hs view

file too large to diff

+ examples/TH/Splice/Use.hs view

file too large to diff

+ examples/TH/Splice/UseImported.hs view

file too large to diff

+ examples/TH/Splice/UseQual.hs view

file too large to diff

+ examples/TH/Splice/UseQualMulti.hs view

file too large to diff

+ examples/TH/WithWildcards.hs view

file too large to diff

+ examples/Type/Bang.hs view

file too large to diff

+ examples/Type/Builtin.hs view

file too large to diff

+ examples/Type/Ctx.hs view

file too large to diff

+ examples/Type/ExplicitTypeApplication.hs view

file too large to diff

+ examples/Type/Forall.hs view

file too large to diff

+ examples/Type/Primitives.hs view

file too large to diff

+ examples/Type/TupleAssert.hs view

file too large to diff

+ examples/Type/TypeOperators.hs view

file too large to diff

+ examples/Type/Unpack.hs view

file too large to diff

+ examples/Type/Wildcard.hs view

file too large to diff

+ haskell-tools-builtin-refactorings.cabal view

file too large to diff

+ test/ExtensionOrganizerTest/AnnotationParser.hs view

file too large to diff

+ test/ExtensionOrganizerTest/BangPatternsTest/Combined.hs view

file too large to diff

+ test/ExtensionOrganizerTest/BangPatternsTest/InAlt.hs view

file too large to diff

+ test/ExtensionOrganizerTest/BangPatternsTest/InExpr.hs view

file too large to diff

+ test/ExtensionOrganizerTest/BangPatternsTest/InMatchLhs.hs view

file too large to diff

+ test/ExtensionOrganizerTest/BangPatternsTest/InPatSynRhs.hs view

file too large to diff

+ test/ExtensionOrganizerTest/BangPatternsTest/InPattern.hs view

file too large to diff

+ test/ExtensionOrganizerTest/BangPatternsTest/InRhsGuard.hs view

file too large to diff

+ test/ExtensionOrganizerTest/BangPatternsTest/InStmt.hs view

file too large to diff

+ test/ExtensionOrganizerTest/BangPatternsTest/InValueBind.hs view

file too large to diff

+ test/ExtensionOrganizerTest/DerivingsTest/DataDeriving.hs view

file too large to diff

+ test/ExtensionOrganizerTest/DerivingsTest/DataDerivingStrategies.hs view

file too large to diff

+ test/ExtensionOrganizerTest/DerivingsTest/Definitions.hs view

file too large to diff

+ test/ExtensionOrganizerTest/DerivingsTest/NewtypeDeriving.hs view

file too large to diff

+ test/ExtensionOrganizerTest/DerivingsTest/NewtypeDerivingStrategies.hs view

file too large to diff

+ test/ExtensionOrganizerTest/DerivingsTest/StandaloneData.hs view

file too large to diff

+ test/ExtensionOrganizerTest/DerivingsTest/StandaloneDataStrategies.hs view

file too large to diff

+ test/ExtensionOrganizerTest/DerivingsTest/StandaloneDataSynonyms.hs view

file too large to diff

+ test/ExtensionOrganizerTest/DerivingsTest/StandaloneDataSynonymsStrategies.hs view

file too large to diff

+ test/ExtensionOrganizerTest/DerivingsTest/StandaloneNewtype.hs view

file too large to diff

+ test/ExtensionOrganizerTest/DerivingsTest/StandaloneNewtypeAny.hs view

file too large to diff

+ test/ExtensionOrganizerTest/DerivingsTest/StandaloneNewtypeStrategies.hs view

file too large to diff

+ test/ExtensionOrganizerTest/DerivingsTest/StandaloneNewtypeSynonyms.hs view

file too large to diff

+ test/ExtensionOrganizerTest/DerivingsTest/StandaloneNewtypeSynonymsAny.hs view

file too large to diff

+ test/ExtensionOrganizerTest/DerivingsTest/StandaloneNewtypeSynonymsStrategies.hs view

file too large to diff

+ test/ExtensionOrganizerTest/DerivingsTest/SynonymDefinitions.hs view

file too large to diff

+ test/ExtensionOrganizerTest/FlexibleInstancesTest/Combined.hs view

file too large to diff

+ test/ExtensionOrganizerTest/FlexibleInstancesTest/Definitions.hs view

file too large to diff

+ test/ExtensionOrganizerTest/FlexibleInstancesTest/NestedTypes.hs view

file too large to diff

+ test/ExtensionOrganizerTest/FlexibleInstancesTest/NestedUnitTyCon.hs view

file too large to diff

+ test/ExtensionOrganizerTest/FlexibleInstancesTest/NestedWiredInType.hs view

file too large to diff

+ test/ExtensionOrganizerTest/FlexibleInstancesTest/NoOccurenceOFF.hs view

file too large to diff

+ test/ExtensionOrganizerTest/FlexibleInstancesTest/NoOccurenceON.hs view

file too large to diff

+ test/ExtensionOrganizerTest/FlexibleInstancesTest/SameTyVars.hs view

file too large to diff

+ test/ExtensionOrganizerTest/FlexibleInstancesTest/TopLevelTyVar.hs view

file too large to diff

+ test/ExtensionOrganizerTest/FlexibleInstancesTest/TopLevelWiredInType.hs view

file too large to diff

+ test/ExtensionOrganizerTest/LambdaCaseTest/Definitions.hs view

file too large to diff

+ test/ExtensionOrganizerTest/LambdaCaseTest/InCaseRhs.hs view

file too large to diff

+ test/ExtensionOrganizerTest/LambdaCaseTest/InCompStmt.hs view

file too large to diff

+ test/ExtensionOrganizerTest/LambdaCaseTest/InExpr.hs view

file too large to diff

+ test/ExtensionOrganizerTest/LambdaCaseTest/InFieldUpdate.hs view

file too large to diff

+ test/ExtensionOrganizerTest/LambdaCaseTest/InPattern.hs view

file too large to diff

+ test/ExtensionOrganizerTest/LambdaCaseTest/InRhs.hs view

file too large to diff

+ test/ExtensionOrganizerTest/LambdaCaseTest/InRhsGuard.hs view

file too large to diff

+ test/ExtensionOrganizerTest/LambdaCaseTest/InStmt.hs view

file too large to diff

+ test/ExtensionOrganizerTest/LambdaCaseTest/InTupSecElem.hs view

file too large to diff

+ test/ExtensionOrganizerTest/Main.hs view

file too large to diff

+ test/ExtensionOrganizerTest/PatternSynonymsTest/BiDirectional.hs view

file too large to diff

+ test/ExtensionOrganizerTest/PatternSynonymsTest/UniDirectional.hs view

file too large to diff

+ test/ExtensionOrganizerTest/RecordWildCardsTest/Definitions.hs view

file too large to diff

+ test/ExtensionOrganizerTest/RecordWildCardsTest/InExpression.hs view

file too large to diff

+ test/ExtensionOrganizerTest/RecordWildCardsTest/InPattern.hs view

file too large to diff

+ test/ExtensionOrganizerTest/TupleSectionsTest/Definitions.hs view

file too large to diff

+ test/ExtensionOrganizerTest/TupleSectionsTest/InCaseRhs.hs view

file too large to diff

+ test/ExtensionOrganizerTest/TupleSectionsTest/InCompStmt.hs view

file too large to diff

+ test/ExtensionOrganizerTest/TupleSectionsTest/InExpr.hs view

file too large to diff

+ test/ExtensionOrganizerTest/TupleSectionsTest/InFieldUpdate.hs view

file too large to diff

+ test/ExtensionOrganizerTest/TupleSectionsTest/InPattern.hs view

file too large to diff

+ test/ExtensionOrganizerTest/TupleSectionsTest/InRhs.hs view

file too large to diff

+ test/ExtensionOrganizerTest/TupleSectionsTest/InRhsGuard.hs view

file too large to diff

+ test/ExtensionOrganizerTest/TupleSectionsTest/InStmt.hs view

file too large to diff

+ test/ExtensionOrganizerTest/TupleSectionsTest/InTupSecElem.hs view

file too large to diff

+ test/ExtensionOrganizerTest/TupleSectionsTest/NoTupleSections.hs view

file too large to diff

+ test/ExtensionOrganizerTest/ViewPatternsTest/InAlt.hs view

file too large to diff

+ test/ExtensionOrganizerTest/ViewPatternsTest/InExpr.hs view

file too large to diff

+ test/ExtensionOrganizerTest/ViewPatternsTest/InMatchLhs.hs view

file too large to diff

+ test/ExtensionOrganizerTest/ViewPatternsTest/InMatchLhsNested.hs view

file too large to diff

+ test/Main.hs view

file too large to diff