haskell-tools-refactor 0.8.1.0 → 0.9.0.0

raw patch · 506 files changed

+874/−8512 lines, 506 filesdep −eitherdep −haskell-tools-refactordep −old-timedep ~Cabaldep ~ghcdep ~haskell-tools-astPVP ok

version bump matches the API change (PVP)

Dependencies removed: either, haskell-tools-refactor, old-time, polyparse, tasty, tasty-hunit, time

Dependency ranges changed: Cabal, ghc, haskell-tools-ast, haskell-tools-backend-ghc, haskell-tools-prettyprint, haskell-tools-rewrite, template-haskell

API changes (from Hackage documentation)

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

Files

• Language/Haskell/Tools/Refactor.hs +24/−16
• Language/Haskell/Tools/Refactor/BindingElem.hs +0/−77
• Language/Haskell/Tools/Refactor/ChangeAST.hs +0/−41
• Language/Haskell/Tools/Refactor/GetModules.hs +0/−507
• Language/Haskell/Tools/Refactor/Helpers.hs +0/−51
• Language/Haskell/Tools/Refactor/ListOperations.hs +0/−103
• Language/Haskell/Tools/Refactor/Monad.hs +128/−0
• Language/Haskell/Tools/Refactor/Perform.hs +0/−87
• Language/Haskell/Tools/Refactor/Predefined/DataToNewtype.hs +0/−15
• Language/Haskell/Tools/Refactor/Predefined/DollarApp.hs +0/−49
• Language/Haskell/Tools/Refactor/Predefined/DollarApp1.hs +0/−16
• Language/Haskell/Tools/Refactor/Predefined/DollarApp2.hs +0/−23
• Language/Haskell/Tools/Refactor/Predefined/DollarApp3.hs +0/−44
• Language/Haskell/Tools/Refactor/Predefined/ExtractBinding.hs +0/−230
• Language/Haskell/Tools/Refactor/Predefined/FloatOut.hs +0/−76
• Language/Haskell/Tools/Refactor/Predefined/GenerateExports.hs +0/−40
• Language/Haskell/Tools/Refactor/Predefined/GenerateTypeSignature.hs +0/−176
• Language/Haskell/Tools/Refactor/Predefined/HelloRefactor.hs +0/−17
• Language/Haskell/Tools/Refactor/Predefined/IfToGuards.hs +0/−29
• Language/Haskell/Tools/Refactor/Predefined/InlineBinding.hs +0/−226
• Language/Haskell/Tools/Refactor/Predefined/OrganizeImports.hs +0/−229
• Language/Haskell/Tools/Refactor/Predefined/RenameDefinition.hs +0/−137
• Language/Haskell/Tools/Refactor/Prepare.hs +30/−28
• Language/Haskell/Tools/Refactor/RefactorBase.hs +0/−456
• Language/Haskell/Tools/Refactor/Refactoring.hs +58/−0
• Language/Haskell/Tools/Refactor/Representation.hs +70/−0
• Language/Haskell/Tools/Refactor/Session.hs +0/−257
• Language/Haskell/Tools/Refactor/Utils/AST.hs +40/−0
• Language/Haskell/Tools/Refactor/Utils/BindingElem.hs +77/−0
• Language/Haskell/Tools/Refactor/Utils/Helpers.hs +49/−0
• Language/Haskell/Tools/Refactor/Utils/Indentation.hs +16/−0
• Language/Haskell/Tools/Refactor/Utils/Lists.hs +102/−0
• Language/Haskell/Tools/Refactor/Utils/Monadic.hs +194/−0
• Language/Haskell/Tools/Refactor/Utils/Name.hs +68/−0
• examples/CPP/BetweenImports.hs +0/−10
• examples/CPP/BetweenImports_res.hs +0/−10
• examples/CPP/ConditionalCode.hs +0/−8
• examples/CPP/ConditionalImport.hs +0/−10
• examples/CPP/ConditionalImportBegin.hs +0/−10
• examples/CPP/ConditionalImportBegin_res.hs +0/−9
• examples/CPP/ConditionalImportEnd.hs +0/−10
• examples/CPP/ConditionalImportEnd_res.hs +0/−9
• examples/CPP/ConditionalImportHalfRemoved.hs +0/−10
• examples/CPP/ConditionalImportHalfRemoved_res.hs +0/−10
• examples/CPP/ConditionalImportMulti.hs +0/−11
• examples/CPP/ConditionalImportMulti_res.hs +0/−11
• examples/CPP/ConditionalImportOrder.hs +0/−13
• examples/CPP/ConditionalImportOrder_res.hs +0/−13
• examples/CPP/ConditionalImport_res.hs +0/−10
• examples/CPP/JustEnabled.hs +0/−2
• examples/CppHs/Language/Preprocessor/Cpphs.hs +0/−34
• examples/CppHs/Language/Preprocessor/Cpphs/CppIfdef.hs +0/−416
• examples/CppHs/Language/Preprocessor/Cpphs/HashDefine.hs +0/−129
• examples/CppHs/Language/Preprocessor/Cpphs/MacroPass.hs +0/−184
• examples/CppHs/Language/Preprocessor/Cpphs/Options.hs +0/−156
• examples/CppHs/Language/Preprocessor/Cpphs/Position.hs +0/−106
• examples/CppHs/Language/Preprocessor/Cpphs/ReadFirst.hs +0/−55
• examples/CppHs/Language/Preprocessor/Cpphs/RunCpphs.hs +0/−82
• examples/CppHs/Language/Preprocessor/Cpphs/SymTab.hs +0/−92
• examples/CppHs/Language/Preprocessor/Cpphs/Tokenise.hs +0/−281
• examples/CppHs/Language/Preprocessor/Unlit.hs +0/−72
• examples/Decl/AmbiguousFields.hs +0/−9
• examples/Decl/AnnPragma.hs +0/−8
• examples/Decl/ClassInfix.hs +0/−10
• examples/Decl/ClosedTypeFamily.hs +0/−9
• examples/Decl/CtorOp.hs +0/−10
• examples/Decl/DataFamily.hs +0/−6
• examples/Decl/DataType.hs +0/−5
• examples/Decl/DataTypeDerivings.hs +0/−5
• examples/Decl/DefaultDecl.hs +0/−3
• examples/Decl/FunBind.hs +0/−4
• examples/Decl/FunFixity.hs +0/−5
• examples/Decl/FunGuards.hs +0/−5
• examples/Decl/FunctionalDeps.hs +0/−6
• examples/Decl/GADT.hs +0/−9
• examples/Decl/GadtConWithCtx.hs +0/−5
• examples/Decl/InfixAssertion.hs +0/−9
• examples/Decl/InfixInstances.hs +0/−8
• examples/Decl/InfixPatSyn.hs +0/−10
• examples/Decl/InjectiveTypeFamily.hs +0/−6
• examples/Decl/InlinePragma.hs +0/−5
• examples/Decl/InstanceFamily.hs +0/−10
• examples/Decl/InstanceOverlaps.hs +0/−11
• examples/Decl/InstanceSpec.hs +0/−7
• examples/Decl/LocalBindingInDo.hs +0/−7
• examples/Decl/LocalBindings.hs +0/−9
• examples/Decl/LocalFixity.hs +0/−6
• examples/Decl/MixedInstance.hs +0/−11
• examples/Decl/MultipleFixity.hs +0/−12
• examples/Decl/MultipleSigs.hs +0/−6
• examples/Decl/OperatorBind.hs +0/−6
• examples/Decl/OperatorDecl.hs +0/−6
• examples/Decl/ParamDataType.hs +0/−5
• examples/Decl/PatternBind.hs +0/−3
• examples/Decl/PatternSynonym.hs +0/−28
• examples/Decl/RecordPatternSynonyms.hs +0/−6
• examples/Decl/RecordType.hs +0/−3
• examples/Decl/RewriteRule.hs +0/−3
• examples/Decl/SpecializePragma.hs +0/−5
• examples/Decl/StandaloneDeriving.hs +0/−6
• examples/Decl/TypeClass.hs +0/−13
• examples/Decl/TypeClassMinimal.hs +0/−8
• examples/Decl/TypeFamily.hs +0/−6
• examples/Decl/TypeFamilyKindSig.hs +0/−6
• examples/Decl/TypeInstance.hs +0/−14
• examples/Decl/TypeRole.hs +0/−5
• examples/Decl/TypeSynonym.hs +0/−3
• examples/Decl/ValBind.hs +0/−3
• examples/Decl/ViewPatternSynonym.hs +0/−8
• examples/Expr/ArrowNotation.hs +0/−10
• examples/Expr/Case.hs +0/−8
• examples/Expr/DoNotation.hs +0/−15
• examples/Expr/EmptyCase.hs +0/−8
• examples/Expr/EmptyLet.hs +0/−6
• examples/Expr/FunSection.hs +0/−6
• examples/Expr/GeneralizedListComp.hs +0/−31
• examples/Expr/If.hs +0/−4
• examples/Expr/ImplicitParams.hs +0/−8
• examples/Expr/LambdaCase.hs +0/−11
• examples/Expr/ListComp.hs +0/−3
• examples/Expr/MultiwayIf.hs +0/−7
• examples/Expr/Negate.hs +0/−4
• examples/Expr/Operator.hs +0/−5
• examples/Expr/ParListComp.hs +0/−4
• examples/Expr/ParenName.hs +0/−3
• examples/Expr/PatternAndDo.hs +0/−10
• examples/Expr/RecordPuns.hs +0/−6
• examples/Expr/RecordWildcards.hs +0/−6
• examples/Expr/RecursiveDo.hs +0/−9
• examples/Expr/SccPragma.hs +0/−4
• examples/Expr/Sections.hs +0/−4
• examples/Expr/SemicolonDo.hs +0/−7
• examples/Expr/StaticPtr.hs +0/−16
• examples/Expr/TupleSections.hs +0/−7
• examples/Expr/UnicodeSyntax.hs +0/−7
• examples/InstanceControl/Control/Instances/Morph.hs +0/−149
• examples/InstanceControl/Control/Instances/ShortestPath.hs +0/−69
• examples/InstanceControl/Control/Instances/Test.hs +0/−23
• examples/InstanceControl/Control/Instances/TypeLevelPrelude.hs +0/−88
• examples/Module/DeprecatedPragma.hs +0/−1
• examples/Module/Export.hs +0/−2
• examples/Module/GhcOptionsPragma.hs +0/−2
• examples/Module/Import.hs +0/−11
• examples/Module/ImportOp.hs +0/−3
• examples/Module/Imported.hs +0/−6
• examples/Module/LangPragmas.hs +0/−4
• examples/Module/NamespaceExport.hs +0/−4
• examples/Module/PatternImport.hs +0/−4
• examples/Module/Simple.hs +0/−1
• examples/Module/WarningPragma.hs +0/−1
• examples/Pattern/Backtick.hs +0/−5
• examples/Pattern/Constructor.hs +0/−3
• examples/Pattern/ImplicitParams.hs +0/−9
• examples/Pattern/Infix.hs +0/−5
• examples/Pattern/NPlusK.hs +0/−6
• examples/Pattern/NestedWildcard.hs +0/−7
• examples/Pattern/OperatorPattern.hs +0/−3
• examples/Pattern/Record.hs +0/−11
• examples/Refactor/CommentHandling/BlockComments.hs +0/−10
• examples/Refactor/CommentHandling/CommentTypes.hs +0/−10
• examples/Refactor/CommentHandling/Crosslinking.hs +0/−6
• examples/Refactor/CommentHandling/FunctionArgs.hs +0/−6
• examples/Refactor/DataToNewtype/Cases.hs +0/−8
• examples/Refactor/DataToNewtype/Cases_res.hs +0/−8
• examples/Refactor/DollarApp/AnotherOperator.hs +0/−5
• examples/Refactor/DollarApp/AnotherOperator_res.hs +0/−5
• examples/Refactor/DollarApp/Defs.hs +0/−9
• examples/Refactor/DollarApp/Final.hs +0/−16
• examples/Refactor/DollarApp/FirstMulti.hs +0/−5
• examples/Refactor/DollarApp/FirstMulti_res.hs +0/−5
• examples/Refactor/DollarApp/FirstSingle.hs +0/−5
• examples/Refactor/DollarApp/FirstSingle_res.hs +0/−5
• examples/Refactor/DollarApp/ImportDollar.hs +0/−6
• examples/Refactor/DollarApp/ImportDollar_res.hs +0/−7
• examples/Refactor/DollarApp/InfixOperator.hs +0/−5
• examples/Refactor/DollarApp/InfixOperator_res.hs +0/−5
• examples/Refactor/ExtractBinding/AddToExisting.hs +0/−4
• examples/Refactor/ExtractBinding/AddToExisting_res.hs +0/−5
• examples/Refactor/ExtractBinding/AssocOp.hs +0/−3
• examples/Refactor/ExtractBinding/AssocOpMiddle.hs +0/−3
• examples/Refactor/ExtractBinding/AssocOpMiddle_res.hs +0/−4
• examples/Refactor/ExtractBinding/AssocOpRightAssoc.hs +0/−3
• examples/Refactor/ExtractBinding/AssocOpRightAssoc_res.hs +0/−4
• examples/Refactor/ExtractBinding/AssocOp_res.hs +0/−4
• examples/Refactor/ExtractBinding/ClassInstance.hs +0/−6
• examples/Refactor/ExtractBinding/ClassInstance_res.hs +0/−7
• examples/Refactor/ExtractBinding/ExistingLocalDef.hs +0/−4
• examples/Refactor/ExtractBinding/ExistingLocalDef_res.hs +0/−4
• examples/Refactor/ExtractBinding/ExtractedFormatting.hs +0/−5
• examples/Refactor/ExtractBinding/ExtractedFormatting_res.hs +0/−6
• examples/Refactor/ExtractBinding/Indentation.hs +0/−5
• examples/Refactor/ExtractBinding/IndentationMultiLine.hs +0/−7
• examples/Refactor/ExtractBinding/IndentationMultiLine_res.hs +0/−8
• examples/Refactor/ExtractBinding/IndentationOperator.hs +0/−5
• examples/Refactor/ExtractBinding/IndentationOperator_res.hs +0/−6
• examples/Refactor/ExtractBinding/Indentation_res.hs +0/−6
• examples/Refactor/ExtractBinding/LeftSection.hs +0/−3
• examples/Refactor/ExtractBinding/LeftSection_res.hs +0/−4
• examples/Refactor/ExtractBinding/ListComprehension.hs +0/−5
• examples/Refactor/ExtractBinding/ListComprehension_res.hs +0/−6
• examples/Refactor/ExtractBinding/LocalDefinition.hs +0/−4
• examples/Refactor/ExtractBinding/LocalDefinition_res.hs +0/−5
• examples/Refactor/ExtractBinding/NameConflict.hs +0/−4
• examples/Refactor/ExtractBinding/Parentheses.hs +0/−6
• examples/Refactor/ExtractBinding/Parentheses_res.hs +0/−7
• examples/Refactor/ExtractBinding/RecordWildcards.hs +0/−6
• examples/Refactor/ExtractBinding/RecordWildcards_res.hs +0/−7
• examples/Refactor/ExtractBinding/Records.hs +0/−5
• examples/Refactor/ExtractBinding/Records_res.hs +0/−6
• examples/Refactor/ExtractBinding/RightSection.hs +0/−3
• examples/Refactor/ExtractBinding/RightSection_res.hs +0/−4
• examples/Refactor/ExtractBinding/SectionInfix.hs +0/−3
• examples/Refactor/ExtractBinding/SectionInfix_res.hs +0/−4
• examples/Refactor/ExtractBinding/SectionWithLocals.hs +0/−6
• examples/Refactor/ExtractBinding/SectionWithLocals_res.hs +0/−7
• examples/Refactor/ExtractBinding/SiblingDefs.hs +0/−7
• examples/Refactor/ExtractBinding/SiblingDefs_res.hs +0/−8
• examples/Refactor/ExtractBinding/Simple.hs +0/−3
• examples/Refactor/ExtractBinding/Simple_res.hs +0/−4
• examples/Refactor/ExtractBinding/TooSimple.hs +0/−3
• examples/Refactor/ExtractBinding/ViewPattern.hs +0/−4
• examples/Refactor/FloatOut/FloatLocals.hs +0/−5
• examples/Refactor/FloatOut/FloatLocals_res.hs +0/−5
• examples/Refactor/FloatOut/ImplicitLocal.hs +0/−5
• examples/Refactor/FloatOut/ImplicitParam.hs +0/−4
• examples/Refactor/FloatOut/MoveFixity.hs +0/−5
• examples/Refactor/FloatOut/MoveFixity_res.hs +0/−5
• examples/Refactor/FloatOut/MoveSignature.hs +0/−5
• examples/Refactor/FloatOut/MoveSignature_res.hs +0/−5
• examples/Refactor/FloatOut/NameCollosion.hs +0/−6
• examples/Refactor/FloatOut/NameCollosionWithImport.hs +0/−4
• examples/Refactor/FloatOut/NameCollosionWithLocal.hs +0/−6
• examples/Refactor/FloatOut/NoCollosion.hs +0/−7
• examples/Refactor/FloatOut/NoCollosion_res.hs +0/−7
• examples/Refactor/FloatOut/SharedSignature.hs +0/−6
• examples/Refactor/FloatOut/ToTopLevel.hs +0/−4
• examples/Refactor/FloatOut/ToTopLevel_res.hs +0/−4
• examples/Refactor/GenerateExports/Normal.hs +0/−17
• examples/Refactor/GenerateExports/Normal_res.hs +0/−17
• examples/Refactor/GenerateExports/Operators.hs +0/−7
• examples/Refactor/GenerateExports/Operators_res.hs +0/−7
• examples/Refactor/GenerateTypeSignature/BringToScope/A.hs +0/−4
• examples/Refactor/GenerateTypeSignature/BringToScope/AlreadyQualImport.hs +0/−6
• examples/Refactor/GenerateTypeSignature/BringToScope/AlreadyQualImport_res.hs +0/−8
• examples/Refactor/GenerateTypeSignature/BringToScope/B.hs +0/−6
• examples/Refactor/GenerateTypeSignature/CanCaptureVariable.hs +0/−8
• examples/Refactor/GenerateTypeSignature/CanCaptureVariableHasOtherDef.hs +0/−11
• examples/Refactor/GenerateTypeSignature/CanCaptureVariableHasOtherDef_res.hs +0/−12
• examples/Refactor/GenerateTypeSignature/CanCaptureVariable_res.hs +0/−9
• examples/Refactor/GenerateTypeSignature/CannotCaptureVariable.hs +0/−7
• examples/Refactor/GenerateTypeSignature/CannotCaptureVariableNoExt.hs +0/−8
• examples/Refactor/GenerateTypeSignature/Complex.hs +0/−3
• examples/Refactor/GenerateTypeSignature/ComplexLhs.hs +0/−6
• examples/Refactor/GenerateTypeSignature/Complex_res.hs +0/−4
• examples/Refactor/GenerateTypeSignature/Function.hs +0/−3
• examples/Refactor/GenerateTypeSignature/Function_res.hs +0/−4
• examples/Refactor/GenerateTypeSignature/HigherOrder.hs +0/−3
• examples/Refactor/GenerateTypeSignature/HigherOrder_res.hs +0/−4
• examples/Refactor/GenerateTypeSignature/Let.hs +0/−4
• examples/Refactor/GenerateTypeSignature/Let_res.hs +0/−5
• examples/Refactor/GenerateTypeSignature/Local.hs +0/−4
• examples/Refactor/GenerateTypeSignature/Local_res.hs +0/−5
• examples/Refactor/GenerateTypeSignature/Placement.hs +0/−5
• examples/Refactor/GenerateTypeSignature/Placement_res.hs +0/−6
• examples/Refactor/GenerateTypeSignature/Polymorph.hs +0/−6
• examples/Refactor/GenerateTypeSignature/PolymorphSub.hs +0/−5
• examples/Refactor/GenerateTypeSignature/PolymorphSubMulti.hs +0/−5
• examples/Refactor/GenerateTypeSignature/PolymorphSubMulti_res.hs +0/−6
• examples/Refactor/GenerateTypeSignature/PolymorphSub_res.hs +0/−6
• examples/Refactor/GenerateTypeSignature/Polymorph_res.hs +0/−7
• examples/Refactor/GenerateTypeSignature/Simple.hs +0/−3
• examples/Refactor/GenerateTypeSignature/Simple_res.hs +0/−4
• examples/Refactor/GenerateTypeSignature/Tuple.hs +0/−3
• examples/Refactor/GenerateTypeSignature/Tuple_res.hs +0/−4
• examples/Refactor/GenerateTypeSignature/TypeDefinedInModule.hs +0/−6
• examples/Refactor/GenerateTypeSignature/TypeDefinedInModule_res.hs +0/−7
• examples/Refactor/IfToGuards/Simple.hs +0/−3
• examples/Refactor/IfToGuards/Simple_res.hs +0/−4
• examples/Refactor/InlineBinding/AlreadyApplied.hs +0/−4
• examples/Refactor/InlineBinding/AlreadyApplied_res.hs +0/−3
• examples/Refactor/InlineBinding/AppearsInAnother/A.hs +0/−3
• examples/Refactor/InlineBinding/AppearsInAnother/B.hs +0/−5
• examples/Refactor/InlineBinding/AutoNaming.hs +0/−5
• examples/Refactor/InlineBinding/AutoNaming_res.hs +0/−4
• examples/Refactor/InlineBinding/FilterSignatures.hs +0/−7
• examples/Refactor/InlineBinding/FilterSignatures_res.hs +0/−6
• examples/Refactor/InlineBinding/InExportList.hs +0/−4
• examples/Refactor/InlineBinding/LetBind.hs +0/−3
• examples/Refactor/InlineBinding/LetBind_res.hs +0/−3
• examples/Refactor/InlineBinding/LetGuard.hs +0/−5
• examples/Refactor/InlineBinding/LetGuard_res.hs +0/−4
• examples/Refactor/InlineBinding/LetStmt.hs +0/−4
• examples/Refactor/InlineBinding/LetStmt_res.hs +0/−3
• examples/Refactor/InlineBinding/Local.hs +0/−4
• examples/Refactor/InlineBinding/LocalNested.hs +0/−5
• examples/Refactor/InlineBinding/LocalNested_res.hs +0/−4
• examples/Refactor/InlineBinding/Local_res.hs +0/−3
• examples/Refactor/InlineBinding/MultiApplied.hs +0/−6
• examples/Refactor/InlineBinding/MultiApplied_res.hs +0/−5
• examples/Refactor/InlineBinding/MultiMatch.hs +0/−6
• examples/Refactor/InlineBinding/MultiMatchGuarded.hs +0/−6
• examples/Refactor/InlineBinding/MultiMatchGuarded_res.hs +0/−4
• examples/Refactor/InlineBinding/MultiMatch_res.hs +0/−5
• examples/Refactor/InlineBinding/Nested.hs +0/−4
• examples/Refactor/InlineBinding/Nested_res.hs +0/−3
• examples/Refactor/InlineBinding/NotOccurring.hs +0/−3
• examples/Refactor/InlineBinding/Operator.hs +0/−4
• examples/Refactor/InlineBinding/Operator_res.hs +0/−3
• examples/Refactor/InlineBinding/PatternMatched.hs +0/−4
• examples/Refactor/InlineBinding/PatternMatched_res.hs +0/−3
• examples/Refactor/InlineBinding/Recursive.hs +0/−4
• examples/Refactor/InlineBinding/RemoveSignatures.hs +0/−6
• examples/Refactor/InlineBinding/RemoveSignatures_res.hs +0/−3
• examples/Refactor/InlineBinding/SimpleMultiMatch.hs +0/−4
• examples/Refactor/InlineBinding/SimpleMultiMatch_res.hs +0/−3
• examples/Refactor/InlineBinding/Simplest.hs +0/−4
• examples/Refactor/InlineBinding/Simplest_res.hs +0/−3
• examples/Refactor/InlineBinding/WithLocals.hs +0/−6
• examples/Refactor/InlineBinding/WithLocals_res.hs +0/−4
• examples/Refactor/OrganizeImports/Class.hs +0/−6
• examples/Refactor/OrganizeImports/Class_res.hs +0/−6
• examples/Refactor/OrganizeImports/Coerce.hs +0/−11
• examples/Refactor/OrganizeImports/Coerce_res.hs +0/−11
• examples/Refactor/OrganizeImports/Ctor.hs +0/−5
• examples/Refactor/OrganizeImports/Ctor_res.hs +0/−5
• examples/Refactor/OrganizeImports/Fields.hs +0/−6
• examples/Refactor/OrganizeImports/Fields_res.hs +0/−6
• examples/Refactor/OrganizeImports/InstanceCarry/DataType.hs +0/−3
• examples/Refactor/OrganizeImports/InstanceCarry/ImportNonOrphan.hs +0/−3
• examples/Refactor/OrganizeImports/InstanceCarry/ImportNonOrphan_res.hs +0/−2
• examples/Refactor/OrganizeImports/InstanceCarry/ImportOrphan.hs +0/−3
• examples/Refactor/OrganizeImports/InstanceCarry/ImportOrphan_res.hs +0/−3
• examples/Refactor/OrganizeImports/InstanceCarry/OrphanInstance.hs +0/−7
• examples/Refactor/OrganizeImports/InstanceCarry/TCWithInst.hs +0/−9
• examples/Refactor/OrganizeImports/InstanceCarry/TypeClass.hs +0/−4
• examples/Refactor/OrganizeImports/KeepCtorOfMarshalled.hs +0/−5
• examples/Refactor/OrganizeImports/KeepCtorOfMarshalled_res.hs +0/−5
• examples/Refactor/OrganizeImports/KeepHiding.hs +0/−6
• examples/Refactor/OrganizeImports/KeepHiding_res.hs +0/−6
• examples/Refactor/OrganizeImports/KeepPrelude.hs +0/−3
• examples/Refactor/OrganizeImports/KeepPrelude_res.hs +0/−3
• examples/Refactor/OrganizeImports/KeepReexported.hs +0/−3
• examples/Refactor/OrganizeImports/KeepReexported_res.hs +0/−3
• examples/Refactor/OrganizeImports/KeepRenamedReexported.hs +0/−4
• examples/Refactor/OrganizeImports/KeepRenamedReexported_res.hs +0/−4
• examples/Refactor/OrganizeImports/MakeExplicit/ClassSource.hs +0/−11
• examples/Refactor/OrganizeImports/MakeExplicit/ConSourceHiddenType.hs +0/−3
• examples/Refactor/OrganizeImports/MakeExplicit/FunSource.hs +0/−3
• examples/Refactor/OrganizeImports/MakeExplicit/ImportClassFun.hs +0/−7
• examples/Refactor/OrganizeImports/MakeExplicit/ImportClassFun_res.hs +0/−7
• examples/Refactor/OrganizeImports/MakeExplicit/ImportCon.hs +0/−5
• examples/Refactor/OrganizeImports/MakeExplicit/ImportCon_res.hs +0/−5
• examples/Refactor/OrganizeImports/MakeExplicit/ImportFour.hs +0/−6
• examples/Refactor/OrganizeImports/MakeExplicit/ImportFour_res.hs +0/−6
• examples/Refactor/OrganizeImports/MakeExplicit/ImportFunHiddenClass.hs +0/−6
• examples/Refactor/OrganizeImports/MakeExplicit/ImportFunHiddenClass_res.hs +0/−6
• examples/Refactor/OrganizeImports/MakeExplicit/ImportFunOutOfClass.hs +0/−6
• examples/Refactor/OrganizeImports/MakeExplicit/ImportFunOutOfClass_res.hs +0/−6
• examples/Refactor/OrganizeImports/MakeExplicit/ImportOne.hs +0/−6
• examples/Refactor/OrganizeImports/MakeExplicit/ImportOne_res.hs +0/−6
• examples/Refactor/OrganizeImports/MakeExplicit/ImportRecordSel.hs +0/−6
• examples/Refactor/OrganizeImports/MakeExplicit/ImportRecordSel_res.hs +0/−6
• examples/Refactor/OrganizeImports/MakeExplicit/ImportThree.hs +0/−6
• examples/Refactor/OrganizeImports/MakeExplicit/ImportThree_res.hs +0/−6
• examples/Refactor/OrganizeImports/MakeExplicit/ImportUnited.hs +0/−7
• examples/Refactor/OrganizeImports/MakeExplicit/ImportUnitedCount.hs +0/−8
• examples/Refactor/OrganizeImports/MakeExplicit/ImportUnitedCount_res.hs +0/−8
• examples/Refactor/OrganizeImports/MakeExplicit/ImportUnited_res.hs +0/−7
• examples/Refactor/OrganizeImports/MakeExplicit/Renamed.hs +0/−5
• examples/Refactor/OrganizeImports/MakeExplicit/Renamed_res.hs +0/−5
• examples/Refactor/OrganizeImports/MakeExplicit/Source.hs +0/−15
• examples/Refactor/OrganizeImports/Narrow.hs +0/−5
• examples/Refactor/OrganizeImports/NarrowQual.hs +0/−6
• examples/Refactor/OrganizeImports/NarrowQual_res.hs +0/−6
• examples/Refactor/OrganizeImports/NarrowSpec.hs +0/−5
• examples/Refactor/OrganizeImports/NarrowSpec_res.hs +0/−5
• examples/Refactor/OrganizeImports/NarrowType.hs +0/−8
• examples/Refactor/OrganizeImports/NarrowType_res.hs +0/−8
• examples/Refactor/OrganizeImports/Narrow_res.hs +0/−5
• examples/Refactor/OrganizeImports/Operator.hs +0/−5
• examples/Refactor/OrganizeImports/Operator_res.hs +0/−5
• examples/Refactor/OrganizeImports/Removed.hs +0/−3
• examples/Refactor/OrganizeImports/Removed_res.hs +0/−2
• examples/Refactor/OrganizeImports/Reorder.hs +0/−7
• examples/Refactor/OrganizeImports/ReorderComment.hs +0/−12
• examples/Refactor/OrganizeImports/ReorderComment_res.hs +0/−12
• examples/Refactor/OrganizeImports/ReorderGroups.hs +0/−12
• examples/Refactor/OrganizeImports/ReorderGroups_res.hs +0/−12
• examples/Refactor/OrganizeImports/Reorder_res.hs +0/−7
• examples/Refactor/OrganizeImports/SameName.hs +0/−6
• examples/Refactor/OrganizeImports/SameName_res.hs +0/−6
• examples/Refactor/OrganizeImports/StandaloneDeriving.hs +0/−6
• examples/Refactor/OrganizeImports/StandaloneDeriving_res.hs +0/−6
• examples/Refactor/OrganizeImports/TemplateHaskell.hs +0/−5
• examples/Refactor/OrganizeImports/TemplateHaskell_res.hs +0/−5
• examples/Refactor/RenameDefinition/AmbiguousFields.hs +0/−11
• examples/Refactor/RenameDefinition/AmbiguousFields_res.hs +0/−11
• examples/Refactor/RenameDefinition/Arg.hs +0/−4
• examples/Refactor/RenameDefinition/Arg_res.hs +0/−4
• examples/Refactor/RenameDefinition/BacktickName.hs +0/−6
• examples/Refactor/RenameDefinition/BacktickName_res.hs too large to diff
• examples/Refactor/RenameDefinition/ClassMember.hs too large to diff
• examples/Refactor/RenameDefinition/ClassMember_res.hs too large to diff
• examples/Refactor/RenameDefinition/ClassTypeVar.hs too large to diff
• examples/Refactor/RenameDefinition/ClassTypeVar_res.hs too large to diff
• examples/Refactor/RenameDefinition/Constructor.hs too large to diff
• examples/Refactor/RenameDefinition/Constructor_res.hs too large to diff
• examples/Refactor/RenameDefinition/CrossRename.hs too large to diff
• examples/Refactor/RenameDefinition/DefineSplices.hs too large to diff
• examples/Refactor/RenameDefinition/FormattingAware.hs too large to diff
• examples/Refactor/RenameDefinition/FormattingAware_res.hs too large to diff
• examples/Refactor/RenameDefinition/FunTypeVar.hs too large to diff
• examples/Refactor/RenameDefinition/FunTypeVarLocal.hs too large to diff
• examples/Refactor/RenameDefinition/FunTypeVarLocal_res.hs too large to diff
• examples/Refactor/RenameDefinition/FunTypeVar_res.hs too large to diff
• examples/Refactor/RenameDefinition/Function.hs too large to diff
• examples/Refactor/RenameDefinition/Function_res.hs too large to diff
• examples/Refactor/RenameDefinition/FunnyDo.hs too large to diff
• examples/Refactor/RenameDefinition/FunnyDo_res.hs too large to diff
• examples/Refactor/RenameDefinition/IllegalQualRename.hs too large to diff
• examples/Refactor/RenameDefinition/LayoutAware.hs too large to diff
• examples/Refactor/RenameDefinition/LayoutAware_res.hs too large to diff
• examples/Refactor/RenameDefinition/LibraryFunction.hs too large to diff
• examples/Refactor/RenameDefinition/LocalFunction.hs too large to diff
• examples/Refactor/RenameDefinition/LocalFunction_res.hs too large to diff
• examples/Refactor/RenameDefinition/MergeFields.hs too large to diff
• examples/Refactor/RenameDefinition/MergeFields_RenameY.hs too large to diff
• examples/Refactor/RenameDefinition/MergeFields_RenameY_res.hs too large to diff
• examples/Refactor/RenameDefinition/MergeFields_res.hs too large to diff
• examples/Refactor/RenameDefinition/MultiModule/A.hs too large to diff
• examples/Refactor/RenameDefinition/MultiModule/B.hs too large to diff
• examples/Refactor/RenameDefinition/MultiModule_res/A.hs too large to diff
• examples/Refactor/RenameDefinition/MultiModule_res/B.hs too large to diff
• examples/Refactor/RenameDefinition/NameClash.hs too large to diff
• examples/Refactor/RenameDefinition/NoPrelude.hs too large to diff
• examples/Refactor/RenameDefinition/NoPrelude_res.hs too large to diff
• examples/Refactor/RenameDefinition/ParenName.hs too large to diff
• examples/Refactor/RenameDefinition/ParenName_res.hs too large to diff
• examples/Refactor/RenameDefinition/QualName.hs too large to diff
• examples/Refactor/RenameDefinition/QualName_res.hs too large to diff
• examples/Refactor/RenameDefinition/RecordField.hs too large to diff
• examples/Refactor/RenameDefinition/RecordField_res.hs too large to diff
• examples/Refactor/RenameDefinition/RecordPatternSynonyms.hs too large to diff
• examples/Refactor/RenameDefinition/RecordPatternSynonyms_res.hs too large to diff
• examples/Refactor/RenameDefinition/RecordWildcards.hs too large to diff
• examples/Refactor/RenameDefinition/RecordWildcards_res.hs too large to diff
• examples/Refactor/RenameDefinition/RenameModule/A.hs too large to diff
• examples/Refactor/RenameDefinition/RenameModule/B.hs too large to diff
• examples/Refactor/RenameDefinition/RenameModuleAlias.hs too large to diff
• examples/Refactor/RenameDefinition/RenameModuleAlias_res.hs too large to diff
• examples/Refactor/RenameDefinition/RenameModule_res/A.hs too large to diff
• examples/Refactor/RenameDefinition/RenameModule_res/C.hs too large to diff
• examples/Refactor/RenameDefinition/RoleAnnotation.hs too large to diff
• examples/Refactor/RenameDefinition/RoleAnnotation_res.hs too large to diff
• examples/Refactor/RenameDefinition/SameCtorAndType.hs too large to diff
• examples/Refactor/RenameDefinition/SameCtorAndType_res.hs too large to diff
• examples/Refactor/RenameDefinition/SpliceDecls/Define.hs too large to diff
• examples/Refactor/RenameDefinition/SpliceDecls/Use.hs too large to diff
• examples/Refactor/RenameDefinition/SpliceDecls_res/Define.hs too large to diff
• examples/Refactor/RenameDefinition/SpliceDecls_res/Use.hs too large to diff
• examples/Refactor/RenameDefinition/SpliceExpr/Define.hs too large to diff
• examples/Refactor/RenameDefinition/SpliceExpr/Use.hs too large to diff
• examples/Refactor/RenameDefinition/SpliceExpr_res/Define.hs too large to diff
• examples/Refactor/RenameDefinition/SpliceExpr_res/Use.hs too large to diff
• examples/Refactor/RenameDefinition/SpliceType/Define.hs too large to diff
• examples/Refactor/RenameDefinition/SpliceType/Use.hs too large to diff
• examples/Refactor/RenameDefinition/SpliceType_res/Define.hs too large to diff
• examples/Refactor/RenameDefinition/SpliceType_res/Use.hs too large to diff
• examples/Refactor/RenameDefinition/Type.hs too large to diff
• examples/Refactor/RenameDefinition/TypeBracket.hs too large to diff
• examples/Refactor/RenameDefinition/TypeBracket_res.hs too large to diff
• examples/Refactor/RenameDefinition/TypeOperators.hs too large to diff
• examples/Refactor/RenameDefinition/TypeOperators_res.hs too large to diff
• examples/Refactor/RenameDefinition/Type_res.hs too large to diff
• examples/Refactor/RenameDefinition/UnusedDef.hs too large to diff
• examples/Refactor/RenameDefinition/UnusedDef_res.hs too large to diff
• examples/Refactor/RenameDefinition/ValBracket.hs too large to diff
• examples/Refactor/RenameDefinition/ValBracket_res.hs too large to diff
• examples/Refactor/RenameDefinition/WrongName.hs too large to diff
• examples/TH/Brackets.hs too large to diff
• examples/TH/CrossDef.hs too large to diff
• examples/TH/DoubleSplice.hs too large to diff
• examples/TH/LocalDefinition.hs too large to diff
• examples/TH/MultiImport.hs too large to diff
• examples/TH/NestedSplices.hs too large to diff
• examples/TH/QuasiQuote/Define.hs too large to diff
• examples/TH/QuasiQuote/Use.hs too large to diff
• examples/TH/Quoted.hs too large to diff
• examples/TH/Splice/Define.hs too large to diff
• examples/TH/Splice/Names.hs too large to diff
• examples/TH/Splice/Use.hs too large to diff
• examples/TH/Splice/UseQual.hs too large to diff
• examples/TH/Splice/UseQualMulti.hs too large to diff
• examples/TH/WithWildcards.hs too large to diff
• examples/Type/Bang.hs too large to diff
• examples/Type/Builtin.hs too large to diff
• examples/Type/Ctx.hs too large to diff
• examples/Type/ExplicitTypeApplication.hs too large to diff
• examples/Type/Forall.hs too large to diff
• examples/Type/Primitives.hs too large to diff
• examples/Type/TupleAssert.hs too large to diff
• examples/Type/TypeOperators.hs too large to diff
• examples/Type/Unpack.hs too large to diff
• examples/Type/Wildcard.hs too large to diff
• haskell-tools-refactor.cabal too large to diff
• test/Main.hs too large to diff

@@ -1,17 +1,21 @@ -- | Defines the API for refactorings
 module Language.Haskell.Tools.Refactor
     ( module Language.Haskell.Tools.AST.SemaInfoClasses
-    , module Language.Haskell.Tools.AST.Rewrite
+    , module Language.Haskell.Tools.Rewrite
     , module Language.Haskell.Tools.AST.References
     , module Language.Haskell.Tools.AST.Helpers
-    , module Language.Haskell.Tools.Refactor.RefactorBase
-  , module Language.Haskell.Tools.Refactor.Helpers
-    , module Language.Haskell.Tools.AST.ElementTypes
+    , module Language.Haskell.Tools.Refactor.Utils.Monadic
+  , module Language.Haskell.Tools.Refactor.Utils.Helpers
+    , module Language.Haskell.Tools.Rewrite.ElementTypes
     , module Language.Haskell.Tools.Refactor.Prepare
-    , module Language.Haskell.Tools.Refactor.ListOperations
-    , module Language.Haskell.Tools.Refactor.BindingElem
-    , module Language.Haskell.Tools.IndentationUtils
-  , Ann, HasSourceInfo(..), HasRange(..), annListElems, annListAnnot, annList, annJust, annMaybe, isAnnNothing, Domain
+    , module Language.Haskell.Tools.Refactor.Utils.Lists
+    , module Language.Haskell.Tools.Refactor.Utils.BindingElem
+    , module Language.Haskell.Tools.Refactor.Utils.Indentation
+    , module Language.Haskell.Tools.Refactor.Refactoring
+    , module Language.Haskell.Tools.Refactor.Utils.Name
+    , module Language.Haskell.Tools.Refactor.Representation
+    , module Language.Haskell.Tools.Refactor.Monad
+  , Ann, HasSourceInfo(..), HasRange(..), annListElems, annListAnnot, annList, annJust, annMaybe, isAnnNothing, Domain, Dom, IdDom
     , shortShowSpan, SrcTemplateStage, SourceInfoTraversal(..)
     -- elements of source templates
     , sourceTemplateNodeRange, sourceTemplateNodeElems
@@ -22,17 +26,21 @@ 
 -- Important: Haddock doesn't support the rename all exported modules and export them at once hack
 
-import Language.Haskell.Tools.AST.ElementTypes
 import Language.Haskell.Tools.AST.Helpers
 import Language.Haskell.Tools.AST.References
-import Language.Haskell.Tools.AST.Rewrite
 import Language.Haskell.Tools.AST.SemaInfoClasses
-import Language.Haskell.Tools.IndentationUtils
-import Language.Haskell.Tools.Refactor.BindingElem
-import Language.Haskell.Tools.Refactor.Helpers
-import Language.Haskell.Tools.Refactor.ListOperations
+import Language.Haskell.Tools.PrettyPrint.Prepare
+import Language.Haskell.Tools.Refactor.Utils.BindingElem
+import Language.Haskell.Tools.Refactor.Utils.Helpers
+import Language.Haskell.Tools.Refactor.Monad
 import Language.Haskell.Tools.Refactor.Prepare
-import Language.Haskell.Tools.Refactor.RefactorBase
-import Language.Haskell.Tools.Transform
+import Language.Haskell.Tools.Refactor.Refactoring
+import Language.Haskell.Tools.Refactor.Representation
+import Language.Haskell.Tools.Refactor.Utils.Indentation
+import Language.Haskell.Tools.Refactor.Utils.Lists
+import Language.Haskell.Tools.Refactor.Utils.Monadic
+import Language.Haskell.Tools.Refactor.Utils.Name
+import Language.Haskell.Tools.Rewrite
+import Language.Haskell.Tools.Rewrite.ElementTypes
 
 import Language.Haskell.Tools.AST.Ann

@@ -1,77 +0,0 @@-{-# LANGUAGE FlexibleContexts
-           , TypeFamilies
-           #-}
--- | Utilities for transformations that work on both top-level and local definitions
-module Language.Haskell.Tools.Refactor.BindingElem where
-
-import Control.Reference
-import Language.Haskell.Tools.AST
-import Language.Haskell.Tools.AST.Rewrite
-import SrcLoc (RealSrcSpan)
-
--- | A type class for handling definitions that can appear as both top-level and local definitions
-class NamedElement d => BindingElem d where
-
-  -- | Accesses a type signature definition in a local or top-level definition
-  sigBind :: Simple Partial (Ann d dom SrcTemplateStage) (TypeSignature dom)
-
-  -- | Accesses a value or function definition in a local or top-level definition
-  valBind :: Simple Partial (Ann d dom SrcTemplateStage) (ValueBind dom)
-
-  -- | Accesses a type signature definition in a local or top-level definition
-  fixitySig :: Simple Partial (Ann d dom SrcTemplateStage) (FixitySignature dom)
-
-  -- | Creates a new definition from a type signature
-  createTypeSig :: TypeSignature dom -> Ann d dom SrcTemplateStage
-
-  -- | Creates a new definition from a value or function definition
-  createBinding :: ValueBind dom -> Ann d dom SrcTemplateStage
-
-  -- | Creates a new fixity signature
-  createFixitySig :: FixitySignature dom -> Ann d dom SrcTemplateStage
-
-  -- | Checks if a given definition is a type signature
-  isTypeSig :: Ann d dom SrcTemplateStage -> Bool
-  
-  -- | Checks if a given definition is a function or value binding
-  isBinding :: Ann d dom SrcTemplateStage -> Bool
-
-  -- | Checks if a given definition is a fixity signature
-  isFixitySig :: Ann d dom SrcTemplateStage -> Bool
-  
-instance BindingElem UDecl where
-  sigBind = declTypeSig
-  valBind = declValBind
-  fixitySig = declFixity
-  createTypeSig = mkTypeSigDecl
-  createBinding = mkValueBinding
-  createFixitySig = mkFixityDecl
-  isTypeSig TypeSigDecl {} = True
-  isTypeSig _ = False
-  isBinding ValueBinding {} = True
-  isBinding _ = False
-  isFixitySig FixityDecl {} = True
-  isFixitySig _ = False
-
-instance BindingElem ULocalBind where
-  sigBind = localSig
-  valBind = localVal
-  fixitySig = localFixity
-  createTypeSig = mkLocalTypeSig
-  createBinding = mkLocalValBind
-  createFixitySig = mkLocalFixity
-  isTypeSig LocalTypeSig {} = True
-  isTypeSig _ = False
-  isBinding LocalValBind {} = True
-  isBinding _ = False
-  isFixitySig LocalFixity {} = True
-  isFixitySig _ = False
-     
-getValBindInList :: (BindingElem d) => RealSrcSpan -> AnnListG d dom SrcTemplateStage -> Maybe (ValueBind dom)
-getValBindInList sp ls = case ls ^? valBindsInList & filtered (isInside sp) of
-  [] -> Nothing
-  [n] -> Just n
-  _ -> error "getValBindInList: Multiple nodes"
-
-valBindsInList :: BindingElem d => Simple Traversal (AnnListG d dom SrcTemplateStage) (ValueBind dom)
-valBindsInList = annList & valBind

@@ -1,41 +0,0 @@-{-# LANGUAGE LambdaCase, TupleSections, AllowAmbiguousTypes #-}
--- | Operations for changing the AST
-module Language.Haskell.Tools.Refactor.ChangeAST (removeChild, removeSeparator) where
-
-import Control.Reference
-import Control.Monad.State
-import Control.Monad.Writer
-import Data.List
-import Data.Maybe
-import Language.Haskell.Tools.AST
-import Language.Haskell.Tools.Transform
-import Language.Haskell.Tools.Refactor.RefactorBase
-import SrcLoc
-
-import Debug.Trace
-import Data.Either
-
--- | Remove a separator from the AST while keeping the textual parts of it that should not be removed (like preprocessor pragmas).
-removeSeparator :: ([SourceTemplateTextElem], SrcSpan) -> LocalRefactor dom ()
-removeSeparator (txts, range) = tell [Right (range, intercalate lineEnd staying, lineEnd)]
-  where staying = catMaybes $ map (\case StayingText str _ -> Just str; _ -> Nothing) txts
-        lineEnd = head $ (catMaybes $ map (\case StayingText _ lnEnd -> Just lnEnd; _ -> Nothing) txts) ++ [""]
-
--- | Remove an element from the AST while keeping the textual parts of it that should not be removed (like preprocessor pragmas).
-removeChild :: (SourceInfoTraversal e) => e dom SrcTemplateStage -> LocalRefactor dom ()
-removeChild e = tell $ map Right $ keptText e
-
--- | Extracts all text elements that should be kept
-keptText :: SourceInfoTraversal e => e dom SrcTemplateStage -> [(SrcSpan,String,String)]
-keptText = execWriter . sourceInfoTraverse (SourceInfoTrf
-  (\ni -> mapM_ writeStaying (mapMaybe (\case (TextElem elems range) -> Just (elems,range)
-                                              _ -> Nothing)
-                                       (ni ^? sourceTemplateNodeElems & traversal)) >> return ni)
-  (\ni -> mapM_ writeStaying (ni ^. srcTmpSeparators) >> return ni)
-  pure)
-
--- | Writes the elements to be kept into a writer monad with ranges and default line ending.
-writeStaying :: ([SourceTemplateTextElem], SrcSpan) -> Writer [(SrcSpan,String,String)] ()
-writeStaying (txts, range) = tell staying
-  where staying = mapMaybe (\case StayingText str lnEnd -> Just (range, str, lnEnd)
-                                  _ -> Nothing) txts

@@ -1,507 +0,0 @@-{-# LANGUAGE TupleSections
-           , NamedFieldPuns
-           , LambdaCase
-           , TemplateHaskell
-           , FlexibleContexts
-           , TypeApplications
-           , RankNTypes
-           #-}
--- | Representation and operations for module collections (libraries, executables, ...) in the framework.
-module Language.Haskell.Tools.Refactor.GetModules where
-
-import Control.Monad
-import Control.Reference
-import Data.Function (on)
-import Data.List
-import qualified Data.Map as Map
-import Data.Char
-import Data.Maybe
-import Distribution.Compiler
-import Distribution.ModuleName
-import Distribution.Package (Dependency(..), PackageName(..), pkgName)
-import Distribution.PackageDescription
-import Distribution.PackageDescription.Configuration
-import Distribution.PackageDescription.Parse
-import Distribution.System
-import Distribution.Verbosity (silent)
-import Language.Haskell.Extension as Cabal
-import System.Directory
-import System.FilePath
-
-import DynFlags
-import Module (stringToUnitId)
-import qualified DynFlags as GHC
-import GHC hiding (ModuleName)
-import qualified Language.Haskell.TH.LanguageExtensions as GHC
-import Name as GHC (Name)
-import RdrName as GHC (RdrName)
-
-import Language.Haskell.Tools.AST (Dom, IdDom)
-import Language.Haskell.Tools.Refactor.RefactorBase
-
-import Debug.Trace
-
-instance Eq ModuleCollection where
-  (==) = (==) `on` _mcId
-
-instance Show ModuleCollection where
-  show (ModuleCollection id root srcDirs mods _ _ deps)
-    = "ModuleCollection (" ++ show id ++ ") " ++ root ++ " " ++ show srcDirs ++ " (" ++ show mods ++ ") " ++ show deps
-
-containingMC :: FilePath -> Simple Traversal [ModuleCollection] ModuleCollection
-containingMC fp = traversal & filtered (\mc -> _mcRoot mc `isPrefixOf` fp)
-
-
-moduleCollectionIdString :: ModuleCollectionId -> String
-moduleCollectionIdString (DirectoryMC fp) = fp
-moduleCollectionIdString (LibraryMC id) = id
-moduleCollectionIdString (ExecutableMC _ id) = id
-moduleCollectionIdString (TestSuiteMC _ id) = id
-moduleCollectionIdString (BenchmarkMC _ id) = id
-
-moduleCollectionPkgId :: ModuleCollectionId -> Maybe String
-moduleCollectionPkgId (DirectoryMC _) = Nothing
-moduleCollectionPkgId (LibraryMC id) = Just id
-moduleCollectionPkgId (ExecutableMC id _) = Just id
-moduleCollectionPkgId (TestSuiteMC id _) = Just id
-moduleCollectionPkgId (BenchmarkMC id _) = Just id
-
-instance Show ModuleRecord where
-  show (ModuleNotLoaded code exposed) = "ModuleNotLoaded " ++ show code ++ " " ++ show exposed
-  show mr@(ModuleParsed {}) = "ModuleParsed (" ++ (GHC.moduleNameString $ GHC.moduleName $ GHC.ms_mod $ fromJust $ mr ^? modRecMS) ++ ")"
-  show mr@(ModuleRenamed {}) = "ModuleRenamed (" ++ (GHC.moduleNameString $ GHC.moduleName $ GHC.ms_mod $ fromJust $ mr ^? modRecMS) ++ ")"
-  show mr@(ModuleTypeChecked {}) = "ModuleTypeChecked (" ++ (GHC.moduleNameString $ GHC.moduleName $ GHC.ms_mod $ fromJust $ mr ^? modRecMS) ++ ")"
-  show mr@(ModuleCodeGenerated {}) = "ModuleCodeGenerated (" ++ (GHC.moduleNameString $ GHC.moduleName $ GHC.ms_mod $ fromJust $ mr ^? modRecMS) ++ ")"
-
-modRecLoaded :: ModuleRecord -> Bool
-modRecLoaded ModuleTypeChecked{} = True
-modRecLoaded ModuleCodeGenerated{} = True
-modRecLoaded _ = False
-
--- | Find the module collection where the given module is.
-lookupModuleColl :: String -> [ModuleCollection] -> Maybe (ModuleCollection)
-lookupModuleColl moduleName = find (any ((moduleName ==) . (^. sfkModuleName)) . Map.keys . (^. mcModules))
-
-lookupSourceFileColl :: FilePath -> [ModuleCollection] -> Maybe (ModuleCollection)
-lookupSourceFileColl fp = find (any ((fp ==) . (^. sfkFileName)) . Map.keys . (^. mcModules))
-
-lookupModInSCs :: SourceFileKey -> [ModuleCollection] -> Maybe (SourceFileKey, ModuleRecord)
-lookupModInSCs moduleName = find (((moduleName ^. sfkFileName) ==) . (^. sfkFileName) . fst) . concatMap (Map.assocs . (^. mcModules))
-
-lookupSourceFileInSCs :: String -> [ModuleCollection] -> Maybe (SourceFileKey, ModuleRecord)
-lookupSourceFileInSCs fileName = find ((fileName ==) . (^. sfkFileName) . fst) . concatMap (Map.assocs . (^. mcModules))
-
-lookupModuleInSCs :: String -> [ModuleCollection] -> Maybe (SourceFileKey, ModuleRecord)
-lookupModuleInSCs moduleName = find ((moduleName ==) . (^. sfkModuleName) . fst) . concatMap (Map.assocs . (^. mcModules))
-
-
-removeModule :: String -> [ModuleCollection] -> [ModuleCollection]
-removeModule moduleName = map (mcModules .- Map.filterWithKey (\k _ -> moduleName /= (k ^. sfkModuleName)))
-
-hasGeneratedCode :: SourceFileKey -> [ModuleCollection] -> Bool
-hasGeneratedCode key = maybe False ((\case ModuleCodeGenerated {} -> True; _ -> False) . snd)
-                         . lookupModInSCs key
-
-needsGeneratedCode :: SourceFileKey -> [ModuleCollection] -> Bool
-needsGeneratedCode key = maybe False ((\case ModuleCodeGenerated {} -> True; ModuleNotLoaded True _ -> True; _ -> False) . snd)
-                           . lookupModInSCs key
-
-codeGeneratedFor :: SourceFileKey -> [ModuleCollection] -> [ModuleCollection]
-codeGeneratedFor key = map (mcModules .- Map.adjust (\case (ModuleTypeChecked mod ms) -> ModuleCodeGenerated mod ms
-                                                           ModuleNotLoaded _ exp -> ModuleNotLoaded True exp
-                                                           r -> r) key)
-
-isAlreadyLoaded :: SourceFileKey -> [ModuleCollection] -> Bool
-isAlreadyLoaded key = maybe False (\case (_, ModuleNotLoaded {}) -> False; _ -> True)
-                         . find ((key ==) . fst) . concatMap (Map.assocs . (^. mcModules))
-
--- | Gets all ModuleCollections from a list of source directories. It also orders the source directories that are package roots so that
--- they can be loaded in the order they are defined (no backward imports). This matters in those cases because for them there can be
--- special compilation flags.
-getAllModules :: [FilePath] -> IO [ModuleCollection]
-getAllModules pathes = orderMCs . concat <$> mapM (getModules pathes) (map normalise pathes)
-
--- | Sorts model collection in an order to remove all backward references.
--- Works because module collections defined by directories cannot be recursive.
-orderMCs :: [ModuleCollection] -> [ModuleCollection]
-orderMCs = sortBy compareMCs
-  where compareMCs :: ModuleCollection -> ModuleCollection -> Ordering
-        compareMCs mc _ | DirectoryMC _ <- (mc ^. mcId) = GT
-        compareMCs _ mc | DirectoryMC _ <- (mc ^. mcId) = LT
-        compareMCs mc1 mc2 | (mc2 ^. mcId) `elem` (mc1 ^. mcDependencies) = GT
-        compareMCs mc1 mc2 | (mc1 ^. mcId) `elem` (mc2 ^. mcDependencies) = LT
-        compareMCs _ _ = EQ
-
-
--- | Get modules of the project with the indicated root directory.
--- If there is a cabal file, it uses that, otherwise it just scans the directory recursively for haskell sourcefiles.
--- Only returns the non-boot haskell modules, the boot modules will be found during loading.
-getModules :: [FilePath] -> FilePath -> IO [ModuleCollection]
-getModules allRoots root
-  = do files <- listDirectory root
-       case find (\p -> takeExtension p == ".cabal") files of
-          Just cabalFile -> modulesFromCabalFile allRoots root cabalFile
-          Nothing        -> do mods <- modulesFromDirectory root root
-                               return [ModuleCollection (DirectoryMC root) root [root] (modKeys mods) return return []]
-  where modKeys mods = Map.fromList $ map (\m -> (SourceFileKey (root </> moduleSourceFile m) m, ModuleNotLoaded False True)) mods
-
--- | Load the module giving a directory. All modules loaded from the folder and subfolders.
-modulesFromDirectory :: FilePath -> FilePath -> IO [String]
--- now recognizing only .hs files
-modulesFromDirectory root searchRoot = concat <$> (mapM goOn =<< listDirectory searchRoot)
-  where goOn fp = let path = searchRoot </> fp
-                   in do isDir <- doesDirectoryExist path
-                         if isDir
-                           then modulesFromDirectory root path
-                           else if takeExtension path == ".hs"
-                                  then return [concat $ intersperse "." $ splitDirectories $ dropExtension $ makeRelative root path]
-                                  else return []
-
-srcDirFromRoot :: FilePath -> String -> FilePath
-srcDirFromRoot fileName "" = fileName
-srcDirFromRoot fileName moduleName
-  = srcDirFromRoot (takeDirectory fileName) (dropWhile (/= '.') $ dropWhile (== '.') moduleName)
-
--- | Load the module using a cabal file. The modules described in the cabal file will be loaded.
--- The flags and extensions set in the cabal file will be used by default.
-modulesFromCabalFile :: [FilePath] -> FilePath -> FilePath -> IO [ModuleCollection]
--- now adding all conditional entries, regardless of flags
-modulesFromCabalFile allRoots root cabal = (getModules . setupFlags <$> readPackageDescription silent (root </> cabal)) >>= filterModules
-  where filterModules :: [ModuleCollection] -> IO [ModuleCollection]
-        filterModules = traversal & mcModules !~ filterKeys
-          where filterKeys :: Show v => Map.Map SourceFileKey v -> IO (Map.Map SourceFileKey v)
-                filterKeys = (Map.fromList . concat . map snd
-                               . map (\ls -> if null (snd ls) then error ("No source file found for module: " ++ (fst ls)) else ls) <$>)
-                                 . mapM (\(mn,ls) -> (mn,) <$> filterM (doesFileExist . (^. sfkFileName) . fst) ls)
-                                 . map (\ls -> ((fst $ head ls) ^. sfkModuleName, ls))
-                                 . groupBy ((==) `on` (^. sfkModuleName) . fst)
-                                 . sortBy (compare `on` (^. sfkModuleName) . fst) . Map.assocs
-
-        getModules pkg = maybe [] (maybe [] (:[]) . toModuleCollection pkg) (library pkg)
-                           ++ catMaybes (map (toModuleCollection pkg) (executables pkg))
-                           ++ catMaybes (map (toModuleCollection pkg) (testSuites pkg))
-                           ++ catMaybes (map (toModuleCollection pkg) (benchmarks pkg))
-
-        toModuleCollection :: ToModuleCollection tmc => PackageDescription -> tmc -> Maybe ModuleCollection
-        toModuleCollection PackageDescription{ buildType = Just Custom } tmc
-          = error "While parsing cabal file \"build-type: custom\" is not supported"
-        toModuleCollection pkg tmc
-          = let bi = getBuildInfo tmc
-                packageName = pkgName $ package pkg
-             in if buildable bi
-                  then Just $ ModuleCollection (mkModuleCollKey packageName tmc)
-                                root
-                                (map (normalise . (root </>)) $ hsSourceDirs bi)
-                                (Map.fromList $ concatMap (modRecord (hsSourceDirs bi) allRoots) $ getModuleNames tmc)
-                                (flagsFromBuildInfo bi)
-                                (loadFlagsFromBuildInfo bi)
-                                (map (\(Dependency pkgName _) -> LibraryMC (unPackageName pkgName)) (targetBuildDepends bi))
-                  else Nothing
-          where modRecord srcs allRoots mn = map (\d -> ( SourceFileKey (getPath d mn) (moduleName mn)
-                                                        , ModuleNotLoaded False (needsToCompile tmc mn) )) srcs
-                                               ++ map (\d -> ( SourceFileKey (getOtherRootPath d mn) (moduleName mn)
-                                                             , ModuleNotLoaded False (needsToCompile tmc mn) )) allRoots
-                getPath d mn = case lookup mn (getModuleSourceFiles tmc) of
-                                 Just fp -> normalise (root </> d </> fp)
-                                 Nothing -> normalise (root </> d </> (moduleSourceFile $ moduleName mn))
-                getOtherRootPath d mn = case lookup mn (getModuleSourceFiles tmc) of
-                     Just fp -> normalise (d </> fp)
-                     Nothing -> normalise (d </> (moduleSourceFile $ moduleName mn))
-        moduleName = concat . intersperse "." . components
-        setupFlags = either (\deps -> error $ "Missing dependencies: " ++ show deps) fst
-                       . finalizePackageDescription [] (const True) buildPlatform
-                                                    (unknownCompilerInfo buildCompilerId NoAbiTag) []
-
-class ToModuleCollection t where
-  mkModuleCollKey :: PackageName -> t -> ModuleCollectionId
-  getBuildInfo :: t -> BuildInfo
-  getModuleNames :: t -> [ModuleName]
-  getModuleSourceFiles :: t -> [(ModuleName, FilePath)]
-  getModuleSourceFiles _ = []
-  needsToCompile :: t -> ModuleName -> Bool
-
-instance ToModuleCollection Library where
-  mkModuleCollKey pn _ = LibraryMC (unPackageName pn)
-  getBuildInfo = libBuildInfo
-  getModuleNames = libModules
-  needsToCompile l m = m `elem` exposedModules l
-
-instance ToModuleCollection Executable where
-  mkModuleCollKey pn exe = ExecutableMC (unPackageName pn) (exeName exe)
-  getBuildInfo = buildInfo
-  getModuleNames exe = fromString (getMain (buildInfo exe)) : exeModules exe
-  needsToCompile exe mn = components mn == [getMain (buildInfo exe)]
-  getModuleSourceFiles exe = [(fromString (getMain (buildInfo exe)), modulePath exe)]
-
-instance ToModuleCollection TestSuite where
-  mkModuleCollKey pn test = TestSuiteMC (unPackageName pn) (testName test)
-  getBuildInfo = testBuildInfo
-  getModuleNames exe = fromString (getMain (testBuildInfo exe)) : testModules exe
-  needsToCompile exe mn = components mn == [getMain (testBuildInfo exe)]
-  getModuleSourceFiles exe
-    = case testInterface exe of
-        TestSuiteExeV10 _ fp -> [(fromString (getMain (testBuildInfo exe)), fp)]
-        _ -> []
-
-instance ToModuleCollection Benchmark where
-  mkModuleCollKey pn test = BenchmarkMC (unPackageName pn) (benchmarkName test)
-  getBuildInfo = benchmarkBuildInfo
-  getModuleNames exe = fromString (getMain (benchmarkBuildInfo exe)) : benchmarkModules exe
-  needsToCompile exe mn = components mn == [getMain (benchmarkBuildInfo exe)]
-  getModuleSourceFiles exe
-    = case benchmarkInterface exe of
-        BenchmarkExeV10 _ fp -> [(fromString (getMain (benchmarkBuildInfo exe)), fp)]
-        _ -> []
-
-getMain :: BuildInfo -> String
-getMain bi
-  = case ls of _:e:_ -> intercalate "." $ filter (isUpper . head) $ groupBy ((==) `on` (== '.')) e
-               _ -> "Main"
-  where ls = dropWhile (/= "-main-is") (concatMap snd (options bi))
-
-isDirectoryMC :: ModuleCollection -> Bool
-isDirectoryMC mc = case mc ^. mcId of DirectoryMC{} -> True; _ -> False
-
-compileInContext :: ModuleCollection -> [ModuleCollection] -> DynFlags -> IO DynFlags
-compileInContext mc mcs dfs
-  = (\dfs' -> applyDependencies mcs (mc ^. mcDependencies) (selectEnabled dfs'))
-       <$> (mc ^. mcFlagSetup $ dfs)
-  where selectEnabled = if isDirectoryMC mc then id else onlyUseEnabled
-
-applyDependencies :: [ModuleCollection] -> [ModuleCollectionId] -> DynFlags -> DynFlags
-applyDependencies mcs ids dfs
-  = dfs { GHC.packageFlags = GHC.packageFlags dfs ++ (catMaybes $ map (dependencyToPkgFlag mcs) ids) }
-
-onlyUseEnabled :: DynFlags -> DynFlags
-onlyUseEnabled = GHC.setGeneralFlag' GHC.Opt_HideAllPackages
-
-dependencyToPkgFlag :: [ModuleCollection] -> ModuleCollectionId -> Maybe (GHC.PackageFlag)
-dependencyToPkgFlag mcs lib@(LibraryMC pkgName)
-  = if isNothing $ find (\mc -> (mc ^. mcId) == lib) mcs
-      then Just $ GHC.ExposePackage pkgName (GHC.PackageArg pkgName) (GHC.ModRenaming True [])
-      else Nothing
-dependencyToPkgFlag _ _ = Nothing
-
-setupLoadFlags :: [ModuleCollection] -> DynFlags -> IO DynFlags
-setupLoadFlags mcs dfs = applyDependencies mcs allDeps . selectEnabled <$> useSavedFlags dfs
-  where allDeps = mcs ^? traversal & mcDependencies & traversal
-        selectEnabled = if any (\(mc,rest) -> isDirectoryMC mc && isIndependentMc mc rest) (breaks mcs) then id else onlyUseEnabled
-        useSavedFlags = foldl @[] (>=>) return (mcs ^? traversal & mcLoadFlagSetup)
-        isIndependentMc mc rest = not $ any (`isPrefixOf` (mc ^. mcRoot)) (map (^. mcRoot) rest)
-
-breaks :: [a] -> [(a,[a])]
-breaks [] = []
-breaks (e:rest) = (e,rest) : map (\(x,ls) -> (x,e:ls)) (breaks rest)
-
-loadFlagsFromBuildInfo :: BuildInfo -> DynFlags -> IO DynFlags
-loadFlagsFromBuildInfo bi@BuildInfo{ cppOptions } df
-  = do (df',unused,warnings) <- parseDynamicFlags df (map (L noSrcSpan) $ cppOptions)
-       mapM_ putStrLn (map unLoc warnings ++ map (("Flag is not used: " ++) . unLoc) unused)
-       return (setupLoadExtensions df')
-  where setupLoadExtensions = foldl (.) id (map setExtensionFlag' $ catMaybes $ map translateExtension loadExtensions)
-        loadExtensions = [PatternSynonyms | patternSynonymsNeeded] ++ [ExplicitNamespaces | explicitNamespacesNeeded]
-                           ++ [PackageImports | packageImportsNeeded] ++ [CPP | cppNeeded] ++ [MagicHash | magicHashNeeded]
-        explicitNamespacesNeeded = not $ null $ map EnableExtension [ExplicitNamespaces, TypeFamilies, TypeOperators] `intersect` usedExtensions bi
-        patternSynonymsNeeded = EnableExtension PatternSynonyms `elem` usedExtensions bi
-        packageImportsNeeded = EnableExtension PackageImports `elem` usedExtensions bi
-        cppNeeded = EnableExtension CPP `elem` usedExtensions bi
-        magicHashNeeded = EnableExtension MagicHash `elem` usedExtensions bi
-
-flagsFromBuildInfo :: BuildInfo -> DynFlags -> IO DynFlags
--- the import pathes are already set globally
-flagsFromBuildInfo bi@BuildInfo{ options } df
-  = do (df',unused,warnings) <- parseDynamicFlags df (map (L noSrcSpan) $ concatMap snd options)
-       mapM_ putStrLn (map unLoc warnings ++ map (("Flag is not used: " ++) . unLoc) unused)
-       return $ (flip lang_set (toGhcLang =<< defaultLanguage bi))
-         $ foldl (.) id (map (\case EnableExtension ext -> setEnabled True ext
-                                    DisableExtension ext -> setEnabled False ext
-                        ) (usedExtensions bi))
-         $ foldr (.) id (map (setEnabled True) (languageDefault (defaultLanguage bi)))
-         $ df'
-  where toGhcLang Cabal.Haskell98 = Just GHC.Haskell98
-        toGhcLang Cabal.Haskell2010 = Just GHC.Haskell2010
-        toGhcLang _ = Nothing
-
-        -- We don't put the default settings (ImplicitPrelude, MonomorphismRestriction) here
-        -- because that overrides the opposite extensions (NoImplicitPrelude, NoMonomorphismRestriction)
-        -- enabled in modules.
-        languageDefault (Just Cabal.Haskell2010)
-          = [ DatatypeContexts, DoAndIfThenElse, EmptyDataDecls, ForeignFunctionInterface
-            , PatternGuards, RelaxedPolyRec, TraditionalRecordSyntax ]
-        -- Haskell 98 is the default
-        languageDefault _
-          = [ DatatypeContexts, NondecreasingIndentation, NPlusKPatterns, TraditionalRecordSyntax ]
-
-        setEnabled enable ext
-          = case translateExtension ext of
-              Just e -> (if enable then setExtensionFlag' else unSetExtensionFlag') e
-              Nothing -> id
-
--- * Not imported from DynFlags.hs, so I copied it here
-setExtensionFlag', unSetExtensionFlag' :: GHC.Extension -> DynFlags -> DynFlags
-setExtensionFlag' f dflags = foldr ($) (xopt_set dflags f) deps
-  where
-    deps = [ if turn_on then setExtensionFlag'   d
-                        else unSetExtensionFlag' d
-           | (f', turn_on, d) <- impliedXFlags, f' == f ]
-unSetExtensionFlag' f dflags = xopt_unset dflags f
-
-turnOn = True
-turnOff = False
-
-impliedXFlags :: [(GHC.Extension, Bool, GHC.Extension)]
-impliedXFlags
-  = [ (GHC.RankNTypes,                turnOn, GHC.ExplicitForAll)
-    , (GHC.ScopedTypeVariables,       turnOn, GHC.ExplicitForAll)
-    , (GHC.LiberalTypeSynonyms,       turnOn, GHC.ExplicitForAll)
-    , (GHC.ExistentialQuantification, turnOn, GHC.ExplicitForAll)
-    , (GHC.FlexibleInstances,         turnOn, GHC.TypeSynonymInstances)
-    , (GHC.FunctionalDependencies,    turnOn, GHC.MultiParamTypeClasses)
-    , (GHC.MultiParamTypeClasses,     turnOn, GHC.ConstrainedClassMethods)
-    , (GHC.TypeFamilyDependencies,    turnOn, GHC.TypeFamilies)
-    , (GHC.RebindableSyntax, turnOff, GHC.ImplicitPrelude)
-    , (GHC.GADTs,            turnOn, GHC.GADTSyntax)
-    , (GHC.GADTs,            turnOn, GHC.MonoLocalBinds)
-    , (GHC.TypeFamilies,     turnOn, GHC.MonoLocalBinds)
-    , (GHC.TypeFamilies,     turnOn, GHC.KindSignatures)
-    , (GHC.PolyKinds,        turnOn, GHC.KindSignatures)
-    , (GHC.TypeInType,       turnOn, GHC.DataKinds)
-    , (GHC.TypeInType,       turnOn, GHC.PolyKinds)
-    , (GHC.TypeInType,       turnOn, GHC.KindSignatures)
-    , (GHC.AutoDeriveTypeable, turnOn, GHC.DeriveDataTypeable)
-    , (GHC.TypeFamilies,     turnOn, GHC.ExplicitNamespaces)
-    , (GHC.TypeOperators, turnOn, GHC.ExplicitNamespaces)
-    , (GHC.ImpredicativeTypes,  turnOn, GHC.RankNTypes)
-    , (GHC.RecordWildCards,     turnOn, GHC.DisambiguateRecordFields)
-    , (GHC.ParallelArrays, turnOn, GHC.ParallelListComp)
-    , (GHC.JavaScriptFFI, turnOn, GHC.InterruptibleFFI)
-    , (GHC.DeriveTraversable, turnOn, GHC.DeriveFunctor)
-    , (GHC.DeriveTraversable, turnOn, GHC.DeriveFoldable)
-    , (GHC.DuplicateRecordFields, turnOn, GHC.DisambiguateRecordFields)
-    , (GHC.TemplateHaskell, turnOn, GHC.TemplateHaskellQuotes)
-    , (GHC.Strict, turnOn, GHC.StrictData)
-  ]
-
--- * Mapping of Cabal haskell extensions to their GHC counterpart
-
--- | Map the cabal extensions to the ones that GHC recognizes
-translateExtension AllowAmbiguousTypes = Just GHC.AllowAmbiguousTypes
-translateExtension ApplicativeDo = Just GHC.ApplicativeDo
-translateExtension Arrows = Just GHC.Arrows
-translateExtension AutoDeriveTypeable = Just GHC.AutoDeriveTypeable
-translateExtension BangPatterns = Just GHC.BangPatterns
-translateExtension BinaryLiterals = Just GHC.BinaryLiterals
-translateExtension CApiFFI = Just GHC.CApiFFI
-translateExtension ConstrainedClassMethods = Just GHC.ConstrainedClassMethods
-translateExtension ConstraintKinds = Just GHC.ConstraintKinds
-translateExtension CPP = Just GHC.Cpp
-translateExtension DataKinds = Just GHC.DataKinds
-translateExtension DatatypeContexts = Just GHC.DatatypeContexts
-translateExtension DefaultSignatures = Just GHC.DefaultSignatures
-translateExtension DeriveAnyClass = Just GHC.DeriveAnyClass
-translateExtension DeriveDataTypeable = Just GHC.DeriveDataTypeable
-translateExtension DeriveFoldable = Just GHC.DeriveFoldable
-translateExtension DeriveFunctor = Just GHC.DeriveFunctor
-translateExtension DeriveGeneric = Just GHC.DeriveGeneric
-translateExtension DeriveLift = Just GHC.DeriveLift
-translateExtension DeriveTraversable = Just GHC.DeriveTraversable
-translateExtension DisambiguateRecordFields = Just GHC.DisambiguateRecordFields
-translateExtension DoAndIfThenElse = Just GHC.DoAndIfThenElse
-translateExtension DoRec = Just GHC.RecursiveDo
-translateExtension DuplicateRecordFields = Just GHC.DuplicateRecordFields
-translateExtension EmptyCase = Just GHC.EmptyCase
-translateExtension EmptyDataDecls = Just GHC.EmptyDataDecls
-translateExtension ExistentialQuantification = Just GHC.ExistentialQuantification
-translateExtension ExplicitForAll = Just GHC.ExplicitForAll
-translateExtension ExplicitNamespaces = Just GHC.ExplicitNamespaces
-translateExtension ExtendedDefaultRules = Just GHC.ExtendedDefaultRules
-translateExtension FlexibleContexts = Just GHC.FlexibleContexts
-translateExtension FlexibleInstances = Just GHC.FlexibleInstances
-translateExtension ForeignFunctionInterface = Just GHC.ForeignFunctionInterface
-translateExtension FunctionalDependencies = Just GHC.FunctionalDependencies
-translateExtension GADTs = Just GHC.GADTs
-translateExtension GADTSyntax = Just GHC.GADTSyntax
-translateExtension GeneralizedNewtypeDeriving = Just GHC.GeneralizedNewtypeDeriving
-translateExtension GHCForeignImportPrim = Just GHC.GHCForeignImportPrim
-translateExtension ImplicitParams = Just GHC.ImplicitParams
-translateExtension ImplicitPrelude = Just GHC.ImplicitPrelude
-translateExtension ImpredicativeTypes = Just GHC.ImpredicativeTypes
-translateExtension IncoherentInstances = Just GHC.IncoherentInstances
-translateExtension InstanceSigs = Just GHC.InstanceSigs
-translateExtension InterruptibleFFI = Just GHC.InterruptibleFFI
-translateExtension JavaScriptFFI = Just GHC.JavaScriptFFI
-translateExtension KindSignatures = Just GHC.KindSignatures
-translateExtension LambdaCase = Just GHC.LambdaCase
-translateExtension LiberalTypeSynonyms = Just GHC.LiberalTypeSynonyms
-translateExtension MagicHash = Just GHC.MagicHash
-translateExtension MonadComprehensions = Just GHC.MonadComprehensions
-translateExtension MonadFailDesugaring = Just GHC.MonadFailDesugaring
-translateExtension MonoLocalBinds = Just GHC.MonoLocalBinds
-translateExtension MonomorphismRestriction = Just GHC.MonomorphismRestriction
-translateExtension MonoPatBinds = Just GHC.MonoPatBinds
-translateExtension MultiParamTypeClasses = Just GHC.MultiParamTypeClasses
-translateExtension MultiWayIf = Just GHC.MultiWayIf
-translateExtension NamedFieldPuns = Just GHC.RecordPuns
-translateExtension NamedWildCards = Just GHC.NamedWildCards
-translateExtension NegativeLiterals = Just GHC.NegativeLiterals
-translateExtension NondecreasingIndentation = Just GHC.NondecreasingIndentation
-translateExtension NPlusKPatterns = Just GHC.NPlusKPatterns
-translateExtension NullaryTypeClasses = Just GHC.NullaryTypeClasses
-translateExtension NumDecimals = Just GHC.NumDecimals
-translateExtension OverlappingInstances = Just GHC.OverlappingInstances
-translateExtension OverloadedLabels = Just GHC.OverloadedLabels
-translateExtension OverloadedLists = Just GHC.OverloadedLists
-translateExtension OverloadedStrings = Just GHC.OverloadedStrings
-translateExtension PackageImports = Just GHC.PackageImports
-translateExtension ParallelArrays = Just GHC.ParallelArrays
-translateExtension ParallelListComp = Just GHC.ParallelListComp
-translateExtension PartialTypeSignatures = Just GHC.PartialTypeSignatures
-translateExtension PatternGuards = Just GHC.PatternGuards
-translateExtension PatternSignatures = Just GHC.PatternSynonyms
-translateExtension PatternSynonyms = Just GHC.PatternSynonyms
-translateExtension PolyKinds = Just GHC.PolyKinds
-translateExtension PostfixOperators = Just GHC.PostfixOperators
-translateExtension QuasiQuotes = Just GHC.QuasiQuotes
-translateExtension RankNTypes = Just GHC.RankNTypes
-translateExtension RebindableSyntax = Just GHC.RebindableSyntax
-translateExtension RecordPuns = Just GHC.RecordPuns
-translateExtension RecordWildCards = Just GHC.RecordWildCards
-translateExtension RecursiveDo = Just GHC.RecursiveDo
-translateExtension RelaxedPolyRec = Just GHC.RelaxedPolyRec
-translateExtension RestrictedTypeSynonyms = Nothing -- flip xopt_unset GHC.LiberalTypeSynonyms
-translateExtension RoleAnnotations = Just GHC.RoleAnnotations
-translateExtension ScopedTypeVariables = Just GHC.ScopedTypeVariables
-translateExtension StandaloneDeriving = Just GHC.StandaloneDeriving
-translateExtension StaticPointers = Just GHC.StaticPointers
-translateExtension Strict = Just GHC.Strict
-translateExtension StrictData = Just GHC.StrictData
-translateExtension TemplateHaskell = Just GHC.TemplateHaskell
-translateExtension TemplateHaskellQuotes = Just GHC.TemplateHaskellQuotes
-translateExtension TraditionalRecordSyntax = Just GHC.TraditionalRecordSyntax
-translateExtension TransformListComp = Just GHC.TransformListComp
-translateExtension TupleSections = Just GHC.TupleSections
-translateExtension TypeApplications = Just GHC.TypeApplications
-translateExtension TypeFamilies = Just GHC.TypeFamilies
-translateExtension TypeInType = Just GHC.TypeInType
-translateExtension TypeOperators = Just GHC.TypeOperators
-translateExtension TypeSynonymInstances = Just GHC.TypeSynonymInstances
-translateExtension UnboxedTuples = Just GHC.UnboxedTuples
-translateExtension UndecidableInstances = Just GHC.UndecidableInstances
-translateExtension UndecidableSuperClasses = Just GHC.UndecidableSuperClasses
-translateExtension UnicodeSyntax = Just GHC.UnicodeSyntax
-translateExtension UnliftedFFITypes = Just GHC.UnliftedFFITypes
-translateExtension ViewPatterns = Just GHC.ViewPatterns
-
-translateExtension Safe = Nothing -- \df -> df { GHC.safeHaskell = GHC.Sf_Safe }
-translateExtension SafeImports = Nothing -- \df -> df { GHC.safeHaskell = GHC.Sf_Safe }
-translateExtension Trustworthy = Nothing -- \df -> df { GHC.safeHaskell = GHC.Sf_Trustworthy }
-translateExtension Unsafe = Nothing -- \df -> df { GHC.safeHaskell = GHC.Sf_Unsafe }
-
-translateExtension Rank2Types = Just GHC.RankNTypes
-translateExtension PolymorphicComponents = Just GHC.RankNTypes
-translateExtension Generics = Nothing -- it does nothing, deprecated extension
-translateExtension NewQualifiedOperators = Nothing -- it does nothing, deprecated extension
-translateExtension ExtensibleRecords = Nothing -- not in GHC
-translateExtension XmlSyntax = Nothing -- not in GHC
-translateExtension HereDocuments = Nothing -- not in GHC
-translateExtension RegularPatterns = Nothing -- not in GHC

@@ -1,51 +0,0 @@-{-# LANGUAGE LambdaCase
-           , RankNTypes
-           , FlexibleContexts
-           #-}
--- | Helper functions for defining refactorings.
-module Language.Haskell.Tools.Refactor.Helpers where
-
-import Control.Reference
-import Control.Monad.Writer
-import Control.Monad.State
-import Data.Function (on)
-import Data.List (sortBy, nubBy, partition)
-import Data.Maybe
-
-import Language.Haskell.Tools.AST as AST
-import Language.Haskell.Tools.AST.Rewrite as AST
-import Language.Haskell.Tools.Refactor.ListOperations (filterList)
-
-import SrcLoc
-import Language.Haskell.Tools.Transform
-
-replaceWithJust :: Ann e dom SrcTemplateStage -> AnnMaybe e dom -> AnnMaybe e dom
-replaceWithJust e = annMaybe .= Just e
-
-replaceWithNothing :: AnnMaybe e dom -> AnnMaybe e dom
-replaceWithNothing = annMaybe .= Nothing
-
--- | Remove the container (where or let) when the last binding is removed.
-removeEmptyBnds :: Simple Traversal (Module dom) (ValueBind dom)
-                     -> Simple Traversal (Module dom) (Expr dom)
-                     -> AST.Module dom -> AST.Module dom
-removeEmptyBnds binds exprs = (binds .- removeEmptyBindsAndGuards) . (exprs .- removeEmptyLetsAndStmts)
-  where removeEmptyBindsAndGuards sb@(SimpleBind _ _ _)
-          = (valBindLocals .- removeIfEmpty) . (valBindRhs .- removeEmptyGuards) $ sb
-        removeEmptyBindsAndGuards fb@(FunctionBind _)
-          = (funBindMatches & annList & matchBinds .- removeIfEmpty) . (funBindMatches & annList & matchRhs .- removeEmptyGuards) $ fb
-
-        removeEmptyGuards rhs = rhsGuards & annList & guardStmts .- filterList (\case GuardLet (AnnList []) -> False; _ -> True) $ rhs
-
-        removeIfEmpty mb@(AnnJust (LocalBinds (AnnList []))) = annMaybe .= Nothing $ mb
-        removeIfEmpty mb = mb
-
-        removeEmptyLetsAndStmts (Let (AnnList []) e) = e
-        removeEmptyLetsAndStmts e = exprStmts .- removeEmptyStmts $ e
-
-        removeEmptyStmts ls = (annList & cmdStmtBinds .- removeEmptyStmts)
-                                . filterList (\case LetStmt (AnnList []) -> False; _ -> True) $ ls
-
--- | Puts the elements in the orginal order and remove duplicates (elements with the same source range)
-normalizeElements :: [Ann e dom SrcTemplateStage] -> [Ann e dom SrcTemplateStage]
-normalizeElements elems = nubBy ((==) `on` getRange) $ sortBy (compare `on` srcSpanStart . getRange) elems

@@ -1,103 +0,0 @@-{-# LANGUAGE TupleSections #-}
--- | Defines operation on AST lists.
--- AST lists carry source information so simple list modification is not enough.
-module Language.Haskell.Tools.Refactor.ListOperations where
-
-import Control.Reference
-import Control.Applicative
-import Control.Monad.IO.Class
-import Data.List (findIndices)
-
-import Language.Haskell.Tools.AST
-import Language.Haskell.Tools.AST.Rewrite (AnnList)
-import Language.Haskell.Tools.Transform
-import Language.Haskell.Tools.Refactor.RefactorBase
-import Language.Haskell.Tools.Refactor.ChangeAST
-import SrcLoc
-
--- | Filters the elements of the list. By default it removes the separator before the element.
--- Of course, if the first element is removed, the following separator is removed as well.
-filterList :: SourceInfoTraversal e => (Ann e dom SrcTemplateStage -> Bool) -> AnnList e dom -> AnnList e dom
-filterList pred = filterListIndexed (const pred)
-
-filterListIndexed :: SourceInfoTraversal e => (Int -> Ann e dom SrcTemplateStage -> Bool) -> AnnList e dom -> AnnList e dom
-filterListIndexed pred (AnnListG (NodeInfo sema src) elems)
-  =  AnnListG (NodeInfo sema (srcTmpIndented .- fmap filterIndents $ srcTmpSeparators .- filterSeparators $ src)) filteredElems
-  where elementsKept = findIndices (uncurry pred) (zip [0..] elems)
-        filteredElems = sublist elementsKept elems
-        filterIndents = sublist elementsKept
-        filterSeparators = take (length elementsKept - 1) . sublist elementsKept
-
--- | A version of filterList that cares about keeping non-removable code elements (like preprocessor pragmas)
-filterListSt :: SourceInfoTraversal e => (Ann e dom SrcTemplateStage -> Bool) -> AnnList e dom -> LocalRefactor dom (AnnList e dom)
-filterListSt pred = filterListIndexedSt (const pred)
-
--- | A version of filterListIndexed that cares about keeping non-removable code elements (like preprocessor pragmas)
-filterListIndexedSt :: SourceInfoTraversal e => (Int -> Ann e dom SrcTemplateStage -> Bool) -> AnnList e dom -> LocalRefactor dom (AnnList e dom)
-filterListIndexedSt pred (AnnListG (NodeInfo sema src) elems)
-  = do mapM_ removeChild removedElems
-       mapM_ removeSeparator removedSeparators
-       return $ AnnListG (NodeInfo sema (srcTmpIndented .- fmap filterIndents $ srcTmpSeparators .- filterSeparators $ src)) filteredElems
-  where elementsKept = findIndices (uncurry pred) (zip [0..] elems)
-        filteredElems = sublist elementsKept elems
-        removedSeparators :: [([SourceTemplateTextElem], SrcSpan)]
-        removedSeparators = notSublist elementsKept (src ^. srcTmpSeparators) ++ lastSepRemoved
-        lastSepRemoved = if (length elems - 1) `notElem` elementsKept
-                           then take 1 (reverse (sublist elementsKept $ src ^. srcTmpSeparators)) else []
-        removedElems = notSublist elementsKept elems
-        filterIndents = sublist elementsKept
-        filterSeparators = take (length elementsKept - 1) . sublist elementsKept
-
-
--- | Selects the given indices from a list
-sublist :: [Int] -> [a] -> [a]
-sublist indices = map snd . filter ((`elem` indices) . fst) . zip [0..]
-
--- | Selects all but the given indices from a list
-notSublist :: [Int] -> [a] -> [a]
-notSublist indices = map snd . filter ((`notElem` indices) . fst) . zip [0..]
-
--- | Inserts the element in the places where the two positioning functions (one checks the element before, one the element after)
--- allows the placement.
-insertWhere :: Bool -> Ann e dom SrcTemplateStage -> (Maybe (Ann e dom SrcTemplateStage) -> Bool)
-                 -> (Maybe (Ann e dom SrcTemplateStage) -> Bool) -> AnnList e dom
-                 -> AnnList e dom
-insertWhere indented e before after al
-  = let index = insertIndex before after (al ^? annList)
-     in case index of
-          Nothing -> al
-          Just ind -> annListElems .- insertAt ind e
-                        $ (if isEmptyAnnList then id else annListAnnot&sourceInfo .- setIndented ind . addDefaultSeparator ind)
-                        $ al
-  where setIndented i = srcTmpIndented .- fmap (insertAt i indented)
-        addDefaultSeparator i al = srcTmpSeparators .- insertAt i ([NormalText $ al ^. srcTmpDefaultSeparator], noSrcSpan) $ al
-        insertAt n e ls = let (bef,aft) = splitAt n ls in bef ++ [e] ++ aft
-        isEmptyAnnList = (null :: [x] -> Bool) $ (al ^? annList)
-
--- | Checks where the element will be inserted given the two positioning functions.
-insertIndex :: (Maybe (Ann e dom SrcTemplateStage) -> Bool) -> (Maybe (Ann e dom SrcTemplateStage) -> Bool) -> [Ann e dom SrcTemplateStage] -> Maybe Int
-insertIndex before after []
-  | before Nothing && after Nothing = Just 0
-  | otherwise = Nothing
-insertIndex before after list@(first:_)
-  | before Nothing && after (Just first) = Just 0
-  | otherwise = (+1) <$> insertIndex' before after list
-  where insertIndex' before after (curr:rest@(next:_))
-          | before (Just curr) && after (Just next) = Just 0
-          | otherwise = (+1) <$> insertIndex' before after rest
-        insertIndex' before after (curr:[])
-          | before (Just curr) && after Nothing = Just 0
-          | otherwise = Nothing
-        insertIndex' before after []
-          | before Nothing && after Nothing = Just 0
-          | otherwise = Nothing
-
--- | Gets the elements and separators from a list. The first separator is zipped to the second element.
--- To the first element, the "" string is zipped.
-zipWithSeparators :: AnnList e dom -> [(([SourceTemplateTextElem], SrcSpan), Ann e dom SrcTemplateStage)]
-zipWithSeparators (AnnListG (NodeInfo _ src) elems)
-  | [] <- src ^. srcTmpSeparators
-  = zip (([], noSrcSpan) : repeat ([NormalText $ src ^. srcTmpDefaultSeparator], noSrcSpan)) elems
-  | otherwise
-  = zip (([], noSrcSpan) : seps ++ repeat (_2 .= noSrcSpan $ last seps)) elems
-  where seps = src ^. srcTmpSeparators

@@ -0,0 +1,128 @@+{-# LANGUAGE TypeSynonymInstances
+           , FlexibleInstances
+           , DeriveFunctor
+           , GeneralizedNewtypeDeriving
+           #-}
+-- | Types and instances for monadic refactorings. The refactoring monad provides automatic
+-- importing, keeping important source fragments (such as preprocessor pragmas), and providing
+-- contextual information for refactorings.
+module Language.Haskell.Tools.Refactor.Monad where
+
+import Control.Monad.Reader
+import qualified Control.Monad.State.Lazy as LazySt
+import Control.Monad.State.Strict
+import Control.Monad.Trans (MonadTrans(..), MonadIO)
+import Control.Monad.Trans.Except (ExceptT(..), throwE, runExceptT)
+import Control.Monad.Trans.Reader (ReaderT(..))
+import Control.Monad.Trans.Writer (WriterT(..))
+import Control.Monad.Writer
+import DynFlags (HasDynFlags(..))
+import Exception (ExceptionMonad(..))
+import GHC hiding (mkModuleName, moduleNameString)
+
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.Refactor.Representation (RefactorChange, ModuleDom, UnnamedModule)
+
+-- | A monad that can be used to refactor
+class Monad m => RefactorMonad m where
+  refactError :: String -> m a
+  liftGhc :: Ghc a -> m a
+
+-- | A refactoring that only affects one module
+type LocalRefactoring dom = UnnamedModule dom -> LocalRefactor dom (UnnamedModule dom)
+
+-- | The type of a refactoring
+type Refactoring dom = ModuleDom dom -> [ModuleDom dom] -> Refactor [RefactorChange dom]
+
+-- | The type of a refactoring that affects the whole project.
+type ProjectRefactoring dom = [ModuleDom dom] -> Refactor [RefactorChange dom]
+
+-- | The refactoring monad for a given module
+type LocalRefactor dom = LocalRefactorT dom Refactor
+
+-- | The refactoring monad for the whole project
+type Refactor = ExceptT String Ghc
+
+-- | Input and output information for the refactoring
+-- TODO: use multiple states instead of Either
+newtype LocalRefactorT dom m a
+  = LocalRefactorT { fromRefactorT :: WriterT [Either GHC.Name (SrcSpan, String, String)]
+                                              (ReaderT (RefactorCtx dom) m) a
+                   }
+  deriving ( Functor, Applicative, Monad, MonadReader (RefactorCtx dom)
+           , MonadWriter [Either GHC.Name (SrcSpan, String, String)]
+           , MonadIO, HasDynFlags, ExceptionMonad, GhcMonad )
+
+-- | The information a refactoring can use
+data RefactorCtx dom
+  = RefactorCtx { refModuleName :: GHC.Module -- ^ The name of the module being refactored. Used for accessing implicit imports.
+                , refCtxRoot :: Ann UModule dom SrcTemplateStage
+                , refCtxImports :: [Ann UImportDecl dom SrcTemplateStage]
+                }
+
+instance MonadTrans (LocalRefactorT dom) where
+  lift = LocalRefactorT . lift . lift
+
+instance RefactorMonad Refactor where
+  refactError = throwE
+  liftGhc = lift
+
+instance RefactorMonad (LocalRefactor dom) where
+  refactError = lift . refactError
+  liftGhc = lift . liftGhc
+
+instance RefactorMonad m => RefactorMonad (StateT s m) where
+  refactError = lift . refactError
+  liftGhc = lift . liftGhc
+
+instance RefactorMonad m => RefactorMonad (LazySt.StateT s m) where
+  refactError = lift . refactError
+  liftGhc = lift . liftGhc
+
+-- * Some instances missing from GHC
+
+instance (GhcMonad m, Monoid s) => GhcMonad (WriterT s m) where
+  getSession = lift getSession
+  setSession env = lift (setSession env)
+
+instance (ExceptionMonad m, Monoid s) => ExceptionMonad (WriterT s m) where
+  gcatch w c = WriterT (runWriterT w `gcatch` (runWriterT . c))
+  gmask m = WriterT $ gmask (\f -> runWriterT $ m (WriterT . f . runWriterT))
+
+instance (Monad m, HasDynFlags m) => HasDynFlags (StateT s m) where
+  getDynFlags = lift getDynFlags
+
+instance (GhcMonad m) => GhcMonad (StateT s m) where
+  getSession = lift getSession
+  setSession env = lift (setSession env)
+
+instance (ExceptionMonad m) => ExceptionMonad (StateT s m) where
+  gcatch r c = StateT (\ctx -> runStateT r ctx `gcatch` (flip runStateT ctx . c))
+  gmask m = StateT $ \ctx -> gmask (\f -> runStateT (m (\a -> StateT $ \ctx' -> f (runStateT a ctx'))) ctx)
+
+instance (Monad m, HasDynFlags m) => HasDynFlags (LazySt.StateT s m) where
+  getDynFlags = lift getDynFlags
+
+instance (GhcMonad m) => GhcMonad (LazySt.StateT s m) where
+  getSession = lift getSession
+  setSession env = lift (setSession env)
+
+instance (ExceptionMonad m) => ExceptionMonad (LazySt.StateT s m) where
+  gcatch r c = LazySt.StateT (\ctx -> LazySt.runStateT r ctx `gcatch` (flip LazySt.runStateT ctx . c))
+  gmask m = LazySt.StateT $ \ctx -> gmask (\f -> LazySt.runStateT (m (\a -> LazySt.StateT $ \ctx' -> f (LazySt.runStateT a ctx'))) ctx)
+
+instance GhcMonad m => GhcMonad (ReaderT s m) where
+  getSession = lift getSession
+  setSession env = lift (setSession env)
+
+instance ExceptionMonad m => ExceptionMonad (ReaderT s m) where
+  gcatch r c = ReaderT (\ctx -> runReaderT r ctx `gcatch` (flip runReaderT ctx . c))
+  gmask m = ReaderT $ \ctx -> gmask (\f -> runReaderT (m (\a -> ReaderT $ \ctx' -> f (runReaderT a ctx'))) ctx)
+
+instance GhcMonad m => GhcMonad (ExceptT s m) where
+  getSession = lift getSession
+  setSession env = lift (setSession env)
+
+instance ExceptionMonad m => ExceptionMonad (ExceptT s m) where
+  gcatch e c = ExceptT (runExceptT e `gcatch` (runExceptT . c))
+  gmask m = ExceptT $ gmask (\f -> runExceptT $ m (ExceptT . f . runExceptT))

@@ -1,87 +0,0 @@-{-# LANGUAGE StandaloneDeriving
-           , DeriveGeneric
-           , LambdaCase
-           , ScopedTypeVariables
-           , BangPatterns
-           , MultiWayIf
-           , FlexibleContexts
-           , TypeFamilies
-           , TupleSections
-           , TemplateHaskell
-           , ViewPatterns
-           #-}
--- | Defines common utilities for using refactorings. Provides an interface for both demo, command line and integrated tools.
-module Language.Haskell.Tools.Refactor.Perform where
-
-import Data.List.Split
-
-import Language.Haskell.Tools.AST as AST
-import Language.Haskell.Tools.Refactor.Predefined.ExtractBinding
-import Language.Haskell.Tools.Refactor.Predefined.FloatOut
-import Language.Haskell.Tools.Refactor.Predefined.GenerateExports
-import Language.Haskell.Tools.Refactor.Predefined.GenerateTypeSignature
-import Language.Haskell.Tools.Refactor.Predefined.InlineBinding
-import Language.Haskell.Tools.Refactor.Predefined.OrganizeImports
-import Language.Haskell.Tools.Refactor.Predefined.RenameDefinition
-import Language.Haskell.Tools.Refactor.Prepare
-import Language.Haskell.Tools.Refactor.RefactorBase
-
-import GHC
-
--- | Executes a given command on the selected module and given other modules
-performCommand :: (HasModuleInfo dom, DomGenerateExports dom, OrganizeImportsDomain dom, DomainRenameDefinition dom, ExtractBindingDomain dom, GenerateSignatureDomain dom)
-               => RefactorCommand -> ModuleDom dom -- ^ The module in which the refactoring is performed
-                                  -> [ModuleDom dom] -- ^ Other modules
-                                  -> Ghc (Either String [RefactorChange dom])
-performCommand rf mod mods = runRefactor mod mods $ selectCommand rf
-  where selectCommand NoRefactor = localRefactoring return
-        selectCommand OrganizeImports = localRefactoring organizeImports
-        selectCommand ProjectOrganizeImports = projectOrganizeImports
-        selectCommand GenerateExports = localRefactoring generateExports
-        selectCommand (GenerateSignature sp) = localRefactoring $ generateTypeSignature' (correctRefactorSpan (snd mod) sp)
-        selectCommand (RenameDefinition sp str) = renameDefinition' (correctRefactorSpan (snd mod) sp) str
-        selectCommand (ExtractBinding sp str) = localRefactoring $ extractBinding' (correctRefactorSpan (snd mod) sp) str
-        selectCommand (InlineBinding sp) = inlineBinding (correctRefactorSpan (snd mod) sp)
-        selectCommand (FloatOut sp) = localRefactoring $ floatOut (correctRefactorSpan (snd mod) sp)
-
--- | A refactoring command
-data RefactorCommand = NoRefactor
-                     | OrganizeImports
-                     | ProjectOrganizeImports
-                     | GenerateExports
-                     | GenerateSignature RealSrcSpan
-                     | RenameDefinition RealSrcSpan String
-                     | ExtractBinding RealSrcSpan String
-                     | InlineBinding RealSrcSpan
-                     | FloatOut RealSrcSpan
-    deriving Show
-
--- | Recognize a command from its textual representation
-readCommand :: String -> Either String RefactorCommand
-readCommand (splitOn " " -> refact:args) = analyzeCommand refact args
-readCommand _ = error "panic: splitOn resulted empty"
-
--- | Check the parts and return the command
-analyzeCommand :: String -> [String] -> Either String RefactorCommand
-analyzeCommand "" _ = Right NoRefactor
-analyzeCommand "CheckSource" _ = Right NoRefactor
-analyzeCommand "OrganizeImports" _ = Right OrganizeImports
-analyzeCommand "ProjectOrganizeImports" _ = Right ProjectOrganizeImports
-analyzeCommand "GenerateExports" _ = Right GenerateExports
-analyzeCommand "GenerateSignature" [sp] = Right $ GenerateSignature (readSrcSpan sp)
-analyzeCommand "GenerateSignature" _ = Left $ "GenerateSignature needs one argument: the source range of the definition"
-analyzeCommand "RenameDefinition" [sp, newName] = Right $ RenameDefinition (readSrcSpan sp) newName
-analyzeCommand "RenameDefinition" _ = Left $ "RenameDefinition needs two arguments: the source range of the name and the new name"
-analyzeCommand "ExtractBinding" [sp, newName] = Right $ ExtractBinding (readSrcSpan sp) newName
-analyzeCommand "ExtractBinding" _ = Left $ "RenameDefinition needs two arguments: the source range of the expression and the new name"
-analyzeCommand "InlineBinding" [sp] = Right $ InlineBinding (readSrcSpan sp)
-analyzeCommand "InlineBinding" _ = Left $ "InlineBinding needs one argument: the source range of the definition"
-analyzeCommand "FloatOut" [sp] = Right $ FloatOut (readSrcSpan sp)
-analyzeCommand "FloatOut" _ = Left $ "FloatOut needs one argument: the source range of the definition"
-analyzeCommand ref _ = Left $ "Unknown command: " ++ ref
-
-refactorCommands :: [String]
-refactorCommands
-  = [ "CheckSource", "OrganizeImports", "ProjectOrganizeImports", "GenerateExports"
-    , "GenerateSignature", "RenameDefinition", "ExtractBinding", "InlineBinding"
-    , "FloatOut" ]

@@ -1,15 +0,0 @@-module Language.Haskell.Tools.Refactor.Predefined.DataToNewtype (dataToNewtype, tryItOut) where
-
-import Control.Reference ((.=), (.-), (&))
-import Language.Haskell.Tools.Refactor
-
-tryItOut :: String -> IO ()
-tryItOut moduleName = tryRefactor (\_ -> localRefactoring dataToNewtype) moduleName ""
-
-dataToNewtype :: LocalRefactoring dom
-dataToNewtype = return . (modDecl & annList .- changeDeclaration)
-
-changeDeclaration :: Decl dom -> Decl dom
-changeDeclaration dd@(DataDecl DataKeyword _ _ (AnnList [ConDecl _ (AnnList [_])]) _)
-  = declNewtype .= mkNewtypeKeyword $ dd
-changeDeclaration decl = decl

@@ -1,49 +0,0 @@-{-# LANGUAGE ViewPatterns, FlexibleContexts, ConstraintKinds #-}
-module Language.Haskell.Tools.Refactor.Predefined.DollarApp (dollarApp, DollarDomain, tryItOut) where
-
-import Language.Haskell.Tools.Refactor
-
-import BasicTypes (Fixity(..))
-import Id (idName)
-import qualified Name as GHC (Name)
-import PrelInfo (wiredInIds)
-import PrelNames (dollarIdKey)
-import SrcLoc (RealSrcSpan, SrcSpan)
-import Unique (getUnique)
-
-import Control.Monad.State
-import Control.Reference ((^.), (!~), biplateRef)
-
-tryItOut :: String -> String -> IO ()
-tryItOut = tryRefactor (localRefactoring . dollarApp)
-
-type DollarMonad dom = StateT [SrcSpan] (LocalRefactor dom)
-type DollarDomain dom = (HasImportInfo dom, HasModuleInfo dom, HasFixityInfo dom, HasNameInfo dom)
-
-dollarApp :: DollarDomain dom => RealSrcSpan -> LocalRefactoring dom
-dollarApp sp = flip evalStateT [] . ((nodesContained sp !~ (\e -> get >>= replaceExpr e)) 
-                                        >=> (biplateRef !~ parenExpr))
-
-replaceExpr :: DollarDomain dom => Expr dom -> [SrcSpan] -> DollarMonad dom (Expr dom)
-replaceExpr expr@(App _ (Paren (InfixApp _ op arg))) replacedRanges
-  | not (getRange arg `elem` replacedRanges)
-  , semanticsName (op ^. operatorName) /= Just dollarName 
-  , case semanticsFixity (op ^. operatorName) of Just (Fixity _ p _) | p > 0 -> False; _ -> True
-  = return expr
-replaceExpr (App fun (Paren arg)) _ = do modify $ (getRange arg :)
-                                         mkInfixApp fun <$> lift (referenceOperator dollarName) <*> pure arg
-replaceExpr e _ = return e
-
-parenExpr :: Expr dom -> DollarMonad dom (Expr dom)
-parenExpr e = (exprLhs !~ parenDollar True) =<< (exprRhs !~ parenDollar False $ e)
-
-parenDollar :: Bool -> Expr dom -> DollarMonad dom (Expr dom)
-parenDollar lhs expr@(InfixApp _ _ arg) 
-  = do replacedRanges <- get
-       if getRange arg `elem` replacedRanges && (lhs || getRange expr `notElem` replacedRanges)
-         then return $ mkParen expr
-         else return expr
-parenDollar _ e = return e
-
-dollarName :: GHC.Name
-[dollarName] = map idName $ filter ((dollarIdKey==) . getUnique) wiredInIds

@@ -1,16 +0,0 @@-module Language.Haskell.Tools.Refactor.Predefined.DollarApp1 where
-
-import Language.Haskell.Tools.Refactor
-
-import Control.Reference
-import SrcLoc (RealSrcSpan)
-
-tryItOut :: String -> String -> IO ()
-tryItOut = tryRefactor (localRefactoring . dollarApp)
-
-dollarApp :: Domain dom => RealSrcSpan -> LocalRefactoring dom
-dollarApp sp = return . (nodesContained sp .- replaceExpr)
-
-replaceExpr :: Expr dom -> Expr dom
-replaceExpr (App fun (Paren arg)) = mkInfixApp fun (mkUnqualOp "$") arg
-replaceExpr e = e

@@ -1,23 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}
-module Language.Haskell.Tools.Refactor.Predefined.DollarApp2 where
-
-import Language.Haskell.Tools.Refactor
-
-import Control.Reference
-import SrcLoc (RealSrcSpan)
-import Unique (getUnique)
-import Id (idName)
-import PrelNames (dollarIdKey)
-import PrelInfo (wiredInIds)
-
-tryItOut :: String -> String -> IO ()
-tryItOut = tryRefactor (localRefactoring . dollarApp)
-
-dollarApp :: (HasImportInfo dom, HasModuleInfo dom) => RealSrcSpan -> LocalRefactoring dom
-dollarApp sp = nodesContained sp !~ replaceExpr
-
-replaceExpr :: (HasImportInfo dom, HasModuleInfo dom) => Expr dom -> LocalRefactor dom (Expr dom)
-replaceExpr (App fun (Paren arg)) = mkInfixApp fun <$> referenceOperator dollarName <*> pure arg
-replaceExpr e = pure e
-
-[dollarName] = map idName $ filter ((dollarIdKey==) . getUnique) wiredInIds

@@ -1,44 +0,0 @@-{-# LANGUAGE ViewPatterns, FlexibleContexts, ConstraintKinds #-}
-module Language.Haskell.Tools.Refactor.Predefined.DollarApp3 where
-
-import Language.Haskell.Tools.Refactor
-
-import BasicTypes (Fixity(..))
-import Id (idName)
-import qualified Name as GHC (Name)
-import PrelInfo (wiredInIds)
-import PrelNames (dollarIdKey)
-import SrcLoc (RealSrcSpan, SrcSpan)
-import Unique (getUnique)
-
-import Control.Monad.State
-import Control.Reference ((^.), (!~), biplateRef)
-
-tryItOut :: String -> String -> IO ()
-tryItOut = tryRefactor (localRefactoring . dollarApp)
-
-type DollarMonad dom = StateT [SrcSpan] (LocalRefactor dom)
-type DollarDomain dom = (HasImportInfo dom, HasModuleInfo dom, HasFixityInfo dom, HasNameInfo dom)
-
-dollarApp :: DollarDomain dom => RealSrcSpan -> LocalRefactoring dom
-dollarApp sp = flip evalStateT [] . ((nodesContained sp !~ (\e -> get >>= replaceExpr e))
-                                        >=> (biplateRef !~ parenExpr))
-
-replaceExpr :: DollarDomain dom => Expr dom -> [SrcSpan] -> DollarMonad dom (Expr dom)
-replaceExpr (App fun (Paren arg)) _ = do modify $ (getRange arg :)
-                                         mkInfixApp fun <$> lift (referenceOperator dollarName) <*> pure arg
-replaceExpr e _ = return e
-
-parenExpr :: Expr dom -> DollarMonad dom (Expr dom)
-parenExpr e = (exprLhs !~ parenDollar True) =<< (exprRhs !~ parenDollar False $ e)
-
-parenDollar :: Bool -> Expr dom -> DollarMonad dom (Expr dom)
-parenDollar lhs expr@(InfixApp _ _ arg)
-  = do replacedRanges <- get
-       if getRange arg `elem` replacedRanges && (lhs || getRange expr `notElem` replacedRanges)
-         then return $ mkParen expr
-         else return expr
-parenDollar _ e = return e
-
-dollarName :: GHC.Name
-[dollarName] = map idName $ filter ((dollarIdKey==) . getUnique) wiredInIds

@@ -1,230 +0,0 @@-
-{-# LANGUAGE ViewPatterns
-           , ScopedTypeVariables
-           , RankNTypes
-           , FlexibleContexts
-           , TypeApplications
-           , ConstraintKinds
-           , TypeFamilies
-           , MultiWayIf
-           #-}
-module Language.Haskell.Tools.Refactor.Predefined.ExtractBinding (extractBinding', ExtractBindingDomain, tryItOut) 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
-
--- | 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
-          exprRange:_ ->
-            if | not (null conflicting)
-               -> refactError $ "The given name causes name conflict with the definition(s) at: " ++ concat (intersperse "," (map (shortShowSpan . getRange) conflicting))
-               | any (`containsRange` exprRange) $ map getRange declPats
-               -> refactError "Extract binding cannot be applied to view pattern expressions."
-               | otherwise
-               -> do (res, st) <- runStateT (selectDecl&selectExpr !~ extractThatBind sp name (head $ decl ^? actualContainingExpr exprRange) $ 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."
-  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 (isInside rng) & matchRhs
-        accessExpr :: Simple Traversal (Rhs dom) (Expr dom)
-        accessExpr = rhsExpr &+& rhsGuards & annList & filtered (isInside rng) & 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

@@ -1,76 +0,0 @@-{-# LANGUAGE LambdaCase
-           , ConstraintKinds
-           , FlexibleContexts
-           , ViewPatterns
-           , TypeApplications
-           , ScopedTypeVariables
-           #-}
-module Language.Haskell.Tools.Refactor.Predefined.FloatOut 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 OccName (occNameString)
-import SrcLoc (RealSrcSpan)
-
-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 fst $ 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 fst) $ take 2 $ semanticsScope qn) \\ catMaybes (map semanticsName bndNames)

@@ -1,40 +0,0 @@-{-# LANGUAGE TupleSections
-           , ConstraintKinds
-           , TypeFamilies
-           , FlexibleContexts
-           #-}
-module Language.Haskell.Tools.Refactor.Predefined.GenerateExports (generateExports, DomGenerateExports) where
-
-import Control.Reference ((^?), (.=), (&))
-import Language.Haskell.Tools.Refactor
-
-import qualified GHC (NamedThing(..), Name)
-
-import Control.Applicative ((<|>))
-import Data.Maybe (Maybe(..), catMaybes)
-
--- | 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))
-                                   (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)
-

@@ -1,176 +0,0 @@-{-# LANGUAGE ViewPatterns
-           , FlexibleContexts
-           , ScopedTypeVariables
-           , RankNTypes
-           , TypeApplications
-           , TypeFamilies
-           , ConstraintKinds
-           , TupleSections
-           #-}
-module Language.Haskell.Tools.Refactor.Predefined.GenerateTypeSignature
-  (generateTypeSignature, generateTypeSignature', GenerateSignatureDomain, tryItOut) 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 )
-
-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 flip evalStateT False .
-          (topLevelRef !~ genTypeSig scopedSigs bindsWithSigs vbAccess
-             <=< localRef !~ genTypeSig scopedSigs bindsWithSigs vbAccess) $ mod
-
-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

@@ -1,17 +0,0 @@-module Language.Haskell.Tools.Refactor.Predefined.HelloRefactor where
-
-import Language.Haskell.Tools.PrettyPrint (prettyPrint)
-import Language.Haskell.Tools.Refactor
-
-import Control.Reference
-import Debug.Trace (trace)
-import SrcLoc (RealSrcSpan)
-
-tryItOut :: String -> String -> IO ()
-tryItOut = tryRefactor (localRefactoring . helloRefactor)
-
-helloRefactor :: Domain dom => RealSrcSpan -> LocalRefactoring dom
-helloRefactor sp = return . (nodesContained sp .- helloExpr)
-
-helloExpr :: Expr dom -> Expr dom
-helloExpr e = trace ("\n### Hello: " ++ prettyPrint e) $ e

@@ -1,29 +0,0 @@-{-# LANGUAGE RankNTypes, FlexibleContexts, ViewPatterns #-}
-module Language.Haskell.Tools.Refactor.Predefined.IfToGuards (ifToGuards, tryItOut) where
-
-import Control.Reference ((^.), (.-), (&))
-import Data.Generics.Uniplate.Data ()
-import Language.Haskell.Tools.Refactor
-import SrcLoc (RealSrcSpan)
-
-tryItOut :: String -> String -> IO ()
-tryItOut = tryRefactor (localRefactoring . ifToGuards)
-
-ifToGuards :: Domain dom => RealSrcSpan -> LocalRefactoring dom
-ifToGuards sp = return . (nodesContaining sp .- changeBindings)
-
-changeBindings :: ValueBind dom -> ValueBind dom
-changeBindings (SimpleBind (VarPat name) (UnguardedRhs (If pred thenE elseE)) locals) 
-  = mkFunctionBind [mkMatch (mkMatchLhs name []) (createSimpleIfRhss pred thenE elseE) (locals ^. annMaybe) ]
-changeBindings fbs@(FunctionBind {}) 
-  = funBindMatches&annList&matchRhs .- trfRhs $ fbs
-  where trfRhs :: Rhs dom -> Rhs dom
-        trfRhs (UnguardedRhs (If pred thenE elseE)) = createSimpleIfRhss pred thenE elseE
-        trfRhs e = e -- don't transform already guarded right-hand sides to avoid multiple evaluation of the same condition
-changeBindings b = b
-
-createSimpleIfRhss :: Expr dom -> Expr dom -> Expr dom -> Rhs dom
-createSimpleIfRhss pred thenE elseE = mkGuardedRhss [ mkGuardedRhs [mkGuardCheck pred] thenE
-                                                    , mkGuardedRhs [mkGuardCheck (mkVar (mkName "otherwise"))] elseE
-                                                    ]
-

@@ -1,226 +0,0 @@-{-# LANGUAGE RankNTypes
-           , ConstraintKinds
-           , FlexibleContexts
-           , TypeFamilies
-           , LambdaCase
-           , TypeApplications
-           , ScopedTypeVariables
-           , MultiWayIf
-           #-}
--- | 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.Predefined.InlineBinding (inlineBinding, InlineBindingDomain, tryItOut) where
-
-import Control.Monad.State
-import Control.Monad.Writer hiding (Alt)
-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, containsSpan)
-
-import Language.Haskell.Tools.Refactor as AST
-
-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', 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 $ removeBindingAndSig topLevelRef localRef exprRef removedBindingName 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 -> AST.Module dom
-                         -> AST.Module dom
-removeBindingAndSig topLevelRef localRef exprRef name
-  = 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 -> AnnList d dom
-removeBindingAndSig' name = (annList .- removeNameFromSigBind) . filterList notThatBindOrSig
-  where notThatBindOrSig e
-          | Just sb <- e ^? sigBind = nub (map semanticsName (sb ^? tsName & annList & simpleName)) /= [Just name]
-          | Just vb <- e ^? valBind = nub (map semanticsName (vb ^? bindingName)) /= [Just name]
-          | Just fs <- e ^? fixitySig = nub (map semanticsName (fs ^? fixityOperators & annList & operatorName)) /= [Just name]
-          | otherwise = True
-
-        removeNameFromSigBind d
-          | Just sb <- d ^? sigBind
-          = createTypeSig $ tsName .- filterList (\n -> semanticsName (n ^. simpleName) /= Just name) $ sb
-          | Just fs <- d ^? fixitySig
-          = createFixitySig $ fixityOperators .- filterList (\n -> semanticsName (n ^. operatorName) /= Just name) $ fs
-          | otherwise = d
-
--- | 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
-  = case getRange expr of
-      RealSrcSpan ownRange | bindingRange `containsSpan` ownRange
-        -> lift $ refactError "Cannot inline definitions containing direct recursion."
-      _ -> do put True
-              replacement (map (map fst) $ 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)

@@ -1,229 +0,0 @@-{-# LANGUAGE LambdaCase
-           , ScopedTypeVariables
-           , FlexibleContexts
-           , TypeFamilies
-           , ConstraintKinds
-           , TupleSections
-           , TypeApplications
-           #-}
-module Language.Haskell.Tools.Refactor.Predefined.OrganizeImports (organizeImports, OrganizeImportsDomain, projectOrganizeImports) 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 TyCon (TyCon(..), tyConFamInst_maybe)
-import SrcLoc
-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
-
-import Debug.Trace
-
-type OrganizeImportsDomain dom = ( HasNameInfo dom, HasImportInfo dom, HasModuleInfo dom, HasImplicitFieldsInfo dom )
-
-projectOrganizeImports :: forall dom . OrganizeImportsDomain dom => Refactoring dom
-projectOrganizeImports mod mods
-  = mapM (\(k, m) -> ContentChanged . (k,) <$> localRefactoringRes id m (organizeImports m)) (mod: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 return . (annList .- narrowImportSubspecs neededNames exportedNames))
-       >=> return . filterList 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 -> IESpec dom
-narrowImportSubspecs neededNames exportedNames ss | noNarrowingForThis = ss
-  | otherwise
-  = ieSubspec & annJust & essList .- filterList (\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

@@ -1,137 +0,0 @@-{-# LANGUAGE ScopedTypeVariables
-           , LambdaCase
-           , MultiWayIf
-           , TypeApplications
-           , ConstraintKinds
-           , TypeFamilies
-           , FlexibleContexts
-           , ViewPatterns
-           , TupleSections
-           #-}
-module Language.Haskell.Tools.Refactor.Predefined.RenameDefinition (renameDefinition, renameDefinition', DomainRenameDefinition) where
-
-import qualified GHC
-import Name (OccName(..), NamedThing(..), occNameString)
-import SrcLoc (RealSrcSpan)
-import Id
-import IdInfo
-import Outputable
-import Type
-import TyCon
-import DataCon
-
-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 Debug.Trace
-
-import Language.Haskell.Tools.Refactor
-
-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 = biplateRef @_ @(ModuleName dom) & filtered (\e -> (e ^. moduleNameString) == from) != mkModuleName to
-
-        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) && not (mergeableFields origId n))
-                     (scopeUpToDef (map (map fst) $ semanticsScope name) ^? traversal & traversal & filtered (sameNamespace toChangeOrig))
-      = refactError $ "The definition clashes with an existing one at: " ++ shortShowSpan (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 fst) $ 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: " ++ shortShowSpan (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`)) 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
-
-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)

@@ -7,39 +7,37 @@            , FlexibleContexts
            , TypeFamilies
            , TupleSections
-           , TemplateHaskell
            , ViewPatterns
            #-}
 -- | Defines utility methods that prepare Haskell modules for refactoring
 module Language.Haskell.Tools.Refactor.Prepare where
 
-import CmdLineParser
+import Control.Monad
+import Control.Monad.IO.Class (MonadIO(..))
+import Data.List ((\\), isSuffixOf)
+import Data.List.Split (splitOn)
+import Data.Maybe (Maybe(..), fromMaybe, fromJust)
+import Language.Haskell.TH.LanguageExtensions (Extension(..))
+import System.Directory (canonicalizePath)
+import System.FilePath
+
+import CmdLineParser (CmdLineP(..), processArgs)
 import DynFlags
-import FastString
+import FastString (mkFastString)
 import GHC hiding (loadModule)
 import qualified GHC (loadModule)
 import GHC.Paths ( libdir )
-import Packages
+import Packages (initPackages)
 import SrcLoc
-import StringBuffer
-
-import Control.Exception
-import Control.Monad
-import Control.Monad.IO.Class
-import Control.Monad.Trans
-import Data.IntSet (member)
-import Data.List ((\\), intersperse, isSuffixOf)
-import Data.List.Split
-import Data.Maybe
-import Language.Haskell.TH.LanguageExtensions
-import System.Directory
-import System.FilePath
+import StringBuffer (hGetStringBuffer)
 
 import Language.Haskell.Tools.AST as AST
-import Language.Haskell.Tools.AST.FromGHC
-import Language.Haskell.Tools.PrettyPrint
-import Language.Haskell.Tools.Refactor.RefactorBase
-import Language.Haskell.Tools.Transform
+import Language.Haskell.Tools.BackendGHC
+import Language.Haskell.Tools.PrettyPrint (prettyPrint)
+import Language.Haskell.Tools.PrettyPrint.Prepare
+import Language.Haskell.Tools.Refactor.Monad (Refactoring(..))
+import Language.Haskell.Tools.Refactor.Representation
+import Language.Haskell.Tools.Refactor.Utils.Monadic (runRefactor)
 
 
 -- | A quick function to try the refactorings
@@ -48,7 +46,7 @@   = runGhc (Just libdir) $ do
       initGhcFlags
       useDirs ["."]
-      mod <- loadModule "." moduleName >>= parseTyped "."
+      mod <- loadModule "." moduleName >>= parseTyped
       res <- runRefactor (SourceFileKey (moduleSourceFile moduleName) moduleName, mod) []
                $ refact $ correctRefactorSpan mod $ readSrcSpan span
       case res of Right r -> liftIO $ mapM_ (putStrLn . prettyPrint . snd . fromContentChanged) r
@@ -63,15 +61,16 @@         updateSrcFile fn loc = mkRealSrcLoc fn (srcLocLine loc) (srcLocCol loc)
 
 -- | Set the given flags for the GHC session
-useFlags :: [String] -> Ghc [String]
+useFlags :: [String] -> Ghc ([String], DynFlags -> DynFlags)
 useFlags args = do
   let lArgs = map (L noSrcSpan) args
-  dynflags <- getSessionDynFlags
+  dynflags <- getSessionDynFlags+  let change = runCmdLine $ processArgs flagsAll lArgs
   -- TODO: print errors and warnings?
-  let ((leftovers, _, _), newDynFlags) = (runCmdLine $ processArgs flagsAll lArgs) dynflags
+  let ((leftovers, _, _), newDynFlags) = change dynflags
   void $ setSessionDynFlags newDynFlags
   when (any ("-package-db" `isSuffixOf`) args) reloadPkgDb
-  return $ map unLoc leftovers
+  return $ (map unLoc leftovers, snd . change)
 
 -- | Reloads the package database based on the session flags
 reloadPkgDb :: Ghc ()
@@ -132,6 +131,9 @@ getModSumOrig :: ModSummary -> FilePath
 getModSumOrig = normalise . fromMaybe (error "getModSumOrig: The given module doesn't have haskell source file.") . ml_hs_file . ms_location
 
+keyFromMS :: ModSummary -> SourceFileKey
+keyFromMS ms = SourceFileKey (normalise $ getModSumOrig ms) (getModSumName ms)
+
 -- | Gets the module name
 getModSumName :: ModSummary -> String
 getModSumName = GHC.moduleNameString . moduleName . ms_mod
@@ -150,8 +152,8 @@ type TypedModule = Ann AST.UModule IdDom SrcTemplateStage
 
 -- | Get the typed representation from a type-correct program.
-parseTyped :: FilePath -> ModSummary -> Ghc TypedModule
-parseTyped wd modSum = withAlteredDynFlags (return . normalizeFlags) $ do
+parseTyped :: ModSummary -> Ghc TypedModule
+parseTyped modSum = withAlteredDynFlags (return . normalizeFlags) $ do
   let hasStaticFlags = StaticPointers `xopt` ms_hspp_opts modSum
       hasCppExtension = Cpp `xopt` ms_hspp_opts modSum
       hasApplicativeDo = ApplicativeDo `xopt` ms_hspp_opts modSum

@@ -1,456 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving
-           , TypeFamilies
-           , ViewPatterns
-           , StandaloneDeriving
-           , LambdaCase
-           , FlexibleInstances
-           , FlexibleContexts
-           , TypeSynonymInstances
-           , MultiWayIf
-           , TemplateHaskell
-           , ViewPatterns
-           , TypeApplications
-           #-}
--- | Basic utilities and types for defining refactorings.
-module Language.Haskell.Tools.Refactor.RefactorBase where
-
-import Language.Haskell.Tools.AST as AST
-import Language.Haskell.Tools.AST.Rewrite
-import Language.Haskell.Tools.Transform
-
-import Bag as GHC
-import DynFlags (HasDynFlags(..))
-import ErrUtils as GHC
-import Exception (ExceptionMonad(..))
-import GHC hiding (mkModuleName, moduleNameString)
-import qualified Module as GHC
-import qualified Name as GHC
-import Outputable
-import qualified PrelNames as GHC
-import qualified TyCon as GHC
-import qualified TysWiredIn as GHC
-import SrcLoc
-
-import Control.Exception
-import Control.Monad.Reader
-import qualified Control.Monad.State as LazySt
-import Control.Monad.State.Strict
-import Control.Monad.Trans.Except
-import Control.Monad.Writer
-import Control.Reference hiding (element)
-import Data.Char
-import Data.Either
-import Data.Function (on)
-import qualified Data.Map as Map
-import Data.List
-import Data.List.Split
-import Data.Maybe
-import Data.Typeable
-import System.FilePath
-
--- | A type for the input and result of refactoring a module
-type UnnamedModule dom = Ann AST.UModule dom SrcTemplateStage
-
--- | The name of the module and the AST
-type ModuleDom dom = (SourceFileKey, UnnamedModule dom)
-
--- | Module name and marker to separate .hs-boot module definitions. Specifies a source file in a working directory.
-data SourceFileKey = SourceFileKey { _sfkFileName :: FilePath
-                                   , _sfkModuleName :: String
-                                   }
-  deriving (Eq, Ord, Show)
-
--- | A refactoring that only affects one module
-type LocalRefactoring dom = UnnamedModule dom -> LocalRefactor dom (UnnamedModule dom)
-
--- | The type of a refactoring
-type Refactoring dom = ModuleDom dom -> [ModuleDom dom] -> Refactor [RefactorChange dom]
-
--- | Change in the project, modification or removal of a module.
-data RefactorChange dom = ContentChanged { fromContentChanged :: ModuleDom dom }
-                        | ModuleRemoved { removedModuleName :: String }
-                        | ModuleCreated { createdModuleName :: String
-                                        , createdModuleContent :: UnnamedModule dom
-                                        , sameLocation :: SourceFileKey
-                                        }
-
--- | Exceptions that can occur while loading modules or during internal operations (not during performing the refactor).
-data RefactorException = IllegalExtensions [String]
-                       | SourceCodeProblem ErrorMessages
-                       | ModuleNotInPackage String
-                       | UnknownException String
-  deriving (Show, Typeable)
-
-moduleSourceFile :: String -> FilePath
-moduleSourceFile m = (foldl1 (</>) (splitOn "." m)) <.> "hs"
-
-sourceFileModule :: FilePath -> String
-sourceFileModule fp = intercalate "." $ splitDirectories $ dropExtension fp
-
-
--- | The modules of a library, executable, test or benchmark. A package contains one or more module collection.
-data ModuleCollection
-  = ModuleCollection { _mcId :: ModuleCollectionId
-                     , _mcRoot :: FilePath
-                     , _mcSourceDirs :: [FilePath]
-                     , _mcModules :: Map.Map SourceFileKey ModuleRecord
-                     , _mcFlagSetup :: DynFlags -> IO DynFlags -- ^ Sets up the ghc environment for compiling the modules of this collection
-                     , _mcLoadFlagSetup :: DynFlags -> IO DynFlags -- ^ Sets up the ghc environment for dependency analysis
-                     , _mcDependencies :: [ModuleCollectionId]
-                     }
-
--- | The state of a module.
-data ModuleRecord
-      = ModuleNotLoaded { _recModuleWillNeedCode :: Bool
-                        , _recModuleExposed :: Bool
-                        }
-      | ModuleParsed { _parsedRecModule :: UnnamedModule (Dom RdrName)
-                     , _modRecMS :: ModSummary
-                     }
-      | ModuleRenamed { _renamedRecModule :: UnnamedModule (Dom GHC.Name)
-                      , _modRecMS :: ModSummary
-                      }
-      | ModuleTypeChecked { _typedRecModule :: UnnamedModule IdDom
-                          , _modRecMS :: ModSummary
-                          }
-      | ModuleCodeGenerated { _typedRecModule :: UnnamedModule IdDom
-                            , _modRecMS :: ModSummary
-                            }
-
--- | This data structure identifies a module collection.
-data ModuleCollectionId = DirectoryMC FilePath
-                       | LibraryMC String
-                       | ExecutableMC String String
-                       | TestSuiteMC String String
-                       | BenchmarkMC String String
- deriving (Eq, Ord, Show)
-
--- | A common class for the state of refactoring tools
-class IsRefactSessionState st where
-  refSessMCs :: Simple Lens st [ModuleCollection]
-  initSession :: st
-
-instance Show ErrorMessages where
-  show = show . bagToList
-
-instance Exception RefactorException where
-  displayException (SourceCodeProblem prob)
-    = "Source code problem: " ++ showSDocUnsafe (vcat (pprErrMsgBagWithLoc prob))
-  displayException (IllegalExtensions exts)
-    = "The following extensions are not allowed: " ++ (concat $ intersperse ", " exts) ++ "."
-  displayException (ModuleNotInPackage modName) = "The module is not in the package: " ++ modName
-  displayException (UnknownException ex) = "An unexpected problem appeared: " ++ ex ++ "."
-
-instance Show (RefactorChange dom) where
-  show (ContentChanged (n, _)) = "ContentChanged (" ++ show n  ++ ")"
-  show (ModuleRemoved n) = "ModuleRemoved " ++ n
-  show (ModuleCreated n _ other) = "ModuleCreated " ++ n ++ " (" ++ show other ++ ")"
-
--- | Performs the given refactoring, transforming it into a Ghc action
-runRefactor :: ModuleDom dom -> [ModuleDom dom] -> Refactoring dom -> Ghc (Either String [RefactorChange dom])
-runRefactor mod mods trf = runExceptT $ trf mod mods
-
--- | Wraps a refactoring that only affects one module. Performs the per-module finishing touches.
-localRefactoring :: HasModuleInfo dom => LocalRefactoring dom -> Refactoring dom
-localRefactoring ref (name, mod) _
-  = (\m -> [ContentChanged (name, m)]) <$> localRefactoringRes id mod (ref mod)
-
--- | Transform the result of the local refactoring
-localRefactoringRes :: HasModuleInfo dom
-                    => ((UnnamedModule dom -> UnnamedModule dom) -> a -> a)
-                          -> UnnamedModule dom
-                          -> LocalRefactor dom a
-                          -> Refactor a
-localRefactoringRes access mod trf
-  = let init = RefactorCtx (semanticsModule $ mod ^. semantics) mod (mod ^? modImports&annList)
-     in flip runReaderT init $ do (mod, recorded) <- runWriterT (fromRefactorT trf)
-                                  return $ access (insertText (rights recorded) . addGeneratedImports (lefts recorded)) mod
-
--- | Re-inserts the elements removed from the AST that should be kept (for example preprocessor directives)
-insertText :: SourceInfoTraversal p => [(SrcSpan,String,String)] -> p dom SrcTemplateStage -> p dom SrcTemplateStage
-insertText [] p = p
-insertText inserted p
-  -- this traverses the AST and finds the positions where the removed elements can be added
-  = evalState (sourceInfoTraverseUp (SourceInfoTrf
-                (\stn -> sourceTemplateNodeElems !~ takeWhatPrecedesElem (stn ^. sourceTemplateNodeRange) $ stn)
-                (srcTmpSeparators !~ takeWhatPrecedesSep)
-                pure) (return ()) (return ()) p) (map Right $ sortOn (^. _1) inserted)
-  where
-   -- insert fragments into list separators
-   takeWhatPrecedesSep :: [([SourceTemplateTextElem], SrcSpan)] -> State [Either SrcSpan (SrcSpan,String,String)] [([SourceTemplateTextElem], SrcSpan)]
-   takeWhatPrecedesSep seps = takeWhatPrecedes Nothing (Just . (^. _2))
-                                               (\str -> _1 .- (++ [StayingText str ""]))
-                                               (\str -> _1 .- ([StayingText str ""] ++))
-                                               seps
-
-   -- insert fragments into AST elements
-   takeWhatPrecedesElem :: SrcSpan -> [SourceTemplateElem] -> State [Either SrcSpan (SrcSpan,String,String)] [SourceTemplateElem]
-   takeWhatPrecedesElem rng elems = takeWhatPrecedes (Just rng) (^? sourceTemplateTextRange)
-                                                                (\s -> sourceTemplateTextElem .- (++ [StayingText s ""]))
-                                                                (\s -> sourceTemplateTextElem .- ([StayingText s ""] ++))
-                                                                elems
-
-   -- finds the position of the fragment where there are elements in the template both before and after the fragment
-   -- puts holes into the list of inserted fragments where child elements are located
-   -- uses these holes to determine where should the fragment be added
-   takeWhatPrecedes :: Maybe SrcSpan -> (a -> Maybe SrcSpan) -> (String -> a -> a) -> (String -> a -> a) -> [a] -> State [Either SrcSpan (SrcSpan,String,String)] [a]
-   takeWhatPrecedes rng access append prepend elems
-     | ranges <- mapMaybe access elems
-     , not (null ranges)
-     = do let start = srcSpanStart $ fromMaybe (head ranges) rng
-              end = srcSpanEnd $ fromMaybe (last ranges) rng
-          toInsert <- get
-          let (prefix,rest) = break ((>= start) . srcSpanStart . either id (\(sp,_,_) -> sp)) toInsert
-              (middle,suffix) = break ((> end) . srcSpanEnd . either id (\(sp,_,_) -> sp)) rest
-          put $ prefix ++ Left (mkSrcSpan start end) : suffix
-          return $ mergeInserted access append prepend False middle elems
-     where mergeInserted :: (a -> Maybe SrcSpan) -> (String -> a -> a) -> (String -> a -> a) -> Bool -> [Either SrcSpan (SrcSpan,String,String)] -> [a] -> [a]
-           -- no fragments left
-           mergeInserted _ _ _ _ [] elems = elems
-           mergeInserted access append prepend prep insert@(Right (insertSpan,insertStr,ln):toInsert) (fstElem:elems)
-              -- insert a fragment to the end of the current element if the next elment is after the fragment
-              | Just fstElemSpace <- access fstElem -- TODO: is this needed?
-              , not prep && case mapMaybe access elems of sp:_ -> srcSpanStart sp >= srcSpanEnd insertSpan
-                                                          _ -> True
-              = mergeInserted access append prepend prep toInsert (append (ln ++ insertStr ++ ln) fstElem : elems)
-              -- insert the fragment before the current elem if we need an element before (we skipped a child)
-              -- and the current element is after the inserted fragment
-              | Just fstElemSpace <- access fstElem
-              , prep && srcSpanStart fstElemSpace >= srcSpanEnd insertSpan
-              = mergeInserted access append prepend prep toInsert (prepend (ln ++ insertStr ++ ln) fstElem : elems)
-              | isJust (access fstElem) && prep
-              = mergeInserted access append prepend False insert (fstElem : elems) -- switch back to append mode
-              | otherwise
-              = fstElem : mergeInserted access append prepend (if isJust (access fstElem) then False else prep) insert elems -- move on and switch back to append mode
-           -- when found a hole
-           mergeInserted access append prepend prep insert@(Left sp : toInsert) (fstElem:elems)
-              | Just fstElemSpace <- access fstElem
-              = if srcSpanStart fstElemSpace > srcSpanEnd sp
-                  -- switch to prepend mode
-                  then mergeInserted access append prepend True toInsert (fstElem:elems)
-                  -- skip elements that are not after the fragment
-                  else fstElem : mergeInserted access append prepend prep insert elems
-              | otherwise
-              = fstElem : mergeInserted access append prepend True toInsert elems -- switch to prepend mode and move on
-           mergeInserted _ _ _ _ _ [] = [] -- maybe error
-   takeWhatPrecedes _ _ _ _ elems = return elems
-
--- | Adds the imports that bring names into scope that are needed by the refactoring
-addGeneratedImports :: [GHC.Name] -> Ann UModule dom SrcTemplateStage -> Ann UModule dom SrcTemplateStage
-addGeneratedImports names m = modImports&annListElems .- (++ addImports names) $ m
-  where addImports :: [GHC.Name] -> [Ann UImportDecl dom SrcTemplateStage]
-        addImports names = map createImport $ groupBy ((==) `on` GHC.nameModule) $ filter (isJust . GHC.nameModule_maybe) $ nub $ sort names
-
-        -- TODO: group names like constructors into correct IESpecs
-        createImport :: [GHC.Name] -> Ann UImportDecl dom SrcTemplateStage
-        -- works on groupby result, so list is nonempty
-        createImport names = mkImportDecl False False False Nothing (mkModuleName $ GHC.moduleNameString $ GHC.moduleName $ GHC.nameModule $ head names)
-                                          Nothing (Just $ mkImportSpecList (map (\n -> mkIESpec (mkUnqualName' n) Nothing) names))
-
--- some instances missing from GHC
-
-instance (GhcMonad m, Monoid s) => GhcMonad (WriterT s m) where
-  getSession = lift getSession
-  setSession env = lift (setSession env)
-
-instance (ExceptionMonad m, Monoid s) => ExceptionMonad (WriterT s m) where
-  gcatch w c = WriterT (runWriterT w `gcatch` (runWriterT . c))
-  gmask m = WriterT $ gmask (\f -> runWriterT $ m (WriterT . f . runWriterT))
-
-instance (Monad m, HasDynFlags m) => HasDynFlags (StateT s m) where
-  getDynFlags = lift getDynFlags
-
-instance (GhcMonad m) => GhcMonad (StateT s m) where
-  getSession = lift getSession
-  setSession env = lift (setSession env)
-
-instance (ExceptionMonad m) => ExceptionMonad (StateT s m) where
-  gcatch r c = StateT (\ctx -> runStateT r ctx `gcatch` (flip runStateT ctx . c))
-  gmask m = StateT $ \ctx -> gmask (\f -> runStateT (m (\a -> StateT $ \ctx' -> f (runStateT a ctx'))) ctx)
-
-instance (Monad m, HasDynFlags m) => HasDynFlags (LazySt.StateT s m) where
-  getDynFlags = lift getDynFlags
-
-instance (GhcMonad m) => GhcMonad (LazySt.StateT s m) where
-  getSession = lift getSession
-  setSession env = lift (setSession env)
-
-instance (ExceptionMonad m) => ExceptionMonad (LazySt.StateT s m) where
-  gcatch r c = LazySt.StateT (\ctx -> LazySt.runStateT r ctx `gcatch` (flip LazySt.runStateT ctx . c))
-  gmask m = LazySt.StateT $ \ctx -> gmask (\f -> LazySt.runStateT (m (\a -> LazySt.StateT $ \ctx' -> f (LazySt.runStateT a ctx'))) ctx)
-
-
-instance GhcMonad m => GhcMonad (ReaderT s m) where
-  getSession = lift getSession
-  setSession env = lift (setSession env)
-
-instance ExceptionMonad m => ExceptionMonad (ReaderT s m) where
-  gcatch r c = ReaderT (\ctx -> runReaderT r ctx `gcatch` (flip runReaderT ctx . c))
-  gmask m = ReaderT $ \ctx -> gmask (\f -> runReaderT (m (\a -> ReaderT $ \ctx' -> f (runReaderT a ctx'))) ctx)
-
-instance GhcMonad m => GhcMonad (ExceptT s m) where
-  getSession = lift getSession
-  setSession env = lift (setSession env)
-
-instance ExceptionMonad m => ExceptionMonad (ExceptT s m) where
-  gcatch e c = ExceptT (runExceptT e `gcatch` (runExceptT . c))
-  gmask m = ExceptT $ gmask (\f -> runExceptT $ m (ExceptT . f . runExceptT))
-
-
--- | Input and output information for the refactoring
-newtype LocalRefactorT dom m a = LocalRefactorT { fromRefactorT :: WriterT [Either GHC.Name (SrcSpan, String, String)] (ReaderT (RefactorCtx dom) m) a }
-  deriving (Functor, Applicative, Monad, MonadReader (RefactorCtx dom), MonadWriter [Either GHC.Name (SrcSpan, String, String)], MonadIO, HasDynFlags, ExceptionMonad, GhcMonad)
-
--- | The information a refactoring can use
-data RefactorCtx dom = RefactorCtx { refModuleName :: GHC.Module
-                                   , refCtxRoot :: Ann UModule dom SrcTemplateStage
-                                   , refCtxImports :: [Ann UImportDecl dom SrcTemplateStage]
-                                   }
-
-instance MonadTrans (LocalRefactorT dom) where
-  lift = LocalRefactorT . lift . lift
-
--- | A monad that can be used to refactor
-class Monad m => RefactorMonad m where
-  refactError :: String -> m a
-  liftGhc :: Ghc a -> m a
-
-instance RefactorMonad Refactor where
-  refactError = throwE
-  liftGhc = lift
-
-instance RefactorMonad (LocalRefactor dom) where
-  refactError = lift . refactError
-  liftGhc = lift . liftGhc
-
-instance RefactorMonad m => RefactorMonad (StateT s m) where
-  refactError = lift . refactError
-  liftGhc = lift . liftGhc
-
-instance RefactorMonad m => RefactorMonad (LazySt.StateT s m) where
-  refactError = lift . refactError
-  liftGhc = lift . liftGhc
-
--- | The refactoring monad for a given module
-type LocalRefactor dom = LocalRefactorT dom Refactor
-
--- | The refactoring monad for the whole project
-type Refactor = ExceptT String Ghc
-
-registeredNamesFromPrelude :: [GHC.Name]
-registeredNamesFromPrelude = GHC.basicKnownKeyNames ++ map GHC.tyConName GHC.wiredInTyCons
-
-otherNamesFromPrelude :: [String]
-otherNamesFromPrelude
- -- TODO: extend and revise this list
- -- TODO: prelude names are simply existing names?? No need to check??
-  = ["GHC.Base.Maybe", "GHC.Base.Just", "GHC.Base.Nothing", "GHC.Base.maybe", "GHC.Base.either", "GHC.Base.not"
-    , "Data.Tuple.curry", "Data.Tuple.uncurry", "GHC.Base.compare", "GHC.Base.max", "GHC.Base.min", "GHC.Base.id"]
-
-qualifiedName :: GHC.Name -> String
-qualifiedName name = case GHC.nameModule_maybe name of
-  Just mod -> GHC.moduleNameString (GHC.moduleName mod) ++ "." ++ GHC.occNameString (GHC.nameOccName name)
-  Nothing -> GHC.occNameString (GHC.nameOccName name)
-
-referenceName :: (HasImportInfo dom, HasModuleInfo dom) => GHC.Name -> LocalRefactor dom (Ann UName dom SrcTemplateStage)
-referenceName = referenceName' mkQualName'
-
-referenceOperator :: (HasImportInfo dom, HasModuleInfo dom) => GHC.Name -> LocalRefactor dom (Ann UOperator dom SrcTemplateStage)
-referenceOperator = referenceName' mkQualOp'
-
--- | Create a name that references the definition. Generates an import if the definition is not yet imported.
-referenceName' :: (HasImportInfo dom, HasModuleInfo dom)
-               => ([String] -> GHC.Name -> Ann nt dom SrcTemplateStage) -> GHC.Name -> LocalRefactor dom (Ann nt dom SrcTemplateStage)
-referenceName' makeName name
-  | name `elem` registeredNamesFromPrelude || qualifiedName name `elem` otherNamesFromPrelude
-  = return $ makeName [] name -- imported from prelude
-  | otherwise
-  = do RefactorCtx {refCtxRoot = mod, refCtxImports = imports, refModuleName = thisModule} <- ask
-       if maybe True (thisModule ==) (GHC.nameModule_maybe name)
-         then return $ makeName [] name -- in the same module, use simple name
-         else let possibleImports = filter ((name `elem`) . (\imp -> semanticsImported $ imp ^. semantics)) imports
-                  fromPrelude = name `elem` semanticsImplicitImports (mod ^. semantics)
-               in if | fromPrelude -> return $ makeName [] name
-                     | null possibleImports -> do tell [Left name]
-                                                  return $ makeName [] name
-                     | otherwise -> return $ referenceBy makeName name possibleImports
-                                     -- use it according to the best available import
-
--- | Reference the name by the shortest suitable import
-referenceBy :: ([String] -> GHC.Name -> Ann nt dom SrcTemplateStage) -> GHC.Name -> [Ann UImportDecl dom SrcTemplateStage] -> Ann nt dom SrcTemplateStage
-referenceBy makeName name imps =
-  let prefixes = map importQualifier imps
-   in makeName (minimumBy (compare `on` (length . concat)) prefixes) name
-  where importQualifier :: Ann UImportDecl dom SrcTemplateStage -> [String]
-        importQualifier imp
-          = if isJust (imp ^? importQualified&annJust)
-              then case imp ^? importAs&annJust&importRename of
-                      Nothing -> splitOn "." (imp ^. importModule&moduleNameString) -- fully qualified import
-                      Just asName -> splitOn "." (asName ^. moduleNameString) -- the name given by as clause
-              else [] -- unqualified import
-
--- | Different classes of definitions that have different kind of names.
-data NameClass = Variable         -- ^ Normal value definitions: functions, variables
-               | Ctor             -- ^ Data constructors
-               | ValueOperator    -- ^ Functions with operator-like names
-               | DataCtorOperator -- ^ Constructors with operator-like names
-               | SynonymOperator  -- ^ UType definitions with operator-like names
-
--- | Get which category does a given name belong to
-classifyName :: RefactorMonad m => GHC.Name -> m NameClass
-classifyName n = liftGhc (lookupName n) >>= return . \case
-    Just (AnId {}) | isop     -> ValueOperator
-    Just (AnId {})            -> Variable
-    Just (AConLike {}) | isop -> DataCtorOperator
-    Just (AConLike {})        -> Ctor
-    Just (ATyCon {}) | isop   -> SynonymOperator
-    Just (ATyCon {})          -> Ctor
-    Just (ACoAxiom {})        -> error "classifyName: ACoAxiom"
-    Nothing | isop            -> ValueOperator
-    Nothing                   -> Variable
-  where isop = GHC.isSymOcc (GHC.getOccName n)
-
--- | Checks if a given name is a valid module name
-validModuleName :: String -> Maybe String
-validModuleName s = foldl mappend mempty $ map (nameValid Ctor) (splitOn "." s)
-
--- | Check if a given name is valid for a given kind of definition
-nameValid :: NameClass -> String -> Maybe String
-nameValid _ "" = Just "An empty name is not valid"
-nameValid _ str | str `elem` reservedNames = Just $ "'" ++ str ++ "' is a reserved name"
-  where -- TODO: names reserved by extensions
-        reservedNames = [ "case", "class", "data", "default", "deriving", "do", "else", "if", "import", "in", "infix"
-                        , "infixl", "infixr", "instance", "let", "module", "newtype", "of", "then", "type", "where", "_"
-                        , "..", ":", "::", "=", "\\", "|", "<-", "->", "@", "~", "=>", "[]"
-                        ]
--- Operators that are data constructors (must start with ':')
-nameValid DataCtorOperator (':' : nameRest) | all isOperatorChar nameRest = Nothing
-nameValid DataCtorOperator _ = Just "A constructor operator must start with ':' and only contain operator characters."
--- Type families and synonyms that are operators (can start with ':')
-nameValid SynonymOperator name | all isOperatorChar name = Nothing
-nameValid SynonymOperator _ = Just "An operator must only contain operator characters."
--- Normal value operators (cannot start with ':')
-nameValid ValueOperator (c : nameRest) | isOperatorChar c && c /= ':' && all isOperatorChar nameRest = Nothing
-nameValid ValueOperator _ = Just "An operator that is a value must only contain operator characters and cannot start with ':'"
--- Data and type constructors (start with uppercase)
-nameValid Ctor (c : nameRest) | isUpper c && isIdStartChar c && all (\c -> isIdStartChar c || isDigit c) nameRest = Nothing
-nameValid Ctor _ = Just "A constructor or module name must start with an uppercase letter, and only contain letters, digits, apostrhophe or underscore"
--- Variables and type variables (start with lowercase)
-nameValid Variable (c : nameRest) | isLower c && isIdStartChar c && all (\c -> isIdStartChar c || isDigit c) nameRest = Nothing
-nameValid Variable _ = Just "The name of a value must start with lowercase, and only contain letters, digits, apostrhophe or underscore"
-
-isIdStartChar :: Char -> Bool
-isIdStartChar c = (isLetter c && isAscii c) || c == '\'' || c == '_'
-
-isOperatorChar :: Char -> Bool
-isOperatorChar c = (isPunctuation c || isSymbol c) && isAscii c
-
-makeReferences ''SourceFileKey
-makeReferences ''ModuleCollection
-makeReferences ''ModuleRecord
-
-
-findModule :: (IsRefactSessionState st, Monad m) => String -> StateT st m [FilePath]
-findModule m = do
-  mods <- gets (^? refSessMCs & traversal & mcModules)
-  return $ concatMap @[] (map (^. sfkFileName) . filter ((== m) . (^. sfkModuleName)) . Map.keys) mods

@@ -0,0 +1,58 @@+-- | Defines a representation to represent refactorings that can be executed on the codebase.
+-- Refactorings are differentiated on their signatures (inputs needed to execute).
+module Language.Haskell.Tools.Refactor.Refactoring where
+
+import Control.Monad.Trans.Except (runExceptT)
+import Data.List ((++), map, find)
+
+import GHC (RealSrcSpan, Ghc)
+
+import Language.Haskell.Tools.AST ()
+import Language.Haskell.Tools.Refactor.Monad (ProjectRefactoring, Refactoring)
+import Language.Haskell.Tools.Refactor.Prepare (correctRefactorSpan, readSrcSpan)
+import Language.Haskell.Tools.Refactor.Representation (RefactorChange, ModuleDom)
+
+-- | The signature and behavior of one refactoring that can be executed.
+data RefactoringChoice dom
+  = NamingRefactoring { refactoringName :: String
+                      , namingRefactoring :: RealSrcSpan -> String -> Refactoring dom
+                      }
+  | SelectionRefactoring { refactoringName :: String
+                         , selectionRefactoring :: RealSrcSpan -> Refactoring dom
+                         }
+  | ModuleRefactoring { refactoringName :: String
+                      , moduleRefactoring :: Refactoring dom
+                      }
+  | ProjectRefactoring { refactoringName :: String
+                       , projectRefactoring :: ProjectRefactoring dom
+                       }
+
+-- | Executes a given command (choosen from the set of available refactorings) on the selected
+-- module and given other modules.
+performCommand :: [RefactoringChoice dom] -- ^ The set of available refactorings
+                    -> [String] -- ^ The refactoring command
+                    -> Either FilePath (ModuleDom dom) -- ^ The module in which the refactoring is performed
+                    -> [ModuleDom dom] -- ^ Other modules
+                    -> Ghc (Either String [RefactorChange dom])
+performCommand refactorings (name:args) mod mods =
+    case (refactoring, mod, args) of
+      (Just (NamingRefactoring _ trf), Right mod, (sp:newName:_))
+        -> runExceptT $ trf (correctRefactorSpan (snd mod) $ readSrcSpan sp) newName mod mods
+      (Just (NamingRefactoring _ _), Right _, _)
+        -> return $ Left $ "The refactoring '" ++ name
+                             ++ "' needs two argument: a source range and a name"
+      (Just (SelectionRefactoring _ trf), Right mod, (sp:_))
+        -> runExceptT $ trf (correctRefactorSpan (snd mod) $ readSrcSpan sp) mod mods
+      (Just (SelectionRefactoring _ _), Right _, _)
+        -> return $ Left $ "The refactoring '" ++ name ++ "' needs one argument: a source range"
+      (Just (ModuleRefactoring _ trf), Right mod, _) -> runExceptT $ trf mod mods
+      (Just (ProjectRefactoring _ trf), _, _) -> runExceptT $ trf mods
+      (Just _, Left modPath, _)
+        -> return $ Left $ "The following file is not loaded to Haskell-tools: " ++ modPath
+                             ++ ". Please add the containing package."
+      (Nothing, _, _) -> return $ Left $ "Unknown command: " ++ name
+  where refactoring = find ((== name) . refactoringName) refactorings
+
+-- | Gets the name of possible refactorings.
+refactorCommands :: [RefactoringChoice dom] -> [String]
+refactorCommands = map refactoringName

@@ -0,0 +1,70 @@+{-# LANGUAGE RecordWildCards
+           , TypeSynonymInstances
+           , FlexibleInstances
+           , TemplateHaskell
+           #-}
+-- | Representation of modules, their collections, refactoring changes and exceptions.
+module Language.Haskell.Tools.Refactor.Representation where
+
+import Control.Exception
+import Control.Reference
+import Data.List
+import Data.List.Split
+import Data.Typeable
+import System.FilePath
+
+import Bag (bagToList)
+import ErrUtils as GHC
+import Outputable
+
+import Language.Haskell.Tools.AST as AST
+
+-- | A type for the input and result of refactoring a module
+type UnnamedModule dom = Ann AST.UModule dom SrcTemplateStage
+
+-- | The name of the module and the AST
+type ModuleDom dom = (SourceFileKey, UnnamedModule dom)
+
+-- | Module name and marker to separate .hs-boot module definitions. Specifies a source file in a working directory.
+data SourceFileKey = SourceFileKey { _sfkFileName :: FilePath
+                                   , _sfkModuleName :: String
+                                   }
+  deriving (Eq, Ord, Show)
+
+-- | Change in the project, modification or removal of a module.
+data RefactorChange dom = ContentChanged { fromContentChanged :: ModuleDom dom }
+                        | ModuleRemoved { removedModuleName :: String }
+                        | ModuleCreated { createdModuleName :: String
+                                        , createdModuleContent :: UnnamedModule dom
+                                        , sameLocation :: SourceFileKey
+                                        }
+instance Show (RefactorChange dom) where
+  show (ContentChanged (n, _)) = "ContentChanged (" ++ show n  ++ ")"
+  show (ModuleRemoved n) = "ModuleRemoved " ++ n
+  show (ModuleCreated n _ other) = "ModuleCreated " ++ n ++ " (" ++ show other ++ ")"
+
+-- | Exceptions that can occur while loading modules or during internal operations (not during performing the refactor).
+data RefactorException = IllegalExtensions [String]
+                       | SourceCodeProblem ErrorMessages
+                       | UnknownException String
+  deriving (Show, Typeable)
+
+instance Show ErrorMessages where
+  show = show . bagToList
+
+instance Exception RefactorException where
+  displayException (SourceCodeProblem prob)
+    = "Source code problem: " ++ showSDocUnsafe (vcat (pprErrMsgBagWithLoc prob))
+  displayException (IllegalExtensions exts)
+    = "The following extensions are not allowed: " ++ (concat $ intersperse ", " exts) ++ "."
+  displayException (UnknownException ex) = "An unexpected problem appeared: " ++ ex ++ "."
+
+-- | Transforms module name to a .hs file name relative to the source root directory.
+moduleSourceFile :: String -> FilePath
+moduleSourceFile m = (foldl1 (</>) (splitOn "." m)) <.> "hs"
+
+-- | Transforms a source root relative file name into module name.
+sourceFileModule :: FilePath -> String
+sourceFileModule fp = intercalate "." $ splitDirectories $ dropExtension fp
+
+makeReferences ''SourceFileKey

@@ -1,257 +0,0 @@-{-# LANGUAGE TemplateHaskell
-           , TupleSections
-           , TypeApplications
-           #-}
--- | Common operations for managing refactoring sessions, for example loading packages, re-loading modules.
-module Language.Haskell.Tools.Refactor.Session where
-
-import Control.Applicative ((<|>))
-import Control.Exception
-import Control.Monad.State.Strict
-import Control.Reference
-import qualified Data.List as List
-import qualified Data.Map as Map
-import Data.Maybe
-import System.FilePath
-import System.IO
-
-import Data.IntSet (member)
-import Digraph as GHC
-import ErrUtils
-import Exception (ExceptionMonad)
-import FastString as GHC
-import GHC
-import DynFlags
-import HscTypes as GHC
-import Language.Haskell.TH.LanguageExtensions
-import Outputable
-
-import Language.Haskell.Tools.AST (IdDom)
-import Language.Haskell.Tools.Refactor.GetModules
-import Language.Haskell.Tools.Refactor.Prepare
-import Language.Haskell.Tools.Refactor.RefactorBase
-
--- | The state common for refactoring tools, carrying the state of modules.
-data RefactorSessionState
-  = RefactorSessionState { __refSessMCs :: [ModuleCollection]
-                         }
-
-makeReferences ''RefactorSessionState
-
-instance IsRefactSessionState RefactorSessionState where
-  refSessMCs = _refSessMCs
-  initSession = RefactorSessionState []
-
--- | Load packages from the given directories. Loads modules, performs the given callback action, warns for duplicate modules.
-loadPackagesFrom :: IsRefactSessionState st => (ModSummary -> IO a) -> ([ModSummary] -> IO ()) -> (st -> FilePath -> IO [FilePath]) -> [FilePath] -> StateT st Ghc (Either RefactorException [a])
-loadPackagesFrom report loadCallback additionalSrcDirs packages =
-  do modColls <- liftIO $ getAllModules packages
-     modify $ refSessMCs .- (++ modColls)
-     allModColls <- gets (^. refSessMCs)
-     st <- get
-     moreSrcDirs <- liftIO $ mapM (additionalSrcDirs st) packages
-     lift $ useDirs ((modColls ^? traversal & mcSourceDirs & traversal) ++ concat moreSrcDirs)
-     let fileNames = map (^. sfkFileName) $ concat
-                      $ map (Map.keys . Map.filter (\v -> fromMaybe True (v ^? recModuleExposed)))
-                      $ modColls ^? traversal & mcModules
-         alreadyLoadedFilesInOtherPackages
-           = concatMap (map (^. sfkFileName) . Map.keys . Map.filter (isJust . (^? typedRecModule)) . (^. mcModules))
-                       (filter (\mc -> (mc ^. mcRoot) `notElem` packages) allModColls)
-     targets <- map targetId <$> (lift getTargets)
-     lift $ mapM_ (\t -> when (targetId t `notElem` targets) (addTarget t))
-          $ map (\f -> (Target (TargetFile f Nothing) True Nothing)) fileNames
-     handleErrors $ withAlteredDynFlags (liftIO . setupLoadFlags allModColls) $ do
-       modsForColls <- lift $ depanal [] True
-       let modsToParse = flattenSCCs $ topSortModuleGraph False modsForColls Nothing
-           actuallyCompiled = filter (\ms -> getModSumOrig ms `notElem` alreadyLoadedFilesInOtherPackages) modsToParse
-       liftIO $ loadCallback actuallyCompiled-       void $ checkEvaluatedMods (\_ -> return ()) actuallyCompiled-       mods <- mapM (loadModule report) actuallyCompiled
-       return mods
-
-  where loadModule :: IsRefactSessionState st => (ModSummary -> IO a) -> ModSummary -> StateT st Ghc a
-        loadModule report ms-          = do needsCodeGen <- gets (needsGeneratedCode (keyFromMS ms) . (^. refSessMCs))-               reloadModule report (if needsCodeGen then forceCodeGen ms else ms)
-
--- | Handle GHC exceptions and RefactorException.
-handleErrors :: ExceptionMonad m => m a -> m (Either RefactorException a)
-handleErrors action = handleSourceError (return . Left . SourceCodeProblem . srcErrorMessages) (Right <$> action)
-                        `gcatch` (return . Left)
-
-keyFromMS :: ModSummary -> SourceFileKey
-keyFromMS ms = SourceFileKey (normalise $ getModSumOrig ms) (modSumName ms)
-
-getMods :: (Monad m, IsRefactSessionState st)
-        => Maybe SourceFileKey -> StateT st m ( Maybe (SourceFileKey, UnnamedModule IdDom)
-                                              , [(SourceFileKey, UnnamedModule IdDom)] )
-getMods actMod
-  = do mcs <- gets (^. refSessMCs)
-       return $ ( (_2 !~ (^? typedRecModule)) =<< flip lookupModInSCs mcs =<< actMod
-                , filter ((actMod /=) . Just . fst) $ concatMap (catMaybes . map (_2 !~ (^? typedRecModule)) . Map.assocs . (^. mcModules)) mcs )
-
-getFileMods :: (GhcMonad m, IsRefactSessionState st)
-        => FilePath -> StateT st m ( Maybe (SourceFileKey, UnnamedModule IdDom)
-                                   , [(SourceFileKey, UnnamedModule IdDom)] )
-getFileMods fname
-  = do mcs <- gets (^. refSessMCs)
-       let mods = map (\(k,m) -> (fromMaybe (error $ "getFileMods: module not loaded: " ++ show m) $ m ^? modRecMS, k))
-                      (concatMap Map.assocs $ (mcs ^? traversal & mcModules :: [Map.Map SourceFileKey ModuleRecord]))
-       let sfs = catMaybes $ map (\(ms,k) -> if Just fname == fmap normalise (ml_hs_file (ms_location ms)) then Just k else Nothing) mods
-       case sfs of sf:_ -> getMods (Just sf)
-                   [] -> getMods Nothing
-
--- | Reload the modules that have been changed (given by predicate). Pefrom the callback.
-reloadChangedModules :: IsRefactSessionState st => (ModSummary -> IO a) -> ([ModSummary] -> IO ()) -> (ModSummary -> Bool) -> StateT st Ghc (Either RefactorException [a])
-reloadChangedModules report loadCallback isChanged = handleErrors $ do
-  reachable <- getReachableModules loadCallback isChanged
-  void $ checkEvaluatedMods report reachable
-  mapM (reloadModule report) reachable
-
-getReachableModules :: IsRefactSessionState st => ([ModSummary] -> IO ()) -> (ModSummary -> Bool) -> StateT st Ghc [ModSummary]
-getReachableModules loadCallback selected = do
-  allModColls <- gets (^. refSessMCs)
-  withAlteredDynFlags (liftIO . setupLoadFlags allModColls) $ do
-    allMods <- lift $ depanal [] True
-    let (allModsGraph, lookup) = moduleGraphNodes False allMods
-        changedMods = catMaybes $ map (\ms -> lookup (ms_hsc_src ms) (moduleName $ ms_mod ms))
-                        $ filter selected allMods
-        recompMods = map (ms_mod . getModFromNode) $ reachablesG (transposeG allModsGraph) changedMods
-        sortedMods = reverse $ topologicalSortG allModsGraph
-        sortedRecompMods = filter ((`elem` recompMods) . ms_mod) $ map getModFromNode sortedMods
-    liftIO $ loadCallback sortedRecompMods
-    return sortedRecompMods
-
--- | Reload a given module. Perform a callback.
-reloadModule :: IsRefactSessionState st => (ModSummary -> IO a) -> ModSummary -> StateT st Ghc a
-reloadModule report ms = do
-  mcs <- gets (^. refSessMCs)
-  let fp = getModSumOrig ms
-      modName = modSumName ms
-      codeGen = needsGeneratedCode (keyFromMS ms) mcs
-  case lookupSourceFileColl fp mcs <|> lookupModuleColl modName mcs of
-    Just mc -> do
-      let dfs = ms_hspp_opts ms
-      dfs' <- liftIO $ compileInContext mc mcs dfs
-      let ms' = ms { ms_hspp_opts = dfs' }
-      newm <- lift $ withAlteredDynFlags (\_ -> return (ms_hspp_opts ms')) $
-        parseTyped (mc ^. mcRoot) (if codeGen then forceCodeGen ms' else ms')
-      modify $ refSessMCs & traversal & filtered (== mc) & mcModules
-                 .- Map.insert (keyFromMS ms) ((if codeGen then ModuleCodeGenerated else ModuleTypeChecked) newm ms)
-      liftIO $ report ms
-    Nothing -> liftIO $ throwIO $ ModuleNotInPackage modName
-
-checkEvaluatedMods :: IsRefactSessionState st => (ModSummary -> IO a) -> [ModSummary] -> StateT st Ghc [a]
-checkEvaluatedMods report mods = do
-    mcs <- gets (^. refSessMCs)
-    let lookupFlags ms = maybe return (^. mcFlagSetup) mc
-          where modName = modSumName ms
-                mc = lookupModuleColl modName mcs
-
-    modsNeedCode <- lift (getEvaluatedMods mods lookupFlags)
-    mcs <- gets (^. refSessMCs)
-    res <- forM modsNeedCode $ \ms -> reloadIfNeeded ms mcs
-    return $ catMaybes res
-  where reloadIfNeeded ms mcs
-          = let key = keyFromMS ms
-              in if not (hasGeneratedCode key mcs)
-                   then do md <- gets (^. refSessMCs)
-                           modify $ refSessMCs .- codeGeneratedFor key
-                           md <- gets (^. refSessMCs)
-                           if (isAlreadyLoaded key mcs) then
-                               -- The module is already loaded but code is not generated. Need to reload.
-                               Just <$> lift (codeGenForModule report (codeGeneratedFor key mcs) ms)
-                             else return Nothing
-                   else return Nothing
-
--- | Re-load the module with code generation enabled. Must be used when the module had already been loaded,
--- but code generation were not enabled by then.
-codeGenForModule :: (ModSummary -> IO a) -> [ModuleCollection] -> ModSummary -> Ghc a
-codeGenForModule report mcs ms
-  = let modName = modSumName ms
-        mc = fromMaybe (error $ "codeGenForModule: The following module is not found: " ++ modName) $ lookupModuleColl modName mcs
-     in -- TODO: don't recompile, only load?
-        do withAlteredDynFlags (liftIO . compileInContext mc mcs)
-             $ void $ parseTyped (mc ^. mcRoot) (forceCodeGen ms)
-           liftIO $ report ms
-
--- | Check which modules can be reached from the module, if it uses template haskell.
-getEvaluatedMods :: [ModSummary] -> (ModSummary -> DynFlags -> IO DynFlags) -> Ghc [GHC.ModSummary]
--- We cannot really get the modules that need to be linked, because we cannot rename splice content if the
--- module is not type checked and that is impossible if the splice cannot be evaluated.
-getEvaluatedMods mods additionalFlags
-  = do allMods <- getModuleGraph
-       flags <- getSessionDynFlags
-       let (allModsGraph, lookup) = moduleGraphNodes False allMods
-       -- some flags are stored only in the module collection and are not recorded in the summary
-       thmods <- liftIO $ filterM (\ms -> ((|| isTH ms) . xopt TemplateHaskell) <$> additionalFlags ms flags) mods
-       let modsWithTH = catMaybes $ map (\ms -> lookup (ms_hsc_src ms) (moduleName $ ms_mod ms)) thmods
-           recompMods = map (moduleName . ms_mod . getModFromNode) $ reachablesG allModsGraph modsWithTH
-           sortedMods = map getModFromNode $ reverse $ topologicalSortG allModsGraph
-           sortedTHMods = filter ((`elem` recompMods) . moduleName . ms_mod) sortedMods
-       return sortedTHMods
-  where isTH mod = fromEnum TemplateHaskell `member` extensionFlags (ms_hspp_opts mod)
-
-
-modSumName :: ModSummary -> String
-modSumName = GHC.moduleNameString . moduleName . ms_mod
-
--- * code copied from GHC because it is not public in GhcMake module
-
-type NodeKey   = (ModuleName, HscSource)
-type NodeMap a = Map.Map NodeKey a
-type SummaryNode = (ModSummary, Int, [Int])
-
-getModFromNode :: SummaryNode -> ModSummary
-getModFromNode (ms, _, _) = ms
-
-moduleGraphNodes :: Bool -> [ModSummary]
-  -> (Graph SummaryNode, HscSource -> ModuleName -> Maybe SummaryNode)
-moduleGraphNodes drop_hs_boot_nodes summaries = (graphFromEdgedVertices nodes, lookup_node)
-  where
-    numbered_summaries = zip summaries [1..]
-
-    lookup_node :: HscSource -> ModuleName -> Maybe SummaryNode
-    lookup_node hs_src mod = Map.lookup (mod, hs_src) node_map
-
-    lookup_key :: HscSource -> ModuleName -> Maybe Int
-    lookup_key hs_src mod = fmap summaryNodeKey (lookup_node hs_src mod)
-
-    node_map :: NodeMap SummaryNode
-    node_map = Map.fromList [ ((moduleName (ms_mod s), (ms_hsc_src s)), node)
-                            | node@(s, _, _) <- nodes ]
-
-    nodes :: [SummaryNode]
-    nodes = [ (s, key, out_keys)
-            | (s, key) <- numbered_summaries
-            , not (isBootSummary s && drop_hs_boot_nodes)
-            , let out_keys = out_edge_keys hs_boot_key (map unLoc (ms_home_srcimps s)) ++
-                             out_edge_keys HsSrcFile   (map unLoc (ms_home_imps s)) ++
-                             (-- see [boot-edges] below
-                              if drop_hs_boot_nodes || ms_hsc_src s == HsBootFile
-                              then []
-                              else case lookup_key HsBootFile (ms_mod_name s) of
-                                    Nothing -> []
-                                    Just k  -> [k]) ]
-
-    hs_boot_key | drop_hs_boot_nodes = HsSrcFile
-                | otherwise          = HsBootFile
-
-    out_edge_keys :: HscSource -> [ModuleName] -> [Int]
-    out_edge_keys hi_boot ms = mapMaybe (lookup_key hi_boot) ms
-
-summaryNodeKey :: SummaryNode -> Int
-summaryNodeKey (_, k, _) = k
-
-ms_home_imps :: ModSummary -> [Located ModuleName]
-ms_home_imps = home_imps . ms_imps
-
-ms_home_srcimps :: ModSummary -> [Located ModuleName]
-ms_home_srcimps = home_imps . ms_srcimps
-
-home_imps :: [(Maybe FastString, Located ModuleName)] -> [Located ModuleName]
-home_imps imps = [ lmodname |  (mb_pkg, lmodname) <- imps,
-                                  isLocal mb_pkg ]
-  where isLocal Nothing = True
-        isLocal (Just pkg) | pkg == fsLit "this" = True -- "this" is special
-        isLocal _ = False

@@ -0,0 +1,40 @@+{-# LANGUAGE LambdaCase, TupleSections, AllowAmbiguousTypes #-}
+-- | Operations for changing the AST
+module Language.Haskell.Tools.Refactor.Utils.AST (removeChild, removeSeparator) where
+
+import Control.Monad.State (Monad(..), mapM_)
+import Control.Monad.Writer
+import Control.Reference
+import Data.List
+import Data.Maybe (Maybe(..), mapMaybe, catMaybes)
+import Language.Haskell.Tools.AST (SrcTemplateStage, SourceInfoTrf(..), SourceInfoTraversal(..))
+import Language.Haskell.Tools.PrettyPrint.Prepare
+import Language.Haskell.Tools.Refactor.Monad (LocalRefactor)
+import SrcLoc (SrcSpan)
+
+import Data.Either (Either(..))
+
+-- | Remove a separator from the AST while keeping the textual parts of it that should not be removed (like preprocessor pragmas).
+removeSeparator :: ([SourceTemplateTextElem], SrcSpan) -> LocalRefactor dom ()
+removeSeparator (txts, range) = tell [Right (range, intercalate lineEnd staying, lineEnd)]
+  where staying = catMaybes $ map (\case StayingText str _ -> Just str; _ -> Nothing) txts
+        lineEnd = head $ (catMaybes $ map (\case StayingText _ lnEnd -> Just lnEnd; _ -> Nothing) txts) ++ [""]
+
+-- | Remove an element from the AST while keeping the textual parts of it that should not be removed (like preprocessor pragmas).
+removeChild :: (SourceInfoTraversal e) => e dom SrcTemplateStage -> LocalRefactor dom ()
+removeChild e = tell $ map Right $ keptText e
+
+-- | Extracts all text elements that should be kept
+keptText :: SourceInfoTraversal e => e dom SrcTemplateStage -> [(SrcSpan,String,String)]
+keptText = execWriter . sourceInfoTraverse (SourceInfoTrf
+  (\ni -> mapM_ writeStaying (mapMaybe (\case (TextElem elems range) -> Just (elems,range)
+                                              _ -> Nothing)
+                                       (ni ^? sourceTemplateNodeElems & traversal)) >> return ni)
+  (\ni -> mapM_ writeStaying (ni ^. srcTmpSeparators) >> return ni)
+  pure)
+
+-- | Writes the elements to be kept into a writer monad with ranges and default line ending.
+writeStaying :: ([SourceTemplateTextElem], SrcSpan) -> Writer [(SrcSpan,String,String)] ()
+writeStaying (txts, range) = tell staying
+  where staying = mapMaybe (\case StayingText str lnEnd -> Just (range, str, lnEnd)
+                                  _ -> Nothing) txts

@@ -0,0 +1,77 @@+{-# LANGUAGE FlexibleContexts
+           , TypeFamilies
+           #-}
+-- | Utilities for transformations that work on both top-level and local definitions
+module Language.Haskell.Tools.Refactor.Utils.BindingElem where
+
+import Control.Reference
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.Rewrite
+import SrcLoc (RealSrcSpan)
+
+-- | A type class for handling definitions that can appear as both top-level and local definitions
+class NamedElement d => BindingElem d where
+
+  -- | Accesses a type signature definition in a local or top-level definition
+  sigBind :: Simple Partial (Ann d dom SrcTemplateStage) (TypeSignature dom)
+
+  -- | Accesses a value or function definition in a local or top-level definition
+  valBind :: Simple Partial (Ann d dom SrcTemplateStage) (ValueBind dom)
+
+  -- | Accesses a type signature definition in a local or top-level definition
+  fixitySig :: Simple Partial (Ann d dom SrcTemplateStage) (FixitySignature dom)
+
+  -- | Creates a new definition from a type signature
+  createTypeSig :: TypeSignature dom -> Ann d dom SrcTemplateStage
+
+  -- | Creates a new definition from a value or function definition
+  createBinding :: ValueBind dom -> Ann d dom SrcTemplateStage
+
+  -- | Creates a new fixity signature
+  createFixitySig :: FixitySignature dom -> Ann d dom SrcTemplateStage
+
+  -- | Checks if a given definition is a type signature
+  isTypeSig :: Ann d dom SrcTemplateStage -> Bool
+
+  -- | Checks if a given definition is a function or value binding
+  isBinding :: Ann d dom SrcTemplateStage -> Bool
+
+  -- | Checks if a given definition is a fixity signature
+  isFixitySig :: Ann d dom SrcTemplateStage -> Bool
+
+instance BindingElem UDecl where
+  sigBind = declTypeSig
+  valBind = declValBind
+  fixitySig = declFixity
+  createTypeSig = mkTypeSigDecl
+  createBinding = mkValueBinding
+  createFixitySig = mkFixityDecl
+  isTypeSig TypeSigDecl {} = True
+  isTypeSig _ = False
+  isBinding ValueBinding {} = True
+  isBinding _ = False
+  isFixitySig FixityDecl {} = True
+  isFixitySig _ = False
+
+instance BindingElem ULocalBind where
+  sigBind = localSig
+  valBind = localVal
+  fixitySig = localFixity
+  createTypeSig = mkLocalTypeSig
+  createBinding = mkLocalValBind
+  createFixitySig = mkLocalFixity
+  isTypeSig LocalTypeSig {} = True
+  isTypeSig _ = False
+  isBinding LocalValBind {} = True
+  isBinding _ = False
+  isFixitySig LocalFixity {} = True
+  isFixitySig _ = False
+
+getValBindInList :: (BindingElem d) => RealSrcSpan -> AnnListG d dom SrcTemplateStage -> Maybe (ValueBind dom)
+getValBindInList sp ls = case ls ^? valBindsInList & filtered (isInside sp) of
+  [] -> Nothing
+  [n] -> Just n
+  _ -> error "getValBindInList: Multiple nodes"
+
+valBindsInList :: BindingElem d => Simple Traversal (AnnListG d dom SrcTemplateStage) (ValueBind dom)
+valBindsInList = annList & valBind

@@ -0,0 +1,49 @@+{-# LANGUAGE LambdaCase
+           , RankNTypes
+           , FlexibleContexts
+           #-}
+-- | Helper functions for defining refactorings.
+module Language.Haskell.Tools.Refactor.Utils.Helpers where
+
+import Control.Monad.State ()
+import Control.Reference
+import Data.Function (on)
+import Data.List (sortBy, nubBy)
+import Data.Maybe (Maybe(..))
+
+import Language.Haskell.Tools.AST as AST
+import Language.Haskell.Tools.Refactor.Utils.Lists (filterList)
+import Language.Haskell.Tools.Rewrite as AST
+
+import SrcLoc (srcSpanStart)
+
+replaceWithJust :: Ann e dom SrcTemplateStage -> AnnMaybe e dom -> AnnMaybe e dom
+replaceWithJust e = annMaybe .= Just e
+
+replaceWithNothing :: AnnMaybe e dom -> AnnMaybe e dom
+replaceWithNothing = annMaybe .= Nothing
+
+-- | Remove the container (where or let) when the last binding is removed.
+removeEmptyBnds :: Simple Traversal (Module dom) (ValueBind dom)
+                     -> Simple Traversal (Module dom) (Expr dom)
+                     -> AST.Module dom -> AST.Module dom
+removeEmptyBnds binds exprs = (binds .- removeEmptyBindsAndGuards) . (exprs .- removeEmptyLetsAndStmts)
+  where removeEmptyBindsAndGuards sb@(SimpleBind _ _ _)
+          = (valBindLocals .- removeIfEmpty) . (valBindRhs .- removeEmptyGuards) $ sb
+        removeEmptyBindsAndGuards fb@(FunctionBind _)
+          = (funBindMatches & annList & matchBinds .- removeIfEmpty) . (funBindMatches & annList & matchRhs .- removeEmptyGuards) $ fb
+
+        removeEmptyGuards rhs = rhsGuards & annList & guardStmts .- filterList (\case GuardLet (AnnList []) -> False; _ -> True) $ rhs
+
+        removeIfEmpty mb@(AnnJust (LocalBinds (AnnList []))) = annMaybe .= Nothing $ mb
+        removeIfEmpty mb = mb
+
+        removeEmptyLetsAndStmts (Let (AnnList []) e) = e
+        removeEmptyLetsAndStmts e = exprStmts .- removeEmptyStmts $ e
+
+        removeEmptyStmts ls = (annList & cmdStmtBinds .- removeEmptyStmts)
+                                . filterList (\case LetStmt (AnnList []) -> False; _ -> True) $ ls
+
+-- | Puts the elements in the orginal order and remove duplicates (elements with the same source range)
+normalizeElements :: [Ann e dom SrcTemplateStage] -> [Ann e dom SrcTemplateStage]
+normalizeElements elems = nubBy ((==) `on` getRange) $ sortBy (compare `on` srcSpanStart . getRange) elems

@@ -0,0 +1,16 @@+-- | Utilities to modify the indentation of AST fragments
+module Language.Haskell.Tools.Refactor.Utils.Indentation where
+
+import Control.Monad.Identity (Identity(..))
+import Control.Reference ((.=))
+
+import Language.Haskell.Tools.AST (SrcTemplateStage, SourceInfoTrf(..), SourceInfoTraversal(..))
+import Language.Haskell.Tools.PrettyPrint.Prepare (sourceTemplateMinimalIndent, srcTmpListMinimalIndent, srcTmpOptMinimalIndent)
+
+-- | Set the minimal indentation recursively for a part of the AST
+setMinimalIndent :: SourceInfoTraversal elem
+                 => Int -> elem dom SrcTemplateStage -> elem dom SrcTemplateStage
+setMinimalIndent ind = runIdentity .
+  sourceInfoTraverse (SourceInfoTrf (Identity . (sourceTemplateMinimalIndent .= ind))
+                                    (Identity . (srcTmpListMinimalIndent .= ind))
+                                    (Identity . (srcTmpOptMinimalIndent .= ind)))

@@ -0,0 +1,102 @@+{-# LANGUAGE TupleSections #-}
+-- | Defines operation on AST lists.
+-- AST lists carry source information so simple list modification is not enough.
+module Language.Haskell.Tools.Refactor.Utils.Lists where
+
+import Control.Applicative ((<$>))
+import Control.Reference
+import Data.List (findIndices)
+
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.PrettyPrint.Prepare
+import Language.Haskell.Tools.Refactor.Monad (LocalRefactor)
+import Language.Haskell.Tools.Refactor.Utils.AST (removeSeparator, removeChild)
+import Language.Haskell.Tools.Rewrite (AnnList)
+import SrcLoc (SrcSpan, noSrcSpan)
+
+-- | Filters the elements of the list. By default it removes the separator before the element.
+-- Of course, if the first element is removed, the following separator is removed as well.
+filterList :: SourceInfoTraversal e => (Ann e dom SrcTemplateStage -> Bool) -> AnnList e dom -> AnnList e dom
+filterList pred = filterListIndexed (const pred)
+
+filterListIndexed :: SourceInfoTraversal e => (Int -> Ann e dom SrcTemplateStage -> Bool) -> AnnList e dom -> AnnList e dom
+filterListIndexed pred (AnnListG (NodeInfo sema src) elems)
+  =  AnnListG (NodeInfo sema (srcTmpIndented .- fmap filterIndents $ srcTmpSeparators .- filterSeparators $ src)) filteredElems
+  where elementsKept = findIndices (uncurry pred) (zip [0..] elems)
+        filteredElems = sublist elementsKept elems
+        filterIndents = sublist elementsKept
+        filterSeparators = take (length elementsKept - 1) . sublist elementsKept
+
+-- | A version of filterList that cares about keeping non-removable code elements (like preprocessor pragmas)
+filterListSt :: SourceInfoTraversal e => (Ann e dom SrcTemplateStage -> Bool) -> AnnList e dom -> LocalRefactor dom (AnnList e dom)
+filterListSt pred = filterListIndexedSt (const pred)
+
+-- | A version of filterListIndexed that cares about keeping non-removable code elements (like preprocessor pragmas)
+filterListIndexedSt :: SourceInfoTraversal e => (Int -> Ann e dom SrcTemplateStage -> Bool) -> AnnList e dom -> LocalRefactor dom (AnnList e dom)
+filterListIndexedSt pred (AnnListG (NodeInfo sema src) elems)
+  = do mapM_ removeChild removedElems
+       mapM_ removeSeparator removedSeparators
+       return $ AnnListG (NodeInfo sema (srcTmpIndented .- fmap filterIndents $ srcTmpSeparators .- filterSeparators $ src)) filteredElems
+  where elementsKept = findIndices (uncurry pred) (zip [0..] elems)
+        filteredElems = sublist elementsKept elems
+        removedSeparators :: [([SourceTemplateTextElem], SrcSpan)]
+        removedSeparators = notSublist elementsKept (src ^. srcTmpSeparators) ++ lastSepRemoved
+        lastSepRemoved = if (length elems - 1) `notElem` elementsKept
+                           then take 1 (reverse (sublist elementsKept $ src ^. srcTmpSeparators)) else []
+        removedElems = notSublist elementsKept elems
+        filterIndents = sublist elementsKept
+        filterSeparators = take (length elementsKept - 1) . sublist elementsKept
+
+
+-- | Selects the given indices from a list
+sublist :: [Int] -> [a] -> [a]
+sublist indices = map snd . filter ((`elem` indices) . fst) . zip [0..]
+
+-- | Selects all but the given indices from a list
+notSublist :: [Int] -> [a] -> [a]
+notSublist indices = map snd . filter ((`notElem` indices) . fst) . zip [0..]
+
+-- | Inserts the element in the places where the two positioning functions (one checks the element before, one the element after)
+-- allows the placement.
+insertWhere :: Bool -> Ann e dom SrcTemplateStage -> (Maybe (Ann e dom SrcTemplateStage) -> Bool)
+                 -> (Maybe (Ann e dom SrcTemplateStage) -> Bool) -> AnnList e dom
+                 -> AnnList e dom
+insertWhere indented e before after al
+  = let index = insertIndex before after (al ^? annList)
+     in case index of
+          Nothing -> al
+          Just ind -> annListElems .- insertAt ind e
+                        $ (if isEmptyAnnList then id else annListAnnot&sourceInfo .- setIndented ind . addDefaultSeparator ind)
+                        $ al
+  where setIndented i = srcTmpIndented .- fmap (insertAt i indented)
+        addDefaultSeparator i al = srcTmpSeparators .- insertAt i ([NormalText $ al ^. srcTmpDefaultSeparator], noSrcSpan) $ al
+        insertAt n e ls = let (bef,aft) = splitAt n ls in bef ++ [e] ++ aft
+        isEmptyAnnList = (null :: [x] -> Bool) $ (al ^? annList)
+
+-- | Checks where the element will be inserted given the two positioning functions.
+insertIndex :: (Maybe (Ann e dom SrcTemplateStage) -> Bool) -> (Maybe (Ann e dom SrcTemplateStage) -> Bool) -> [Ann e dom SrcTemplateStage] -> Maybe Int
+insertIndex before after []
+  | before Nothing && after Nothing = Just 0
+  | otherwise = Nothing
+insertIndex before after list@(first:_)
+  | before Nothing && after (Just first) = Just 0
+  | otherwise = (+1) <$> insertIndex' before after list
+  where insertIndex' before after (curr:rest@(next:_))
+          | before (Just curr) && after (Just next) = Just 0
+          | otherwise = (+1) <$> insertIndex' before after rest
+        insertIndex' before after (curr:[])
+          | before (Just curr) && after Nothing = Just 0
+          | otherwise = Nothing
+        insertIndex' before after []
+          | before Nothing && after Nothing = Just 0
+          | otherwise = Nothing
+
+-- | Gets the elements and separators from a list. The first separator is zipped to the second element.
+-- To the first element, the "" string is zipped.
+zipWithSeparators :: AnnList e dom -> [(([SourceTemplateTextElem], SrcSpan), Ann e dom SrcTemplateStage)]
+zipWithSeparators (AnnListG (NodeInfo _ src) elems)
+  | [] <- src ^. srcTmpSeparators
+  = zip (([], noSrcSpan) : repeat ([NormalText $ src ^. srcTmpDefaultSeparator], noSrcSpan)) elems
+  | otherwise
+  = zip (([], noSrcSpan) : seps ++ repeat (_2 .= noSrcSpan $ last seps)) elems
+  where seps = src ^. srcTmpSeparators

@@ -0,0 +1,194 @@+{-# LANGUAGE GeneralizedNewtypeDeriving
+           , TypeFamilies
+           , ViewPatterns
+           , StandaloneDeriving
+           , LambdaCase
+           , FlexibleInstances
+           , FlexibleContexts
+           , TypeSynonymInstances
+           , MultiWayIf
+           , TemplateHaskell
+           , ViewPatterns
+           , TypeApplications
+           , RecordWildCards
+           #-}
+-- | Basic utilities and types for defining refactorings.
+module Language.Haskell.Tools.Refactor.Utils.Monadic where
+
+import Control.Monad.Reader
+import Control.Monad.State.Strict
+import Control.Monad.Trans.Except
+import Control.Monad.Writer
+import Control.Reference hiding (element)
+import Data.Either
+import Data.Function (on)
+import Data.List
+import Data.List.Split
+import Data.Maybe
+
+import GHC hiding (mkModuleName, moduleNameString)
+import qualified Module as GHC
+import qualified Name as GHC
+import qualified PrelNames as GHC
+import qualified TyCon as GHC
+import qualified TysWiredIn as GHC
+
+import Language.Haskell.Tools.AST as AST
+import Language.Haskell.Tools.PrettyPrint.Prepare
+import Language.Haskell.Tools.Refactor.Monad
+import Language.Haskell.Tools.Refactor.Representation
+import Language.Haskell.Tools.Rewrite
+
+-- | Performs the given refactoring, transforming it into a Ghc action
+runRefactor :: ModuleDom dom -> [ModuleDom dom] -> Refactoring dom -> Ghc (Either String [RefactorChange dom])
+runRefactor mod mods trf = runExceptT $ trf mod mods
+
+-- | Wraps a refactoring that only affects one module. Performs the per-module finishing touches.
+localRefactoring :: HasModuleInfo dom => LocalRefactoring dom -> Refactoring dom
+localRefactoring ref (name, mod) _
+  = (\m -> [ContentChanged (name, m)]) <$> localRefactoringRes id mod (ref mod)
+
+-- | Transform the result of the local refactoring
+localRefactoringRes :: HasModuleInfo dom
+                    => ((UnnamedModule dom -> UnnamedModule dom) -> a -> a)
+                          -> UnnamedModule dom
+                          -> LocalRefactor dom a
+                          -> Refactor a
+localRefactoringRes access mod trf
+  = let init = RefactorCtx (semanticsModule $ mod ^. semantics) mod (mod ^? modImports&annList)
+     in flip runReaderT init $ do (mod, recorded) <- runWriterT (fromRefactorT trf)
+                                  return $ access (insertText (rights recorded) . addGeneratedImports (lefts recorded)) mod
+
+-- | Re-inserts the elements removed from the AST that should be kept (for example preprocessor directives)
+insertText :: SourceInfoTraversal p => [(SrcSpan,String,String)] -> p dom SrcTemplateStage -> p dom SrcTemplateStage
+insertText [] p = p
+insertText inserted p
+  -- this traverses the AST and finds the positions where the removed elements can be added
+  = evalState (sourceInfoTraverseUp (SourceInfoTrf
+                (\stn -> sourceTemplateNodeElems !~ takeWhatPrecedesElem (stn ^. sourceTemplateNodeRange) $ stn)
+                (srcTmpSeparators !~ takeWhatPrecedesSep)
+                pure) (return ()) (return ()) p) (map Right $ sortOn (^. _1) inserted)
+  where
+   -- insert fragments into list separators
+   takeWhatPrecedesSep :: [([SourceTemplateTextElem], SrcSpan)] -> State [Either SrcSpan (SrcSpan,String,String)] [([SourceTemplateTextElem], SrcSpan)]
+   takeWhatPrecedesSep seps = takeWhatPrecedes Nothing (Just . (^. _2))
+                                               (\str -> _1 .- (++ [StayingText str ""]))
+                                               (\str -> _1 .- ([StayingText str ""] ++))
+                                               seps
+
+   -- insert fragments into AST elements
+   takeWhatPrecedesElem :: SrcSpan -> [SourceTemplateElem] -> State [Either SrcSpan (SrcSpan,String,String)] [SourceTemplateElem]
+   takeWhatPrecedesElem rng elems = takeWhatPrecedes (Just rng) (^? sourceTemplateTextRange)
+                                                                (\s -> sourceTemplateTextElem .- (++ [StayingText s ""]))
+                                                                (\s -> sourceTemplateTextElem .- ([StayingText s ""] ++))
+                                                                elems
+
+   -- finds the position of the fragment where there are elements in the template both before and after the fragment
+   -- puts holes into the list of inserted fragments where child elements are located
+   -- uses these holes to determine where should the fragment be added
+   takeWhatPrecedes :: Maybe SrcSpan -> (a -> Maybe SrcSpan) -> (String -> a -> a) -> (String -> a -> a) -> [a] -> State [Either SrcSpan (SrcSpan,String,String)] [a]
+   takeWhatPrecedes rng access append prepend elems
+     | ranges <- mapMaybe access elems
+     , not (null ranges)
+     = do let start = srcSpanStart $ fromMaybe (head ranges) rng
+              end = srcSpanEnd $ fromMaybe (last ranges) rng
+          toInsert <- get
+          let (prefix,rest) = break ((>= start) . srcSpanStart . either id (\(sp,_,_) -> sp)) toInsert
+              (middle,suffix) = break ((> end) . srcSpanEnd . either id (\(sp,_,_) -> sp)) rest
+          put $ prefix ++ Left (mkSrcSpan start end) : suffix
+          return $ mergeInserted access append prepend False middle elems
+     where mergeInserted :: (a -> Maybe SrcSpan) -> (String -> a -> a) -> (String -> a -> a) -> Bool -> [Either SrcSpan (SrcSpan,String,String)] -> [a] -> [a]
+           -- no fragments left
+           mergeInserted _ _ _ _ [] elems = elems
+           mergeInserted access append prepend prep insert@(Right (insertSpan,insertStr,ln):toInsert) (fstElem:elems)
+              -- insert a fragment to the end of the current element if the next elment is after the fragment
+              | Just _ <- access fstElem -- TODO: is this needed?
+              , not prep && case mapMaybe access elems of sp:_ -> srcSpanStart sp >= srcSpanEnd insertSpan
+                                                          _ -> True
+              = mergeInserted access append prepend prep toInsert (append (ln ++ insertStr ++ ln) fstElem : elems)
+              -- insert the fragment before the current elem if we need an element before (we skipped a child)
+              -- and the current element is after the inserted fragment
+              | Just fstElemSpace <- access fstElem
+              , prep && srcSpanStart fstElemSpace >= srcSpanEnd insertSpan
+              = mergeInserted access append prepend prep toInsert (prepend (ln ++ insertStr ++ ln) fstElem : elems)
+              | isJust (access fstElem) && prep
+              = mergeInserted access append prepend False insert (fstElem : elems) -- switch back to append mode
+              | otherwise
+              = fstElem : mergeInserted access append prepend (if isJust (access fstElem) then False else prep) insert elems -- move on and switch back to append mode
+           -- when found a hole
+           mergeInserted access append prepend prep insert@(Left sp : toInsert) (fstElem:elems)
+              | Just fstElemSpace <- access fstElem
+              = if srcSpanStart fstElemSpace > srcSpanEnd sp
+                  -- switch to prepend mode
+                  then mergeInserted access append prepend True toInsert (fstElem:elems)
+                  -- skip elements that are not after the fragment
+                  else fstElem : mergeInserted access append prepend prep insert elems
+              | otherwise
+              = fstElem : mergeInserted access append prepend True toInsert elems -- switch to prepend mode and move on
+           mergeInserted _ _ _ _ _ [] = [] -- maybe error
+   takeWhatPrecedes _ _ _ _ elems = return elems
+
+-- | Adds the imports that bring names into scope that are needed by the refactoring
+addGeneratedImports :: [GHC.Name] -> Ann UModule dom SrcTemplateStage -> Ann UModule dom SrcTemplateStage
+addGeneratedImports names m = modImports&annListElems .- (++ addImports names) $ m
+  where addImports :: [GHC.Name] -> [Ann UImportDecl dom SrcTemplateStage]
+        addImports names = map createImport $ groupBy ((==) `on` GHC.nameModule) $ filter (isJust . GHC.nameModule_maybe) $ nub $ sort names
+
+        -- TODO: group names like constructors into correct IESpecs
+        createImport :: [GHC.Name] -> Ann UImportDecl dom SrcTemplateStage
+        -- works on groupby result, so list is nonempty
+        createImport names = mkImportDecl False True False Nothing (mkModuleName $ GHC.moduleNameString $ GHC.moduleName $ GHC.nameModule $ head names)
+                                          Nothing (Just $ mkImportSpecList (map (\n -> mkIESpec (mkUnqualName' n) Nothing) names))
+
+registeredNamesFromPrelude :: [GHC.Name]
+registeredNamesFromPrelude = GHC.basicKnownKeyNames ++ map GHC.tyConName GHC.wiredInTyCons
+
+otherNamesFromPrelude :: [String]
+otherNamesFromPrelude
+ -- TODO: extend and revise this list
+ -- TODO: prelude names are simply existing names?? No need to check??
+  = ["GHC.Base.Maybe", "GHC.Base.Just", "GHC.Base.Nothing", "GHC.Base.maybe", "GHC.Base.either", "GHC.Base.not"
+    , "Data.Tuple.curry", "Data.Tuple.uncurry", "GHC.Base.compare", "GHC.Base.max", "GHC.Base.min", "GHC.Base.id"]
+
+qualifiedName :: GHC.Name -> String
+qualifiedName name = case GHC.nameModule_maybe name of
+  Just mod -> GHC.moduleNameString (GHC.moduleName mod) ++ "." ++ GHC.occNameString (GHC.nameOccName name)
+  Nothing -> GHC.occNameString (GHC.nameOccName name)
+
+referenceName :: (HasImportInfo dom, HasModuleInfo dom) => GHC.Name -> LocalRefactor dom (Ann UName dom SrcTemplateStage)
+referenceName = referenceName' mkQualName'
+
+referenceOperator :: (HasImportInfo dom, HasModuleInfo dom) => GHC.Name -> LocalRefactor dom (Ann UOperator dom SrcTemplateStage)
+referenceOperator = referenceName' mkQualOp'
+
+-- | Create a name that references the definition. Generates an import if the definition is not yet imported.
+referenceName' :: (HasImportInfo dom, HasModuleInfo dom)
+               => ([String] -> GHC.Name -> Ann nt dom SrcTemplateStage) -> GHC.Name -> LocalRefactor dom (Ann nt dom SrcTemplateStage)
+referenceName' makeName name
+  | name `elem` registeredNamesFromPrelude || qualifiedName name `elem` otherNamesFromPrelude
+  = return $ makeName [] name -- imported from prelude
+  | otherwise
+  = do RefactorCtx {refCtxRoot = mod, refCtxImports = imports, refModuleName = thisModule} <- ask
+       if maybe True (thisModule ==) (GHC.nameModule_maybe name)
+         then return $ makeName [] name -- in the same module, use simple name
+         else let possibleImports = filter ((name `elem`) . (\imp -> semanticsImported $ imp ^. semantics)) imports
+                  fromPrelude = name `elem` semanticsImplicitImports (mod ^. semantics)
+               in if | fromPrelude -> return $ makeName [] name
+                     | null possibleImports -> do tell [Left name]
+                                                  return $ makeName (moduleParts name) name
+                     | otherwise -> return $ referenceBy makeName name possibleImports
+                                     -- use it according to the best available import
+  where moduleParts = maybe [] (splitOn "." . GHC.moduleNameString . GHC.moduleName) . GHC.nameModule_maybe
+
+-- | Reference the name by the shortest suitable import
+referenceBy :: ([String] -> GHC.Name -> Ann nt dom SrcTemplateStage) -> GHC.Name -> [Ann UImportDecl dom SrcTemplateStage] -> Ann nt dom SrcTemplateStage
+referenceBy makeName name imps =
+  let prefixes = map importQualifier imps
+   in makeName (minimumBy (compare `on` (length . concat)) prefixes) name
+  where importQualifier :: Ann UImportDecl dom SrcTemplateStage -> [String]
+        importQualifier imp
+          = if isJust (imp ^? importQualified&annJust)
+              then case imp ^? importAs&annJust&importRename of
+                      Nothing -> splitOn "." (imp ^. importModule&moduleNameString) -- fully qualified import
+                      Just asName -> splitOn "." (asName ^. moduleNameString) -- the name given by as clause
+              else [] -- unqualified import

@@ -0,0 +1,68 @@+{-# LANGUAGE LambdaCase #-}
+-- | Defines utility operations on Haskell names such as checking if a given identifier is a
+-- correct name for a certain kind of Haskell construct.
+module Language.Haskell.Tools.Refactor.Utils.Name where
+
+import Data.Char
+import Data.List.Split (splitOn)
+
+import GHC hiding (mkModuleName, moduleNameString)
+import Name as GHC (NamedThing(..), Name, isSymOcc)
+
+import Language.Haskell.Tools.Refactor.Monad (RefactorMonad(..))
+
+-- | Different classes of definitions that have different kind of names.
+data NameClass = Variable         -- ^ Normal value definitions: functions, variables
+               | Ctor             -- ^ Data constructors
+               | ValueOperator    -- ^ Functions with operator-like names
+               | DataCtorOperator -- ^ Constructors with operator-like names
+               | SynonymOperator  -- ^ UType definitions with operator-like names
+
+-- | Get which category does a given name belong to
+classifyName :: RefactorMonad m => GHC.Name -> m NameClass
+classifyName n = liftGhc (lookupName n) >>= return . \case
+    Just (AnId {}) | isop     -> ValueOperator
+    Just (AnId {})            -> Variable
+    Just (AConLike {}) | isop -> DataCtorOperator
+    Just (AConLike {})        -> Ctor
+    Just (ATyCon {}) | isop   -> SynonymOperator
+    Just (ATyCon {})          -> Ctor
+    Just (ACoAxiom {})        -> error "classifyName: ACoAxiom"
+    Nothing | isop            -> ValueOperator
+    Nothing                   -> Variable
+  where isop = GHC.isSymOcc (GHC.getOccName n)
+
+-- | Checks if a given name is a valid module name
+validModuleName :: String -> Maybe String
+validModuleName s = foldl mappend mempty $ map (nameValid Ctor) (splitOn "." s)
+
+-- | Check if a given name is valid for a given kind of definition
+nameValid :: NameClass -> String -> Maybe String
+nameValid _ "" = Just "An empty name is not valid"
+nameValid _ str | str `elem` reservedNames = Just $ "'" ++ str ++ "' is a reserved name"
+  where -- TODO: names reserved by extensions
+        reservedNames = [ "case", "class", "data", "default", "deriving", "do", "else", "if", "import", "in", "infix"
+                        , "infixl", "infixr", "instance", "let", "module", "newtype", "of", "then", "type", "where", "_"
+                        , "..", ":", "::", "=", "\\", "|", "<-", "->", "@", "~", "=>", "[]"
+                        ]
+-- Operators that are data constructors (must start with ':')
+nameValid DataCtorOperator (':' : nameRest) | all isOperatorChar nameRest = Nothing
+nameValid DataCtorOperator _ = Just "A constructor operator must start with ':' and only contain operator characters."
+-- Type families and synonyms that are operators (can start with ':')
+nameValid SynonymOperator name | all isOperatorChar name = Nothing
+nameValid SynonymOperator _ = Just "An operator must only contain operator characters."
+-- Normal value operators (cannot start with ':')
+nameValid ValueOperator (c : nameRest) | isOperatorChar c && c /= ':' && all isOperatorChar nameRest = Nothing
+nameValid ValueOperator _ = Just "An operator that is a value must only contain operator characters and cannot start with ':'"
+-- Data and type constructors (start with uppercase)
+nameValid Ctor (c : nameRest) | isUpper c && isIdStartChar c && all (\c -> isIdStartChar c || isDigit c) nameRest = Nothing
+nameValid Ctor _ = Just "A constructor or module name must start with an uppercase letter, and only contain letters, digits, apostrhophe or underscore"
+-- Variables and type variables (start with lowercase)
+nameValid Variable (c : nameRest) | isLower c && isIdStartChar c && all (\c -> isIdStartChar c || isDigit c) nameRest = Nothing
+nameValid Variable _ = Just "The name of a value must start with lowercase, and only contain letters, digits, apostrhophe or underscore"
+
+isIdStartChar :: Char -> Bool
+isIdStartChar c = (isLetter c && isAscii c) || c == '\'' || c == '_'
+
+isOperatorChar :: Char -> Bool
+isOperatorChar c = (isPunctuation c || isSymbol c) && isAscii c

@@ -1,10 +0,0 @@-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleContexts #-}
-module CPP.BetweenImports where
-
-import Data.List
-#if !(MIN_VERSION_text(1,2,1))
-#endif
-import Data.Maybe
-
-x = Just

@@ -1,10 +0,0 @@-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleContexts #-}
-module CPP.BetweenImports where
-
-import Data.Maybe (Maybe(..))
-#if !(MIN_VERSION_text(1,2,1))
-#endif
-
-
-x = Just

@@ -1,8 +0,0 @@-{-# LANGUAGE CPP #-}
-module CPP.ConditionalCode where
-
-#if __GLASGOW_HASKELL__ >= 800
-version = "GHC 8"
-#else
-version = "not GHC 8"
-#endif

@@ -1,10 +0,0 @@-{-# LANGUAGE CPP #-}
-module CPP.ConditionalImport where
-
-import Data.List
-#ifndef USE_DATA_LIST
-import Control.Monad (Monad(..))
-#endif
-import Data.List
-
-a = Nothing >> Nothing

@@ -1,10 +0,0 @@-{-# LANGUAGE CPP #-}
-module CPP.ConditionalImportBegin where
-
-#ifndef USE_DATA_LIST
-import Control.Monad ((>>))
-#endif
-import Data.List
-import Data.List
-
-a = Nothing >> Nothing

@@ -1,9 +0,0 @@-{-# LANGUAGE CPP #-}
-module CPP.ConditionalImportBegin where
-
-#ifndef USE_DATA_LIST
-import Control.Monad ((>>))
-#endif
-
-
-a = Nothing >> Nothing

@@ -1,10 +0,0 @@-{-# LANGUAGE CPP #-}
-module CPP.ConditionalImportEnd where
-
-import Data.List
-import Data.List
-#ifndef USE_DATA_LIST
-import Control.Monad ((>>))
-#endif
-
-a = Nothing >> Nothing

@@ -1,9 +0,0 @@-{-# LANGUAGE CPP #-}
-module CPP.ConditionalImportEnd where
-
-
-#ifndef USE_DATA_LIST
-import Control.Monad ((>>))
-#endif
-
-a = Nothing >> Nothing

@@ -1,10 +0,0 @@-{-# LANGUAGE CPP #-}
-module CPP.ConditionalImportHalfRemoved where
-
-import Data.List
-#ifndef USE_DATA_LIST
-import Control.Monad ((>>))
-#endif
-import Control.Applicative ((<$>))
-
-a = id <$> (Nothing >> Nothing)

@@ -1,10 +0,0 @@-{-# LANGUAGE CPP #-}
-module CPP.ConditionalImportHalfRemoved where
-
-
-#ifndef USE_DATA_LIST
-import Control.Monad ((>>))
-#endif
-import Control.Applicative ((<$>))
-
-a = id <$> (Nothing >> Nothing)

@@ -1,11 +0,0 @@-{-# 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)

@@ -1,11 +0,0 @@-{-# LANGUAGE CPP #-}
-module CPP.ConditionalImportMulti where
-
-
-#ifndef USE_DATA_LIST
-import Control.Applicative ((<$>))
-import Control.Monad ((>>))
-#endif
-
-
-a = id <$> (Nothing >> Nothing)

@@ -1,13 +0,0 @@-{-# 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"]

@@ -1,13 +0,0 @@-{-# 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"]

@@ -1,10 +0,0 @@-{-# LANGUAGE CPP #-}
-module CPP.ConditionalImport where
-
-
-#ifndef USE_DATA_LIST
-import Control.Monad (Monad(..))
-#endif
-
-
-a = Nothing >> Nothing

@@ -1,2 +0,0 @@-{-# LANGUAGE CPP #-}
-module CPP.JustEnabled where

@@ -1,34 +0,0 @@------------------------------------------------------------------------------
--- |
--- Module      :  Language.Preprocessor.Cpphs
--- Copyright   :  2000-2006 Malcolm Wallace
--- Licence     :  LGPL
---
--- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
--- Stability   :  experimental
--- Portability :  All
---
--- Include the interface that is exported
------------------------------------------------------------------------------
-
-module Language.Preprocessor.Cpphs
-  ( runCpphs, runCpphsPass1, runCpphsPass2, runCpphsReturningSymTab
-  , cppIfdef, tokenise, WordStyle(..)
-  , macroPass, macroPassReturningSymTab
-  , CpphsOptions(..), BoolOptions(..)
-  , parseOptions, defaultCpphsOptions, defaultBoolOptions
-  , module Language.Preprocessor.Cpphs.Position
-  ) where
-
-import Language.Preprocessor.Cpphs.CppIfdef(cppIfdef)
-import Language.Preprocessor.Cpphs.MacroPass(macroPass
-                                            ,macroPassReturningSymTab)
-import Language.Preprocessor.Cpphs.RunCpphs(runCpphs
-                                           ,runCpphsPass1
-                                           ,runCpphsPass2
-                                           ,runCpphsReturningSymTab)
-import Language.Preprocessor.Cpphs.Options
-       (CpphsOptions(..), BoolOptions(..), parseOptions
-       ,defaultCpphsOptions,defaultBoolOptions)
-import Language.Preprocessor.Cpphs.Position
-import Language.Preprocessor.Cpphs.Tokenise

@@ -1,416 +0,0 @@------------------------------------------------------------------------------
--- |
--- Module      :  CppIfdef
--- Copyright   :  1999-2004 Malcolm Wallace
--- Licence     :  LGPL
--- 
--- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
--- Stability   :  experimental
--- Portability :  All
-
--- Perform a cpp.first-pass, gathering \#define's and evaluating \#ifdef's.
--- and \#include's.
------------------------------------------------------------------------------
-
-module Language.Preprocessor.Cpphs.CppIfdef
-  ( cppIfdef    -- :: FilePath -> [(String,String)] -> [String] -> Options
-                --      -> String -> IO [(Posn,String)]
-  ) where
-
-
-import Text.Parse
-import Language.Preprocessor.Cpphs.SymTab
-import Language.Preprocessor.Cpphs.Position  (Posn,newfile,newline,newlines
-                                             ,cppline,cpp2hask,newpos)
-import Language.Preprocessor.Cpphs.ReadFirst (readFirst)
-import Language.Preprocessor.Cpphs.Tokenise  (linesCpp,reslash)
-import Language.Preprocessor.Cpphs.Options   (BoolOptions(..))
-import Language.Preprocessor.Cpphs.HashDefine(HashDefine(..),parseHashDefine
-                                             ,expandMacro)
-import Language.Preprocessor.Cpphs.MacroPass (preDefine,defineMacro)
-import Data.Char        (isDigit,isSpace,isAlphaNum)
-import Data.List        (intercalate,isPrefixOf)
-import Numeric          (readHex,readOct,readDec)
-import System.IO.Unsafe (unsafeInterleaveIO)
-import System.IO        (hPutStrLn,stderr)
-import Control.Monad    (when)
-
--- | Run a first pass of cpp, evaluating \#ifdef's and processing \#include's,
---   whilst taking account of \#define's and \#undef's as we encounter them.
-cppIfdef :: FilePath            -- ^ File for error reports
-        -> [(String,String)]    -- ^ Pre-defined symbols and their values
-        -> [String]             -- ^ Search path for \#includes
-        -> BoolOptions          -- ^ Options controlling output style
-        -> String               -- ^ The input file content
-        -> IO [(Posn,String)]   -- ^ The file after processing (in lines)
-cppIfdef fp syms search options =
-    cpp posn defs search options (Keep []) . initial . linesCpp
-  where
-    posn = newfile fp
-    defs = preDefine options syms
-    initial = if literate options then id else (cppline posn:)
--- Previous versions had a very simple symbol table  mapping strings
--- to strings.  Now the #ifdef pass uses a more elaborate table, in
--- particular to deal with parameterised macros in conditionals.
-
-
--- | Internal state for whether lines are being kept or dropped.
---   In @Drop n b ps@, @n@ is the depth of nesting, @b@ is whether
---   we have already succeeded in keeping some lines in a chain of
---   @elif@'s, and @ps@ is the stack of positions of open @#if@ contexts,
---   used for error messages in case EOF is reached too soon.
-data KeepState = Keep [Posn] | Drop Int Bool [Posn]
-
--- | Return just the list of lines that the real cpp would decide to keep.
-cpp :: Posn -> SymTab HashDefine -> [String] -> BoolOptions -> KeepState
-       -> [String] -> IO [(Posn,String)]
-
-cpp _ _ _ _ (Keep ps) [] | not (null ps) = do
-    hPutStrLn stderr $ "Unmatched #if: positions of open context are:\n"++
-                       unlines (map show ps)
-    return []
-cpp _ _ _ _ _ [] = return []
-
-cpp p syms path options (Keep ps) (l@('#':x):xs) =
-    let ws = words x
-        cmd = if null ws then "" else head ws
-        line = tail ws
-        sym  = head (tail ws)
-        rest = tail (tail ws)
-        def = defineMacro options (sym++" "++ maybe "1" id (un rest))
-        un v = if null v then Nothing else Just (unwords v)
-        keepIf b = if b then Keep (p:ps) else Drop 1 False (p:ps)
-        skipn syms' retain ud xs' =
-            let n = 1 + length (filter (=='\n') l) in
-            (if macros options && retain then emitOne  (p,reslash l)
-                                         else emitMany (replicate n (p,""))) $
-            cpp (newlines n p) syms' path options ud xs'
-    in case cmd of
-        "define" -> skipn (insertST def syms) True (Keep ps) xs
-        "undef"  -> skipn (deleteST sym syms) True (Keep ps) xs
-        "ifndef" -> skipn syms False (keepIf (not (definedST sym syms))) xs
-        "ifdef"  -> skipn syms False (keepIf      (definedST sym syms)) xs
-        "if"     -> do b <- gatherDefined p syms (unwords line)
-                       skipn syms False (keepIf b) xs
-        "else"   -> skipn syms False (Drop 1 False ps) xs
-        "elif"   -> skipn syms False (Drop 1 True ps) xs
-        "endif"  | null ps ->
-                    do hPutStrLn stderr $ "Unmatched #endif at "++show p
-                       return []
-        "endif"  -> skipn syms False (Keep (tail ps)) xs
-        "pragma" -> skipn syms True  (Keep ps) xs
-        ('!':_)  -> skipn syms False (Keep ps) xs       -- \#!runhs scripts
-        "include"-> do (inc,content) <- readFirst (file syms (unwords line))
-                                                  p path
-                                                  (warnings options)
-                       cpp p syms path options (Keep ps)
-                             (("#line 1 "++show inc): linesCpp content
-                                                    ++ cppline (newline p): xs)
-        "warning"-> if warnings options then
-                      do hPutStrLn stderr (l++"\nin "++show p)
-                         skipn syms False (Keep ps) xs
-                    else skipn syms False (Keep ps) xs
-        "error"  -> error (l++"\nin "++show p)
-        "line"   | all isDigit sym
-                 -> (if locations options && hashline options then emitOne (p,l)
-                     else if locations options then emitOne (p,cpp2hask l)
-                     else id) $
-                    cpp (newpos (read sym) (un rest) p)
-                        syms path options (Keep ps) xs
-        n | all isDigit n && not (null n)
-                 -> (if locations options && hashline options then emitOne (p,l)
-                     else if locations options then emitOne (p,cpp2hask l)
-                     else id) $
-                    cpp (newpos (read n) (un (tail ws)) p)
-                        syms path options (Keep ps) xs
-          | otherwise
-                 -> do when (warnings options) $
-                           hPutStrLn stderr ("Warning: unknown directive #"++n
-                                             ++"\nin "++show p)
-                       emitOne (p,l) $
-                               cpp (newline p) syms path options (Keep ps) xs
-
-cpp p syms path options (Drop n b ps) (('#':x):xs) =
-    let ws = words x
-        cmd = if null ws then "" else head ws
-        delse    | n==1 && b = Drop 1 b ps
-                 | n==1      = Keep ps
-                 | otherwise = Drop n b ps
-        dend     | n==1      = Keep (tail ps)
-                 | otherwise = Drop (n-1) b (tail ps)
-        delif v  | n==1 && not b && v
-                             = Keep ps
-                 | otherwise = Drop n b ps
-        skipn ud xs' =
-                 let n' = 1 + length (filter (=='\n') x) in
-                 emitMany (replicate n' (p,"")) $
-                    cpp (newlines n' p) syms path options ud xs'
-    in
-    if      cmd == "ifndef" ||
-            cmd == "if"     ||
-            cmd == "ifdef" then    skipn (Drop (n+1) b (p:ps)) xs
-    else if cmd == "elif"  then do v <- gatherDefined p syms (unwords (tail ws))
-                                   skipn (delif v) xs
-    else if cmd == "else"  then    skipn  delse xs
-    else if cmd == "endif" then
-            if null ps then do hPutStrLn stderr $ "Unmatched #endif at "++show p
-                               return []
-                       else skipn  dend  xs
-    else skipn (Drop n b ps) xs
-        -- define, undef, include, error, warning, pragma, line
-
-cpp p syms path options (Keep ps) (x:xs) =
-    let p' = newline p in seq p' $
-    emitOne (p,x)  $  cpp p' syms path options (Keep ps) xs
-cpp p syms path options d@(Drop _ _ _) (_:xs) =
-    let p' = newline p in seq p' $
-    emitOne (p,"") $  cpp p' syms path options d xs
-
-
--- | Auxiliary IO functions
-emitOne  ::  a  -> IO [a] -> IO [a]
-emitMany :: [a] -> IO [a] -> IO [a]
-emitOne  x  io = do ys <- unsafeInterleaveIO io
-                    return (x:ys)
-emitMany xs io = do ys <- unsafeInterleaveIO io
-                    return (xs++ys)
-
-
-----
-gatherDefined :: Posn -> SymTab HashDefine -> String -> IO Bool
-gatherDefined p st inp =
-  case runParser (preExpand st) inp of
-    (Left msg, _) -> error ("Cannot expand #if directive in file "++show p
-                           ++":\n    "++msg)
-    (Right s, xs) -> do
---      hPutStrLn stderr $ "Expanded #if at "++show p++" is:\n  "++s
-        when (any (not . isSpace) xs) $
-             hPutStrLn stderr ("Warning: trailing characters after #if"
-                              ++" macro expansion in file "++show p++": "++xs)
-
-        case runParser parseBoolExp s of
-          (Left msg, _) -> error ("Cannot parse #if directive in file "++show p
-                                 ++":\n    "++msg)
-          (Right b, xs) -> do when (any (not . isSpace) xs && notComment xs) $
-                                   hPutStrLn stderr
-                                     ("Warning: trailing characters after #if"
-                                      ++" directive in file "++show p++": "++xs)
-                              return b
-
-notComment = not . ("//"`isPrefixOf`) . dropWhile isSpace
-
-
--- | The preprocessor must expand all macros (recursively) before evaluating
---   the conditional.
-preExpand :: SymTab HashDefine -> TextParser String
-preExpand st =
-  do  eof
-      return ""
-  <|>
-  do  a <- many1 (satisfy notIdent)
-      commit $ pure (a++) `apply` preExpand st
-  <|>
-  do  b <- expandSymOrCall st
-      commit $ pure (b++) `apply` preExpand st
-
--- | Expansion of symbols.
-expandSymOrCall :: SymTab HashDefine -> TextParser String
-expandSymOrCall st =
-  do sym <- parseSym
-     if sym=="defined" then do arg <- skip parseSym; convert sym [arg]
-                            <|>
-                            do arg <- skip $ parenthesis (do x <- skip parseSym;
-                                                             skip (return x))
-                               convert sym [arg]
-                            <|> convert sym []
-      else
-      ( do  args <- parenthesis (commit $ fragment `sepBy` skip (isWord ","))
-            args' <- flip mapM args $ \arg->
-                         case runParser (preExpand st) arg of
-                             (Left msg, _) -> fail msg
-                             (Right s, _)  -> return s
-            convert sym args'
-        <|> convert sym []
-      )
-  where
-    fragment = many1 (satisfy (`notElem`",)"))
-    convert "defined" [arg] =
-      case lookupST arg st of
-        Nothing | all isDigit arg    -> return arg 
-        Nothing                      -> return "0"
-        Just (a@AntiDefined{})       -> return "0"
-        Just (a@SymbolReplacement{}) -> return "1"
-        Just (a@MacroExpansion{})    -> return "1"
-    convert sym args =
-      case lookupST sym st of
-        Nothing  -> if null args then return sym
-                    else return "0"
-                 -- else fail (disp sym args++" is not a defined macro")
-        Just (a@SymbolReplacement{}) -> do reparse (replacement a)
-                                           return ""
-        Just (a@MacroExpansion{})    -> do reparse (expandMacro a args False)
-                                           return ""
-        Just (a@AntiDefined{})       ->
-                    if null args then return sym
-                    else return "0"
-                 -- else fail (disp sym args++" explicitly undefined with -U")
-    disp sym args = let len = length args
-                        chars = map (:[]) ['a'..'z']
-                    in sym ++ if null args then ""
-                              else "("++intercalate "," (take len chars)++")"
-
-parseBoolExp :: TextParser Bool
-parseBoolExp =
-  do  a <- parseExp1
-      bs <- many (do skip (isWord "||")
-                     commit $ skip parseBoolExp)
-      return $ foldr (||) a bs
-
-parseExp1 :: TextParser Bool
-parseExp1 =
-  do  a <- parseExp0
-      bs <- many (do skip (isWord "&&")
-                     commit $ skip parseExp1)
-      return $ foldr (&&) a bs
-
-parseExp0 :: TextParser Bool
-parseExp0 =
-  do  skip (isWord "!")
-      a <- commit $ parseExp0
-      return (not a)
-  <|>
-  do  val1 <- parseArithExp1
-      op   <- parseCmpOp
-      val2 <- parseArithExp1
-      return (val1 `op` val2)
-  <|>
-  do  sym <- parseArithExp1
-      case sym of
-        0 -> return False
-        _ -> return True
-  <|>
-  do  parenthesis (commit parseBoolExp)
-
-parseArithExp1 :: TextParser Integer
-parseArithExp1 =
-  do  val1 <- parseArithExp0
-      ( do op   <- parseArithOp1
-           val2 <- parseArithExp1
-           return (val1 `op` val2)
-        <|> return val1 )
-  <|>
-  do  parenthesis parseArithExp1
-
-parseArithExp0 :: TextParser Integer
-parseArithExp0 =
-  do  val1 <- parseNumber
-      ( do op   <- parseArithOp0
-           val2 <- parseArithExp0
-           return (val1 `op` val2)
-        <|> return val1 )
-  <|>
-  do  parenthesis parseArithExp0
-
-parseNumber :: TextParser Integer
-parseNumber = fmap safeRead $ skip parseSym
-  where
-    safeRead s =
-      case s of
-        '0':'x':s' -> number readHex s'
-        '0':'o':s' -> number readOct s'
-        _          -> number readDec s
-    number rd s =
-      case rd s of
-        []        -> 0 :: Integer
-        ((n,_):_) -> n :: Integer
-
-parseCmpOp :: TextParser (Integer -> Integer -> Bool)
-parseCmpOp =
-  do  skip (isWord ">=")
-      return (>=)
-  <|>
-  do  skip (isWord ">")
-      return (>)
-  <|>
-  do  skip (isWord "<=")
-      return (<=)
-  <|>
-  do  skip (isWord "<")
-      return (<)
-  <|>
-  do  skip (isWord "==")
-      return (==)
-  <|>
-  do  skip (isWord "!=")
-      return (/=)
-
-parseArithOp1 :: TextParser (Integer -> Integer -> Integer)
-parseArithOp1 =
-  do  skip (isWord "+")
-      return (+)
-  <|>
-  do  skip (isWord "-")
-      return (-)
-
-parseArithOp0 :: TextParser (Integer -> Integer -> Integer)
-parseArithOp0 =
-  do  skip (isWord "*")
-      return (*)
-  <|>
-  do  skip (isWord "/")
-      return (div)
-  <|>
-  do  skip (isWord "%")
-      return (rem)
-
--- | Return the expansion of the symbol (if there is one).
-parseSymOrCall :: SymTab HashDefine -> TextParser String
-parseSymOrCall st =
-  do  sym <- skip parseSym
-      args <- parenthesis (commit $ parseSymOrCall st `sepBy` skip (isWord ","))
-      return $ convert sym args
-  <|>
-  do  sym <- skip parseSym
-      return $ convert sym []
-  where
-    convert sym args =
-      case lookupST sym st of
-        Nothing  -> sym
-        Just (a@SymbolReplacement{}) -> recursivelyExpand st (replacement a)
-        Just (a@MacroExpansion{})    -> recursivelyExpand st (expandMacro a args False)
-        Just (a@AntiDefined{})       -> name a
-
-recursivelyExpand :: SymTab HashDefine -> String -> String
-recursivelyExpand st inp =
-  case runParser (parseSymOrCall st) inp of
-    (Left msg, _) -> inp
-    (Right s,  _) -> s
-
-parseSym :: TextParser String
-parseSym = many1 (satisfy (\c-> isAlphaNum c || c`elem`"'`_"))
-           `onFail`
-           do xs <- allAsString
-              fail $ "Expected an identifier, got \""++xs++"\""
-
-notIdent :: Char -> Bool
-notIdent c = not (isAlphaNum c || c`elem`"'`_")
-
-skip :: TextParser a -> TextParser a
-skip p = many (satisfy isSpace) >> p
-
--- | The standard "parens" parser does not work for us here.  Define our own.
-parenthesis :: TextParser a -> TextParser a
-parenthesis p = do isWord "("
-                   x <- p
-                   isWord ")"
-                   return x
-
--- | Determine filename in \#include
-file :: SymTab HashDefine -> String -> String
-file st name =
-    case name of
-      ('"':ns) -> init ns
-      ('<':ns) -> init ns
-      _ -> let ex = recursivelyExpand st name in
-           if ex == name then name else file st ex
-

@@ -1,129 +0,0 @@------------------------------------------------------------------------------
--- |
--- Module      :  HashDefine
--- Copyright   :  2004 Malcolm Wallace
--- Licence     :  LGPL
---
--- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
--- Stability   :  experimental
--- Portability :  All
---
--- What structures are declared in a \#define.
------------------------------------------------------------------------------
- 
-module Language.Preprocessor.Cpphs.HashDefine
-  ( HashDefine(..)
-  , ArgOrText(..)
-  , expandMacro
-  , parseHashDefine
-  , simplifyHashDefines
-  ) where
-
-import Data.Char (isSpace)
-import Data.List (intercalate)
-
-data HashDefine
-        = LineDrop
-                { name :: String }
-        | Pragma
-                { name :: String }
-        | AntiDefined
-                { name          :: String
-                , linebreaks    :: Int
-                }
-        | SymbolReplacement
-                { name          :: String
-                , replacement   :: String
-                , linebreaks    :: Int
-                }
-        | MacroExpansion
-                { name          :: String
-                , arguments     :: [String]
-                , expansion     :: [(ArgOrText,String)]
-                , linebreaks    :: Int
-                }
-    deriving (Eq,Show)
-
--- | 'smart' constructor to avoid warnings from ghc (undefined fields)
-symbolReplacement :: HashDefine
-symbolReplacement =
-    SymbolReplacement
-         { name=undefined, replacement=undefined, linebreaks=undefined }
-
--- | Macro expansion text is divided into sections, each of which is classified
---   as one of three kinds: a formal argument (Arg), plain text (Text),
---   or a stringised formal argument (Str).
-data ArgOrText = Arg | Text | Str deriving (Eq,Show)
-
--- | Expand an instance of a macro.
---   Precondition: got a match on the macro name.
-expandMacro :: HashDefine -> [String] -> Bool -> String
-expandMacro macro parameters layout =
-    let env = zip (arguments macro) parameters
-        replace (Arg,s)  = maybe ("")      id (lookup s env)
-        replace (Str,s)  = maybe (str "") str (lookup s env)
-        replace (Text,s) = if layout then s else filter (/='\n') s
-        str s = '"':s++"\""
-        checkArity | length (arguments macro) == 1 && length parameters <= 1
-                   || length (arguments macro) == length parameters = id
-                   | otherwise = error ("macro "++name macro++" expected "++
-                                        show (length (arguments macro))++
-                                        " arguments, but was given "++
-                                        show (length parameters))
-    in
-    checkArity $ concatMap replace (expansion macro)
-
--- | Parse a \#define, or \#undef, ignoring other \# directives
-parseHashDefine :: Bool -> [String] -> Maybe HashDefine
-parseHashDefine ansi def = (command . skip) def
-  where
-    skip xss@(x:xs) | all isSpace x = skip xs
-                    | otherwise     = xss
-    skip    []      = []
-    command ("line":xs)   = Just (LineDrop ("#line"++concat xs))
-    command ("pragma":xs) = Just (Pragma ("#pragma"++concat xs))
-    command ("define":xs) = Just (((define . skip) xs) { linebreaks=count def })
-    command ("undef":xs)  = Just (((undef  . skip) xs))
-    command _             = Nothing
-    undef  (sym:_)   = AntiDefined { name=sym, linebreaks=0 }
-    define (sym:xs)  = case {-skip-} xs of
-                           ("(":ys) -> (macroHead sym [] . skip) ys
-                           ys   -> symbolReplacement
-                                     { name=sym
-                                     , replacement = concatMap snd
-                                             (classifyRhs [] (chop (skip ys))) }
-    macroHead sym args (",":xs) = (macroHead sym args . skip) xs
-    macroHead sym args (")":xs) = MacroExpansion
-                                    { name =sym , arguments = reverse args
-                                    , expansion = classifyRhs args (skip xs)
-                                    , linebreaks = undefined }
-    macroHead sym args (var:xs) = (macroHead sym (var:args) . skip) xs
-    macroHead sym args []       = error ("incomplete macro definition:\n"
-                                        ++"  #define "++sym++"("
-                                        ++intercalate "," args)
-    classifyRhs args ("#":x:xs)
-                          | ansi &&
-                            x `elem` args    = (Str,x): classifyRhs args xs
-    classifyRhs args ("##":xs)
-                          | ansi             = classifyRhs args xs
-    classifyRhs args (s:"##":s':xs)
-                          | ansi && all isSpace s && all isSpace s'
-                                             = classifyRhs args xs
-    classifyRhs args (word:xs)
-                          | word `elem` args = (Arg,word): classifyRhs args xs
-                          | otherwise        = (Text,word): classifyRhs args xs
-    classifyRhs _    []                      = []
-    count = length . filter (=='\n') . concat
-    chop  = reverse . dropWhile (all isSpace) . reverse
-
--- | Pretty-print hash defines to a simpler format, as key-value pairs.
-simplifyHashDefines :: [HashDefine] -> [(String,String)]
-simplifyHashDefines = concatMap simp
-  where
-    simp hd@LineDrop{}    = []
-    simp hd@Pragma{}      = []
-    simp hd@AntiDefined{} = []
-    simp hd@SymbolReplacement{} = [(name hd, replacement hd)]
-    simp hd@MacroExpansion{}    = [(name hd++"("++intercalate "," (arguments hd)
-                                           ++")"
-                                   ,concatMap snd (expansion hd))]

@@ -1,184 +0,0 @@------------------------------------------------------------------------------
--- |
--- Module      :  MacroPass
--- Copyright   :  2004 Malcolm Wallace
--- Licence     :  LGPL
---
--- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
--- Stability   :  experimental
--- Portability :  All
---
--- Perform a cpp.second-pass, accumulating \#define's and \#undef's,
--- whilst doing symbol replacement and macro expansion.
------------------------------------------------------------------------------
-
-module Language.Preprocessor.Cpphs.MacroPass
-  ( macroPass
-  , preDefine
-  , defineMacro
-  , macroPassReturningSymTab
-  ) where
-
-import Language.Preprocessor.Cpphs.HashDefine (HashDefine(..), expandMacro
-                                              , simplifyHashDefines)
-import Language.Preprocessor.Cpphs.Tokenise   (tokenise, WordStyle(..)
-                                              , parseMacroCall)
-import Language.Preprocessor.Cpphs.SymTab     (SymTab, lookupST, insertST
-                                              , emptyST, flattenST)
-import Language.Preprocessor.Cpphs.Position   (Posn, newfile, filename, lineno)
-import Language.Preprocessor.Cpphs.Options    (BoolOptions(..))
-import System.IO.Unsafe (unsafeInterleaveIO)
-import Control.Monad    ((=<<))
-import System.Time       (getClockTime, toCalendarTime, formatCalendarTime)
-import System.Locale     (defaultTimeLocale)
-
-noPos :: Posn
-noPos = newfile "preDefined"
-
--- | Walk through the document, replacing calls of macros with the expanded RHS.
-macroPass :: [(String,String)]  -- ^ Pre-defined symbols and their values
-          -> BoolOptions        -- ^ Options that alter processing style
-          -> [(Posn,String)]    -- ^ The input file content
-          -> IO String          -- ^ The file after processing
-macroPass syms options =
-    fmap (safetail              -- to remove extra "\n" inserted below
-         . concat
-         . onlyRights)
-    . macroProcess (pragma options) (layout options) (lang options)
-                   (preDefine options syms)
-    . tokenise (stripEol options) (stripC89 options)
-               (ansi options) (lang options)
-    . ((noPos,""):)     -- ensure recognition of "\n#" at start of file
-  where
-    safetail [] = []
-    safetail (_:xs) = xs
-
--- | auxiliary
-onlyRights :: [Either a b] -> [b]
-onlyRights = concatMap (\x->case x of Right t-> [t]; Left _-> [];)
-
--- | Walk through the document, replacing calls of macros with the expanded RHS.
---   Additionally returns the active symbol table after processing.
-macroPassReturningSymTab
-          :: [(String,String)]  -- ^ Pre-defined symbols and their values
-          -> BoolOptions        -- ^ Options that alter processing style
-          -> [(Posn,String)]    -- ^ The input file content
-          -> IO (String,[(String,String)])
-                                -- ^ The file and symbol table after processing
-macroPassReturningSymTab syms options =
-    fmap (mapFst (safetail              -- to remove extra "\n" inserted below
-                 . concat)
-         . walk)
-    . macroProcess (pragma options) (layout options) (lang options)
-                   (preDefine options syms)
-    . tokenise (stripEol options) (stripC89 options)
-               (ansi options) (lang options)
-    . ((noPos,""):)     -- ensure recognition of "\n#" at start of file
-  where
-    safetail [] = []
-    safetail (_:xs) = xs
-    walk (Right x: rest) = let (xs,   foo) = walk rest
-                           in  (x:xs, foo)
-    walk (Left  x: [])   =     ( [] , simplifyHashDefines (flattenST x) )
-    walk (Left  x: rest) = walk rest
-    mapFst f (a,b) = (f a, b)
-
-
--- | Turn command-line definitions (from @-D@) into 'HashDefine's.
-preDefine :: BoolOptions -> [(String,String)] -> SymTab HashDefine
-preDefine options defines =
-    foldr (insertST . defineMacro options . (\ (s,d)-> s++" "++d))
-          emptyST defines
-
--- | Turn a string representing a macro definition into a 'HashDefine'.
-defineMacro :: BoolOptions -> String -> (String,HashDefine)
-defineMacro opts s =
-    let (Cmd (Just hd):_) = tokenise True True (ansi opts) (lang opts)
-                                     [(noPos,"\n#define "++s++"\n")]
-    in (name hd, hd)
-
-
--- | Trundle through the document, one word at a time, using the WordStyle
---   classification introduced by 'tokenise' to decide whether to expand a
---   word or macro.  Encountering a \#define or \#undef causes that symbol to
---   be overwritten in the symbol table.  Any other remaining cpp directives
---   are discarded and replaced with blanks, except for \#line markers.
---   All valid identifiers are checked for the presence of a definition
---   of that name in the symbol table, and if so, expanded appropriately.
---   (Bool arguments are: keep pragmas?  retain layout?  haskell language?)
---   The result lazily intersperses output text with symbol tables.  Lines
---   are emitted as they are encountered.  A symbol table is emitted after
---   each change to the defined symbols, and always at the end of processing.
-macroProcess :: Bool -> Bool -> Bool -> SymTab HashDefine -> [WordStyle]
-             -> IO [Either (SymTab HashDefine) String]
-macroProcess _ _ _ st        []          = return [Left st]
-macroProcess p y l st (Other x: ws)      = emit x    $ macroProcess p y l st ws
-macroProcess p y l st (Cmd Nothing: ws)  = emit "\n" $ macroProcess p y l st ws
-macroProcess p y l st (Cmd (Just (LineDrop x)): ws)
-                                         = emit "\n" $
-                                           emit x    $ macroProcess p y l st ws
-macroProcess pragma y l st (Cmd (Just (Pragma x)): ws)
-               | pragma    = emit "\n" $ emit x $ macroProcess pragma y l st ws
-               | otherwise = emit "\n" $          macroProcess pragma y l st ws
-macroProcess p layout lang st (Cmd (Just hd): ws) =
-    let n = 1 + linebreaks hd
-        newST = insertST (name hd, hd) st
-    in
-    emit (replicate n '\n') $
-    emitSymTab newST $
-    macroProcess p layout lang newST ws
-macroProcess pr layout lang st (Ident p x: ws) =
-    case x of
-      "__FILE__" -> emit (show (filename p))$ macroProcess pr layout lang st ws
-      "__LINE__" -> emit (show (lineno p))  $ macroProcess pr layout lang st ws
-      "__DATE__" -> do w <- return .
-                            formatCalendarTime defaultTimeLocale "\"%d %b %Y\""
-                            =<< toCalendarTime =<< getClockTime
-                       emit w $ macroProcess pr layout lang st ws
-      "__TIME__" -> do w <- return .
-                            formatCalendarTime defaultTimeLocale "\"%H:%M:%S\""
-                            =<< toCalendarTime =<< getClockTime
-                       emit w $ macroProcess pr layout lang st ws
-      _ ->
-        case lookupST x st of
-            Nothing -> emit x $ macroProcess pr layout lang st ws
-            Just hd ->
-                case hd of
-                    AntiDefined {name=n} -> emit n $
-                                            macroProcess pr layout lang st ws
-                    SymbolReplacement {replacement=r} ->
-                        let r' = if layout then r else filter (/='\n') r in
-                        -- one-level expansion only:
-                        -- emit r' $ macroProcess layout st ws
-                        -- multi-level expansion:
-                        macroProcess pr layout lang st
-                                     (tokenise True True False lang [(p,r')]
-                                      ++ ws)
-                    MacroExpansion {} ->
-                        case parseMacroCall p ws of
-                            Nothing -> emit x $
-                                       macroProcess pr layout lang st ws
-                            Just (args,ws') ->
-                                if length args /= length (arguments hd) then
-                                     emit x $ macroProcess pr layout lang st ws
-                                else do args' <- mapM (fmap (concat.onlyRights)
-                                                       . macroProcess pr layout
-                                                                        lang st)
-                                                      args
-                                        -- one-level expansion only:
-                                        -- emit (expandMacro hd args' layout) $
-                                        --         macroProcess layout st ws'
-                                        -- multi-level expansion:
-                                        macroProcess pr layout lang st
-                                            (tokenise True True False lang
-                                               [(p,expandMacro hd args' layout)]
-                                            ++ ws')
-
--- | Useful helper function.
-emit :: a -> IO [Either b a] -> IO [Either b a]
-emit x io = do xs <- unsafeInterleaveIO io
-               return (Right x:xs)
--- | Useful helper function.
-emitSymTab :: b -> IO [Either b a] -> IO [Either b a]
-emitSymTab x io = do xs <- unsafeInterleaveIO io
-                     return (Left x:xs)

@@ -1,156 +0,0 @@------------------------------------------------------------------------------
--- |
--- Module      :  Options
--- Copyright   :  2006 Malcolm Wallace
--- Licence     :  LGPL
---
--- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
--- Stability   :  experimental
--- Portability :  All
---
--- This module deals with Cpphs options and parsing them
------------------------------------------------------------------------------
-
-module Language.Preprocessor.Cpphs.Options
-  ( CpphsOptions(..)
-  , BoolOptions(..)
-  , parseOptions
-  , defaultCpphsOptions
-  , defaultBoolOptions
-  , trailing
-  ) where
-
-import Data.Maybe
-import Data.List (isPrefixOf)
-
--- | Cpphs options structure.
-data CpphsOptions = CpphsOptions 
-    { infiles   :: [FilePath]
-    , outfiles  :: [FilePath]
-    , defines   :: [(String,String)]
-    , includes  :: [String]
-    , preInclude:: [FilePath]   -- ^ Files to \#include before anything else
-    , boolopts  :: BoolOptions
-    } deriving (Show)
-
--- | Default options.
-defaultCpphsOptions :: CpphsOptions
-defaultCpphsOptions = CpphsOptions { infiles = [], outfiles = []
-                                   , defines = [], includes = []
-                                   , preInclude = []
-                                   , boolopts = defaultBoolOptions }
-
--- | Options representable as Booleans.
-data BoolOptions = BoolOptions
-    { macros    :: Bool  -- ^ Leave \#define and \#undef in output of ifdef?
-    , locations :: Bool  -- ^ Place \#line droppings in output?
-    , hashline  :: Bool  -- ^ Write \#line or {-\# LINE \#-} ?
-    , pragma    :: Bool  -- ^ Keep \#pragma in final output?
-    , stripEol  :: Bool  -- ^ Remove C eol (\/\/) comments everywhere?
-    , stripC89  :: Bool  -- ^ Remove C inline (\/**\/) comments everywhere?
-    , lang      :: Bool  -- ^ Lex input as Haskell code?
-    , ansi      :: Bool  -- ^ Permit stringise \# and catenate \#\# operators?
-    , layout    :: Bool  -- ^ Retain newlines in macro expansions?
-    , literate  :: Bool  -- ^ Remove literate markup?
-    , warnings  :: Bool  -- ^ Issue warnings?
-    } deriving (Show)
-
--- | Default settings of boolean options.
-defaultBoolOptions :: BoolOptions
-defaultBoolOptions = BoolOptions { macros   = True,   locations = True
-                                 , hashline = True,   pragma    = False
-                                 , stripEol = False,  stripC89  = False
-                                 , lang     = True,   ansi      = False
-                                 , layout   = False,  literate  = False
-                                 , warnings = True }
-
--- | Raw command-line options.  This is an internal intermediate data
---   structure, used during option parsing only.
-data RawOption
-    = NoMacro
-    | NoLine
-    | LinePragma
-    | Pragma
-    | Text
-    | Strip
-    | StripEol
-    | Ansi
-    | Layout
-    | Unlit
-    | SuppressWarnings
-    | Macro (String,String)
-    | Path String
-    | PreInclude FilePath
-    | IgnoredForCompatibility
-      deriving (Eq, Show)
-
-flags :: [(String, RawOption)]
-flags = [ ("--nomacro", NoMacro)
-        , ("--noline",  NoLine)
-        , ("--linepragma", LinePragma)
-        , ("--pragma",  Pragma)
-        , ("--text",    Text)
-        , ("--strip",   Strip)
-        , ("--strip-eol",  StripEol)
-        , ("--hashes",  Ansi)
-        , ("--layout",  Layout)
-        , ("--unlit",   Unlit)
-        , ("--nowarn",  SuppressWarnings)
-        ]
-
--- | Parse a single raw command-line option.  Parse failure is indicated by
---   result Nothing.
-rawOption :: String -> Maybe RawOption
-rawOption x | isJust a = a
-    where a = lookup x flags
-rawOption ('-':'D':xs) = Just $ Macro (s, if null d then "1" else tail d)
-    where (s,d) = break (=='=') xs
-rawOption ('-':'U':xs) = Just $ IgnoredForCompatibility
-rawOption ('-':'I':xs) = Just $ Path $ trailing "/\\" xs
-rawOption xs | "--include="`isPrefixOf`xs
-            = Just $ PreInclude (drop 10 xs)
-rawOption _ = Nothing
-
--- | Trim trailing elements of the second list that match any from
---   the first list.  Typically used to remove trailing forward\/back
---   slashes from a directory path.
-trailing :: (Eq a) => [a] -> [a] -> [a]
-trailing xs = reverse . dropWhile (`elem`xs) . reverse
-
--- | Convert a list of RawOption to a BoolOptions structure.
-boolOpts :: [RawOption] -> BoolOptions
-boolOpts opts =
-  BoolOptions
-    { macros    = not (NoMacro `elem` opts)
-    , locations = not (NoLine  `elem` opts)
-    , hashline  = not (LinePragma `elem` opts)
-    , pragma    =      Pragma  `elem` opts
-    , stripEol  =      StripEol`elem` opts
-    , stripC89  =      StripEol`elem` opts || Strip `elem` opts
-    , lang      = not (Text    `elem` opts)
-    , ansi      =      Ansi    `elem` opts
-    , layout    =      Layout  `elem` opts
-    , literate  =      Unlit   `elem` opts
-    , warnings  = not (SuppressWarnings `elem` opts)
-    }
-
--- | Parse all command-line options.
-parseOptions :: [String] -> Either String CpphsOptions
-parseOptions xs = f ([], [], []) xs
-  where
-    f (opts, ins, outs) (('-':'O':x):xs) = f (opts, ins, x:outs) xs
-    f (opts, ins, outs) (x@('-':_):xs) = case rawOption x of
-                                           Nothing -> Left x
-                                           Just a  -> f (a:opts, ins, outs) xs
-    f (opts, ins, outs) (x:xs) = f (opts, normalise x:ins, outs) xs
-    f (opts, ins, outs) []     =
-        Right CpphsOptions { infiles  = reverse ins
-                           , outfiles = reverse outs
-                           , defines  = [ x | Macro x <- reverse opts ]
-                           , includes = [ x | Path x  <- reverse opts ]
-                           , preInclude=[ x | PreInclude x <- reverse opts ]
-                           , boolopts = boolOpts opts
-                           }
-    normalise ('/':'/':filepath) = normalise ('/':filepath)
-    normalise (x:filepath)       = x:normalise filepath
-    normalise []                 = []

@@ -1,106 +0,0 @@------------------------------------------------------------------------------
--- |
--- Module      :  Position
--- Copyright   :  2000-2004 Malcolm Wallace
--- Licence     :  LGPL
---
--- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
--- Stability   :  experimental
--- Portability :  All
---
--- Simple file position information, with recursive inclusion points.
------------------------------------------------------------------------------
-
-module Language.Preprocessor.Cpphs.Position
-  ( Posn(..)
-  , newfile
-  , addcol, newline, tab, newlines, newpos
-  , cppline, haskline, cpp2hask
-  , filename, lineno, directory
-  , cleanPath
-  ) where
-
-import Data.List (isPrefixOf)
-
--- | Source positions contain a filename, line, column, and an
---   inclusion point, which is itself another source position,
---   recursively.
-data Posn = Pn String !Int !Int (Maybe Posn)
-        deriving (Eq)
-
-instance Show Posn where
-      showsPrec _ (Pn f l c i) = showString f .
-                                 showString "  at line " . shows l .
-                                 showString " col " . shows c .
-                                 ( case i of
-                                    Nothing -> id
-                                    Just p  -> showString "\n    used by  " .
-                                               shows p )
-
--- | Constructor.  Argument is filename.
-newfile :: String -> Posn
-newfile name = Pn (cleanPath name) 1 1 Nothing
-
--- | Increment column number by given quantity.
-addcol :: Int -> Posn -> Posn
-addcol n (Pn f r c i) = Pn f r (c+n) i
-
--- | Increment row number, reset column to 1.
-newline :: Posn -> Posn
---newline (Pn f r _ i) = Pn f (r+1) 1 i
-newline (Pn f r _ i) = let r' = r+1 in r' `seq` Pn f r' 1 i
-
--- | Increment column number, tab stops are every 8 chars.
-tab     :: Posn -> Posn
-tab     (Pn f r c i) = Pn f r (((c`div`8)+1)*8) i
-
--- | Increment row number by given quantity.
-newlines :: Int -> Posn -> Posn
-newlines n (Pn f r _ i) = Pn f (r+n) 1 i
-
--- | Update position with a new row, and possible filename.
-newpos :: Int -> Maybe String -> Posn -> Posn
-newpos r Nothing  (Pn f _ c i) = Pn f r c i
-newpos r (Just ('"':f)) (Pn _ _ c i) = Pn (init f) r c i
-newpos r (Just f)       (Pn _ _ c i) = Pn f r c i
-
--- | Project the line number.
-lineno    :: Posn -> Int
--- | Project the filename.
-filename  :: Posn -> String
--- | Project the directory of the filename.
-directory :: Posn -> FilePath
-
-lineno    (Pn _ r _ _) = r
-filename  (Pn f _ _ _) = f
-directory (Pn f _ _ _) = dirname f
-
-
--- | cpp-style printing of file position
-cppline :: Posn -> String
-cppline (Pn f r _ _) = "#line "++show r++" "++show f
-
--- | haskell-style printing of file position
-haskline :: Posn -> String
-haskline (Pn f r _ _) = "{-# LINE "++show r++" "++show f++" #-}"
-
--- | Conversion from a cpp-style "#line" to haskell-style pragma.
-cpp2hask :: String -> String
-cpp2hask line | "#line" `isPrefixOf` line = "{-# LINE "
-                                            ++unwords (tail (words line))
-                                            ++" #-}"
-              | otherwise = line
-
--- | Strip non-directory suffix from file name (analogous to the shell
---   command of the same name).
-dirname :: String -> String
-dirname  = reverse . safetail . dropWhile (not.(`elem`"\\/")) . reverse
-  where safetail [] = []
-        safetail (_:x) = x
-
--- | Sigh.  Mixing Windows filepaths with unix is bad.  Make sure there is a
---   canonical path separator.
-cleanPath :: FilePath -> FilePath
-cleanPath [] = []
-cleanPath ('\\':cs) = '/': cleanPath cs
-cleanPath (c:cs)    = c:   cleanPath cs

@@ -1,55 +0,0 @@------------------------------------------------------------------------------
--- |
--- Module      :  ReadFirst
--- Copyright   :  2004 Malcolm Wallace
--- Licence     :  LGPL
--- 
--- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
--- Stability   :  experimental
--- Portability :  All
---
--- Read the first file that matches in a list of search paths.
------------------------------------------------------------------------------
-
-module Language.Preprocessor.Cpphs.ReadFirst
-  ( readFirst
-  ) where
-
-import System.IO        (hPutStrLn, stderr)
-import System.Directory (doesFileExist)
-import Data.List      (intersperse)
-import Control.Monad     (when)
-import Language.Preprocessor.Cpphs.Position  (Posn,directory,cleanPath)
-
--- | Attempt to read the given file from any location within the search path.
---   The first location found is returned, together with the file content.
---   (The directory of the calling file is always searched first, then
---    the current directory, finally any specified search path.)
-readFirst :: String             -- ^ filename
-        -> Posn                 -- ^ inclusion point
-        -> [String]             -- ^ search path
-        -> Bool                 -- ^ report warnings?
-        -> IO ( FilePath
-              , String
-              )                 -- ^ discovered filepath, and file contents
-
-readFirst name demand path warn =
-    case name of
-       '/':nm -> try nm   [""]
-       _      -> try name (cons dd (".":path))
-  where
-    dd = directory demand
-    cons x xs = if null x then xs else x:xs
-    try name [] = do
-        when warn $
-          hPutStrLn stderr ("Warning: Can't find file \""++name
-                           ++"\" in directories\n\t"
-                           ++concat (intersperse "\n\t" (cons dd (".":path)))
-                           ++"\n  Asked for by: "++show demand)
-        return ("missing file: "++name,"")
-    try name (p:ps) = do
-        let file = cleanPath p++'/':cleanPath name
-        ok <- doesFileExist file
-        if not ok then try name ps
-          else do content <- readFile file
-                  return (file,content)

@@ -1,82 +0,0 @@-{-
--- The main program for cpphs, a simple C pre-processor written in Haskell.
-
--- Copyright (c) 2004 Malcolm Wallace
--- This file is LGPL (relicensed from the GPL by Malcolm Wallace, October 2011).
--}
-module Language.Preprocessor.Cpphs.RunCpphs ( runCpphs
-                                            , runCpphsPass1
-                                            , runCpphsPass2
-                                            , runCpphsReturningSymTab
-                                            ) where
-
-import Language.Preprocessor.Cpphs.CppIfdef (cppIfdef)
-import Language.Preprocessor.Cpphs.MacroPass(macroPass,macroPassReturningSymTab)
-import Language.Preprocessor.Cpphs.Options  (CpphsOptions(..), BoolOptions(..)
-                                            ,trailing)
-import Language.Preprocessor.Cpphs.Tokenise (deWordStyle, tokenise)
-import Language.Preprocessor.Cpphs.Position (cleanPath, Posn)
-import Language.Preprocessor.Unlit as Unlit (unlit)
-
-
-runCpphs :: CpphsOptions -> FilePath -> String -> IO String
-runCpphs options filename input = do
-  pass1 <- runCpphsPass1 options filename input
-  runCpphsPass2 (boolopts options) (defines options) filename pass1
-
-runCpphsPass1 :: CpphsOptions -> FilePath -> String -> IO [(Posn,String)]
-runCpphsPass1 options' filename input = do
-  let options= options'{ includes= map (trailing "\\/") (includes options') }
-  let bools  = boolopts options
-      preInc = case preInclude options of
-                 [] -> ""
-                 is -> concatMap (\f->"#include \""++f++"\"\n") is 
-                       ++ "#line 1 \""++cleanPath filename++"\"\n"
-
-  pass1 <- cppIfdef filename (defines options) (includes options) bools
-                    (preInc++input)
-  return pass1
-
-runCpphsPass2 :: BoolOptions -> [(String,String)] -> FilePath -> [(Posn,String)] -> IO String
-runCpphsPass2 bools defines filename pass1 = do
-  pass2 <- macroPass defines bools pass1
-  let result= if not (macros bools)
-              then if   stripC89 bools || stripEol bools
-                   then concatMap deWordStyle $
-                        tokenise (stripEol bools) (stripC89 bools)
-                                 (ansi bools) (lang bools) pass1
-                   else unlines (map snd pass1)
-              else pass2
-      pass3 = if literate bools then Unlit.unlit filename else id
-  return (pass3 result)
-
-runCpphsReturningSymTab :: CpphsOptions -> FilePath -> String
-             -> IO (String,[(String,String)])
-runCpphsReturningSymTab options' filename input = do
-  let options= options'{ includes= map (trailing "\\/") (includes options') }
-  let bools  = boolopts options
-      preInc = case preInclude options of
-                 [] -> ""
-                 is -> concatMap (\f->"#include \""++f++"\"\n") is 
-                       ++ "#line 1 \""++cleanPath filename++"\"\n"
-  (pass2,syms) <-
-      if macros bools then do
-          pass1 <- cppIfdef filename (defines options) (includes options)
-                            bools (preInc++input)
-          macroPassReturningSymTab (defines options) bools pass1
-      else do
-          pass1 <- cppIfdef filename (defines options) (includes options)
-                            bools{macros=True} (preInc++input)
-          (_,syms) <- macroPassReturningSymTab (defines options) bools pass1
-          pass1 <- cppIfdef filename (defines options) (includes options)
-                            bools (preInc++input)
-          let result = if   stripC89 bools || stripEol bools
-                       then concatMap deWordStyle $
-                            tokenise (stripEol bools) (stripC89 bools)
-                                     (ansi bools) (lang bools) pass1
-                       else init $ unlines (map snd pass1)
-          return (result,syms)
-
-  let pass3 = if literate bools then Unlit.unlit filename else id
-  return (pass3 pass2, syms)
-

@@ -1,92 +0,0 @@------------------------------------------------------------------------------
--- |
--- Module      :  SymTab
--- Copyright   :  2000-2004 Malcolm Wallace
--- Licence     :  LGPL
--- 
--- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
--- Stability   :  Stable
--- Portability :  All
---
--- Symbol Table, based on index trees using a hash on the key.
---   Keys are always Strings.  Stored values can be any type.
------------------------------------------------------------------------------
-
-module Language.Preprocessor.Cpphs.SymTab
-  ( SymTab
-  , emptyST
-  , insertST
-  , deleteST
-  , lookupST
-  , definedST
-  , flattenST
-  , IndTree
-  ) where
-
--- | Symbol Table.  Stored values are polymorphic, but the keys are
---   always strings.
-type SymTab v = IndTree [(String,v)]
-
-emptyST   :: SymTab v
-insertST  :: (String,v) -> SymTab v -> SymTab v
-deleteST  :: String -> SymTab v -> SymTab v
-lookupST  :: String -> SymTab v -> Maybe v
-definedST :: String -> SymTab v -> Bool
-flattenST :: SymTab v -> [v]
-
-emptyST           = itgen maxHash []
-insertST (s,v) ss = itiap (hash s) ((s,v):)    ss id
-deleteST  s    ss = itiap (hash s) (filter ((/=s).fst)) ss id
-lookupST  s    ss = let vs = filter ((==s).fst) ((itind (hash s)) ss)
-                    in if null vs then Nothing
-                       else (Just . snd . head) vs
-definedST s    ss = let vs = filter ((==s).fst) ((itind (hash s)) ss)
-                    in (not . null) vs
-flattenST      ss = itfold (map snd) (++) ss
-
-
-----
--- | Index Trees (storing indexes at nodes).
-
-data IndTree t = Leaf t | Fork Int (IndTree t) (IndTree t)
-     deriving Show
-
-itgen :: Int -> a -> IndTree a
-itgen 1 x = Leaf x
-itgen n x =
-  let n' = n `div` 2
-  in Fork n' (itgen n' x) (itgen (n-n') x)
-
-itiap :: --Eval a =>
-         Int -> (a->a) -> IndTree a -> (IndTree a -> b) -> b
-itiap _ f (Leaf x)       k = let fx = f x in {-seq fx-} (k (Leaf fx))
-itiap i f (Fork n lt rt) k =
-  if i<n then
-       itiap i f lt $ \lt' -> k (Fork n lt' rt)
-  else itiap (i-n) f rt $ \rt' -> k (Fork n lt rt')
-
-itind :: Int -> IndTree a -> a
-itind _ (Leaf x) = x
-itind i (Fork n lt rt) = if i<n then itind i lt else itind (i-n) rt
-
-itfold :: (a->b) -> (b->b->b) -> IndTree a -> b
-itfold leaf _fork (Leaf x) = leaf x
-itfold leaf  fork (Fork _ l r) = fork (itfold leaf fork l) (itfold leaf fork r)
-
-----
--- Hash values
-
-maxHash :: Int -- should be prime
-maxHash = 101
-
-class Hashable a where
-    hashWithMax :: Int -> a -> Int
-    hash        :: a -> Int
-    hash = hashWithMax maxHash
-
-instance Enum a => Hashable [a] where
-    hashWithMax m = h 0
-        where h a []     = a
-              h a (c:cs) = h ((17*(fromEnum c)+19*a)`rem`m) cs
-
-----

@@ -1,281 +0,0 @@------------------------------------------------------------------------------
--- |
--- Module      :  Tokenise
--- Copyright   :  2004 Malcolm Wallace
--- Licence     :  LGPL
---
--- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
--- Stability   :  experimental
--- Portability :  All
---
--- The purpose of this module is to lex a source file (language
--- unspecified) into tokens such that cpp can recognise a replaceable
--- symbol or macro-use, and do the right thing.
------------------------------------------------------------------------------
-
-module Language.Preprocessor.Cpphs.Tokenise
-  ( linesCpp
-  , reslash
-  , tokenise
-  , WordStyle(..)
-  , deWordStyle
-  , parseMacroCall
-  ) where
-
-import Data.Char
-import Language.Preprocessor.Cpphs.HashDefine
-import Language.Preprocessor.Cpphs.Position
-
--- | A Mode value describes whether to tokenise a la Haskell, or a la Cpp.
---   The main difference is that in Cpp mode we should recognise line
---   continuation characters.
-data Mode = Haskell | Cpp
-
--- | linesCpp is, broadly speaking, Prelude.lines, except that
---   on a line beginning with a \#, line continuation characters are
---   recognised.  In a line continuation, the newline character is
---   preserved, but the backslash is not.
-linesCpp :: String -> [String]
-linesCpp  []                 = []
-linesCpp (x:xs) | x=='#'     = tok Cpp     ['#'] xs
-                | otherwise  = tok Haskell [] (x:xs)
-  where
-    tok Cpp   acc ('\\':'\n':ys)   = tok Cpp ('\n':acc) ys
-    tok _     acc ('\n':'#':ys)    = reverse acc: tok Cpp ['#'] ys
-    tok _     acc ('\n':ys)        = reverse acc: tok Haskell [] ys
-    tok _     acc []               = reverse acc: []
-    tok mode  acc (y:ys)           = tok mode (y:acc) ys
-
--- | Put back the line-continuation characters.
-reslash :: String -> String
-reslash ('\n':xs) = '\\':'\n':reslash xs
-reslash (x:xs)    = x: reslash xs
-reslash   []      = []
-
-----
--- | Submodes are required to deal correctly with nesting of lexical
---   structures.
-data SubMode = Any | Pred (Char->Bool) (Posn->String->WordStyle)
-             | String Char | LineComment | NestComment Int
-             | CComment | CLineComment
-
--- | Each token is classified as one of Ident, Other, or Cmd:
---   * Ident is a word that could potentially match a macro name.
---   * Cmd is a complete cpp directive (\#define etc).
---   * Other is anything else.
-data WordStyle = Ident Posn String | Other String | Cmd (Maybe HashDefine)
-  deriving (Eq,Show)
-other :: Posn -> String -> WordStyle
-other _ s = Other s
-
-deWordStyle :: WordStyle -> String
-deWordStyle (Ident _ i) = i
-deWordStyle (Other i)   = i
-deWordStyle (Cmd _)     = "\n"
-
--- | tokenise is, broadly-speaking, Prelude.words, except that:
---    * the input is already divided into lines
---    * each word-like "token" is categorised as one of {Ident,Other,Cmd}
---    * \#define's are parsed and returned out-of-band using the Cmd variant
---    * All whitespace is preserved intact as tokens.
---    * C-comments are converted to white-space (depending on first param)
---    * Parens and commas are tokens in their own right.
---    * Any cpp line continuations are respected.
---   No errors can be raised.
---   The inverse of tokenise is (concatMap deWordStyle).
-tokenise :: Bool -> Bool -> Bool -> Bool -> [(Posn,String)] -> [WordStyle]
-tokenise _        _             _    _     [] = []
-tokenise stripEol stripComments ansi lang ((pos,str):pos_strs) =
-    (if lang then haskell else plaintext) Any [] pos pos_strs str
- where
-    -- rules to lex Haskell
-  haskell :: SubMode -> String -> Posn -> [(Posn,String)]
-             -> String -> [WordStyle]
-  haskell Any acc p ls ('\n':'#':xs)      = emit acc $  -- emit "\n" $
-                                            cpp Any haskell [] [] p ls xs
-    -- warning: non-maximal munch on comment
-  haskell Any acc p ls ('-':'-':xs)       = emit acc $
-                                            haskell LineComment "--" p ls xs
-  haskell Any acc p ls ('{':'-':xs)       = emit acc $
-                                            haskell (NestComment 0) "-{" p ls xs
-  haskell Any acc p ls ('/':'*':xs)
-                          | stripComments = emit acc $
-                                            haskell CComment "  " p ls xs
-  haskell Any acc p ls ('/':'/':xs)
-                          | stripEol      = emit acc $
-                                            haskell CLineComment "  " p ls xs
-  haskell Any acc p ls ('"':xs)           = emit acc $
-                                            haskell (String '"') ['"'] p ls xs
-  haskell Any acc p ls ('\'':'\'':xs)     = emit acc $ -- TH type quote
-                                            haskell Any "''" p ls xs
-  haskell Any acc p ls ('\'':xs@('\\':_)) = emit acc $ -- escaped char literal
-                                            haskell (String '\'') "'" p ls xs
-  haskell Any acc p ls ('\'':x:'\'':xs)   = emit acc $ -- character literal
-                                            emit ['\'', x, '\''] $
-                                            haskell Any [] p ls xs
-  haskell Any acc p ls ('\'':xs)          = emit acc $ -- TH name quote
-                                            haskell Any "'" p ls xs
-  haskell Any acc p ls (x:xs) | single x  = emit acc $ emit [x] $
-                                            haskell Any [] p ls xs
-  haskell Any acc p ls (x:xs) | space x   = emit acc $
-                                            haskell (Pred space other) [x]
-                                                                        p ls xs
-  haskell Any acc p ls (x:xs) | symbol x  = emit acc $
-                                            haskell (Pred symbol other) [x]
-                                                                        p ls xs
- -- haskell Any [] p ls (x:xs) | ident0 x  = id $
-  haskell Any acc p ls (x:xs) | ident0 x  = emit acc $
-                                            haskell (Pred ident1 Ident) [x]
-                                                                        p ls xs
-  haskell Any acc p ls (x:xs)             = haskell Any (x:acc) p ls xs
-
-  haskell pre@(Pred pred ws) acc p ls (x:xs)
-                        | pred x    = haskell pre (x:acc) p ls xs
-  haskell (Pred _ ws) acc p ls xs   = ws p (reverse acc):
-                                      haskell Any [] p ls xs
-  haskell (String c) acc p ls ('\\':x:xs)
-                        | x=='\\'   = haskell (String c) ('\\':'\\':acc) p ls xs
-                        | x==c      = haskell (String c) (c:'\\':acc) p ls xs
-  haskell (String c) acc p ls (x:xs)
-                        | x==c      = emit (c:acc) $ haskell Any [] p ls xs
-                        | otherwise = haskell (String c) (x:acc) p ls xs
-  haskell LineComment acc p ls xs@('\n':_) = emit acc $ haskell Any [] p ls xs
-  haskell LineComment acc p ls (x:xs)      = haskell LineComment (x:acc) p ls xs
-  haskell (NestComment n) acc p ls ('{':'-':xs)
-                                    = haskell (NestComment (n+1))
-                                                            ("-{"++acc) p ls xs
-  haskell (NestComment 0) acc p ls ('-':'}':xs)
-                                    = emit ("}-"++acc) $ haskell Any [] p ls xs
-  haskell (NestComment n) acc p ls ('-':'}':xs)
-                                    = haskell (NestComment (n-1))
-                                                            ("}-"++acc) p ls xs
-  haskell (NestComment n) acc p ls (x:xs) = haskell (NestComment n) (x:acc)
-                                                                        p ls xs
-  haskell CComment acc p ls ('*':'/':xs)  = emit ("  "++acc) $
-                                            haskell Any [] p ls xs
-  haskell CComment acc p ls (x:xs)        = haskell CComment (white x:acc) p ls xs
-  haskell CLineComment acc p ls xs@('\n':_)= emit acc $ haskell Any [] p ls xs
-  haskell CLineComment acc p ls (_:xs)    = haskell CLineComment (' ':acc)
-                                                                       p ls xs
-  haskell mode acc _ ((p,l):ls) []        = haskell mode acc p ls ('\n':l)
-  haskell _    acc _ [] []                = emit acc $ []
-
-  -- rules to lex Cpp
-  cpp :: SubMode -> (SubMode -> String -> Posn -> [(Posn,String)]
-                     -> String -> [WordStyle])
-         -> String -> [String] -> Posn -> [(Posn,String)]
-         -> String -> [WordStyle]
-  cpp mode next word line pos remaining input =
-    lexcpp mode word line remaining input
-   where
-    lexcpp Any w l ls ('/':'*':xs)   = lexcpp (NestComment 0) "" (w*/*l) ls xs
-    lexcpp Any w l ls ('/':'/':xs)   = lexcpp LineComment "  " (w*/*l) ls xs
-    lexcpp Any w l ((p,l'):ls) ('\\':[])  = cpp Any next [] ("\n":w*/*l) p ls l'
-    lexcpp Any w l ls ('\\':'\n':xs) = lexcpp Any [] ("\n":w*/*l) ls xs
-    lexcpp Any w l ls xs@('\n':_)    = Cmd (parseHashDefine ansi
-                                                           (reverse (w*/*l))):
-                                       next Any [] pos ls xs
- -- lexcpp Any w l ls ('"':xs)     = lexcpp (String '"') ['"'] (w*/*l) ls xs
- -- lexcpp Any w l ls ('\'':xs)    = lexcpp (String '\'') "'"  (w*/*l) ls xs
-    lexcpp Any w l ls ('"':xs)       = lexcpp Any [] ("\"":(w*/*l)) ls xs
-    lexcpp Any w l ls ('\'':xs)      = lexcpp Any [] ("'": (w*/*l)) ls xs
-    lexcpp Any [] l ls (x:xs)
-                    | ident0 x  = lexcpp (Pred ident1 Ident) [x] l ls xs
- -- lexcpp Any w l ls (x:xs) | ident0 x  = lexcpp (Pred ident1 Ident) [x] (w*/*l) ls xs
-    lexcpp Any w l ls (x:xs)
-                    | single x  = lexcpp Any [] ([x]:w*/*l) ls xs
-                    | space x   = lexcpp (Pred space other) [x] (w*/*l) ls xs
-                    | symbol x  = lexcpp (Pred symbol other) [x] (w*/*l) ls xs
-                    | otherwise = lexcpp Any (x:w) l ls xs
-    lexcpp pre@(Pred pred _) w l ls (x:xs)
-                    | pred x    = lexcpp pre (x:w) l ls xs
-    lexcpp (Pred _ _) w l ls xs = lexcpp Any [] (w*/*l) ls xs
-    lexcpp (String c) w l ls ('\\':x:xs)
-                    | x=='\\'   = lexcpp (String c) ('\\':'\\':w) l ls xs
-                    | x==c      = lexcpp (String c) (c:'\\':w) l ls xs
-    lexcpp (String c) w l ls (x:xs)
-                    | x==c      = lexcpp Any [] ((c:w)*/*l) ls xs
-                    | otherwise = lexcpp (String c) (x:w) l ls xs
-    lexcpp LineComment w l ((p,l'):ls) ('\\':[])
-                             = cpp LineComment next [] (('\n':w)*/*l) pos ls l'
-    lexcpp LineComment w l ls ('\\':'\n':xs)
-                                = lexcpp LineComment [] (('\n':w)*/*l) ls xs
-    lexcpp LineComment w l ls xs@('\n':_) = lexcpp Any w l ls xs
-    lexcpp LineComment w l ls (_:xs)      = lexcpp LineComment (' ':w) l ls xs
-    lexcpp (NestComment _) w l ls ('*':'/':xs)
-                                          = lexcpp Any [] (w*/*l) ls xs
-    lexcpp (NestComment n) w l ls (x:xs)  = lexcpp (NestComment n) (white x:w) l
-                                                                        ls xs
-    lexcpp mode w l ((p,l'):ls) []        = cpp mode next w l p ls ('\n':l')
-    lexcpp _    _ _ []          []        = []
-
-    -- rules to lex non-Haskell, non-cpp text
-  plaintext :: SubMode -> String -> Posn -> [(Posn,String)]
-            -> String -> [WordStyle]
-  plaintext Any acc p ls ('\n':'#':xs)  = emit acc $  -- emit "\n" $
-                                          cpp Any plaintext [] [] p ls xs
-  plaintext Any acc p ls ('/':'*':xs)
-                           | stripComments = emit acc $
-                                             plaintext CComment "  " p ls xs
-  plaintext Any acc p ls ('/':'/':xs)
-                                | stripEol = emit acc $
-                                             plaintext CLineComment "  " p ls xs
-  plaintext Any acc p ls (x:xs) | single x = emit acc $ emit [x] $
-                                             plaintext Any [] p ls xs
-  plaintext Any acc p ls (x:xs) | space x  = emit acc $
-                                             plaintext (Pred space other) [x]
-                                                                        p ls xs
-  plaintext Any acc p ls (x:xs) | ident0 x = emit acc $
-                                             plaintext (Pred ident1 Ident) [x]
-                                                                        p ls xs
-  plaintext Any acc p ls (x:xs)            = plaintext Any (x:acc) p ls xs
-  plaintext pre@(Pred pred ws) acc p ls (x:xs)
-                                | pred x   = plaintext pre (x:acc) p ls xs
-  plaintext (Pred _ ws) acc p ls xs        = ws p (reverse acc):
-                                             plaintext Any [] p ls xs
-  plaintext CComment acc p ls ('*':'/':xs) = emit ("  "++acc) $
-                                             plaintext Any [] p ls xs
-  plaintext CComment acc p ls (x:xs)       = plaintext CComment (white x:acc) p ls xs
-  plaintext CLineComment acc p ls xs@('\n':_)
-                                        = emit acc $ plaintext Any [] p ls xs
-  plaintext CLineComment acc p ls (_:xs)= plaintext CLineComment (' ':acc)
-                                                                       p ls xs
-  plaintext mode acc _ ((p,l):ls) []    = plaintext mode acc p ls ('\n':l)
-  plaintext _    acc _ [] []            = emit acc $ []
-
-  -- predicates for lexing Haskell.
-  ident0 x = isAlpha x    || x `elem` "_`"
-  ident1 x = isAlphaNum x || x `elem` "'_`"
-  symbol x = x `elem` ":!#$%&*+./<=>?@\\^|-~"
-  single x = x `elem` "(),[];{}"
-  space  x = x `elem` " \t"
-  -- conversion of comment text to whitespace
-  white '\n' = '\n'
-  white '\r' = '\r'
-  white _    = ' '
-  -- emit a token (if there is one) from the accumulator
-  emit ""  = id
-  emit xs  = (Other (reverse xs):)
-  -- add a reversed word to the accumulator
-  "" */* l = l
-  w */* l  = reverse w : l
-  -- help out broken Haskell compilers which need balanced numbers of C
-  -- comments in order to do import chasing :-)  ----->   */*
-
-
--- | Parse a possible macro call, returning argument list and remaining input
-parseMacroCall :: Posn -> [WordStyle] -> Maybe ([[WordStyle]],[WordStyle])
-parseMacroCall p = call . skip
-  where
-    skip (Other x:xs) | all isSpace x = skip xs
-    skip xss                          = xss
-    call (Other "(":xs)   = (args (0::Int) [] [] . skip) xs
-    call _                = Nothing
-    args 0 w acc (   Other ")" :xs)  = Just (reverse (addone w acc), xs)
-    args 0 w acc (   Other "," :xs)  = args 0     []   (addone w acc) (skip xs)
-    args n w acc (x@(Other "("):xs)  = args (n+1) (x:w)         acc    xs
-    args n w acc (x@(Other ")"):xs)  = args (n-1) (x:w)         acc    xs
-    args n w acc (   Ident _ v :xs)  = args n     (Ident p v:w) acc    xs
-    args n w acc (x@(Other _)  :xs)  = args n     (x:w)         acc    xs
-    args _ _ _   _                   = Nothing
-    addone w acc = reverse (skip w): acc

@@ -1,72 +0,0 @@--- | Part of this code is from "Report on the Programming Language Haskell",
---   version 1.2, appendix C.
-module Language.Preprocessor.Unlit (unlit) where
-
-import Data.Char
-import Data.List (isPrefixOf)
-
-data Classified = Program String | Blank | Comment
-                | Include Int String | Pre String
-
-classify :: [String] -> [Classified]
-classify []                = []
-classify (('\\':x):xs) | x == "begin{code}" = Blank : allProg xs
-   where allProg [] = []  -- Should give an error message,
-                          -- but I have no good position information.
-         allProg (('\\':x):xs) |  "end{code}"`isPrefixOf`x = Blank : classify xs
-         allProg (x:xs) = Program x:allProg xs
-classify (('>':x):xs)      = Program (' ':x) : classify xs
-classify (('#':x):xs)      = (case words x of
-                                (line:rest) | all isDigit line
-                                   -> Include (read line) (unwords rest)
-                                _  -> Pre x
-                             ) : classify xs
---classify (x:xs) | "{-# LINE" `isPrefixOf` x = Program x: classify xs
-classify (x:xs) | all isSpace x = Blank:classify xs
-classify (x:xs)                 = Comment:classify xs
-
-unclassify :: Classified -> String
-unclassify (Program s) = s
-unclassify (Pre s)     = '#':s
-unclassify (Include i f) = '#':' ':show i ++ ' ':f
-unclassify Blank       = ""
-unclassify Comment     = ""
-
--- | 'unlit' takes a filename (for error reports), and transforms the
---   given string, to eliminate the literate comments from the program text.
-unlit :: FilePath -> String -> String
-unlit file lhs = (unlines
-                 . map unclassify
-                 . adjacent file (0::Int) Blank
-                 . classify) (inlines lhs)
-
-adjacent :: FilePath -> Int -> Classified -> [Classified] -> [Classified]
-adjacent file 0 _             (x              :xs) = x : adjacent file 1 x xs -- force evaluation of line number
-adjacent file n y@(Program _) (x@Comment      :xs) = error (message file n "program" "comment")
-adjacent file n y@(Program _) (x@(Include i f):xs) = x: adjacent f    i     y xs
-adjacent file n y@(Program _) (x@(Pre _)      :xs) = x: adjacent file (n+1) y xs
-adjacent file n y@Comment     (x@(Program _)  :xs) = error (message file n "comment" "program")
-adjacent file n y@Comment     (x@(Include i f):xs) = x: adjacent f    i     y xs
-adjacent file n y@Comment     (x@(Pre _)      :xs) = x: adjacent file (n+1) y xs
-adjacent file n y@Blank       (x@(Include i f):xs) = x: adjacent f    i     y xs
-adjacent file n y@Blank       (x@(Pre _)      :xs) = x: adjacent file (n+1) y xs
-adjacent file n _             (x@next         :xs) = x: adjacent file (n+1) x xs
-adjacent file n _             []                   = []
-
-message :: String -> Int -> String -> String -> String
-message "\"\"" n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n"
-message []     n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n"
-message file   n p c = "In file " ++ file ++ " at line "++show n++": "++p++ " line before "++c++" line.\n"
-
-
--- Re-implementation of 'lines', for better efficiency (but decreased laziness).
--- Also, importantly, accepts non-standard DOS and Mac line ending characters.
-inlines :: String -> [String]
-inlines s = lines' s id
-  where
-  lines' []             acc = [acc []]
-  lines' ('\^M':'\n':s) acc = acc [] : lines' s id      -- DOS
-  lines' ('\^M':s)      acc = acc [] : lines' s id      -- MacOS
-  lines' ('\n':s)       acc = acc [] : lines' s id      -- Unix
-  lines' (c:s)          acc = lines' s (acc . (c:))
-

@@ -1,9 +0,0 @@-{-# LANGUAGE DuplicateRecordFields #-}
-module Decl.AmbiguousFields where
-
-data A = A { x, y :: Int }
-data B = B { x, y :: Int }
-
-f :: A -> Int
-f = x
-

@@ -1,8 +0,0 @@-module Decl.AnnPragma where
-{-# ANN module (Just "Hello") #-}
-{-# ANN f (Just "Hello") #-}
-f :: Int -> Int
-f a = a + 1
-
-{-# ANN type A (Just "Hello") #-}
-data A = A

@@ -1,10 +0,0 @@-module Decl.ClassInfix where
-
-import Control.Applicative
-
-class Applicative f => MonoidApplicative f where
-   infixl 4 +<*>
-   (+<*>) :: f (a -> a) -> f a -> f a
-
-   infixl 5 ><
-   (><) :: Monoid a => f a -> f a -> f a

@@ -1,9 +0,0 @@-{-# LANGUAGE TypeFamilies #-}
-module Decl.ClosedTypeFamily where
-
-type family F a where
-  F Int  = Bool
-  F Bool = Char
-  F a    = Bool
-
-type family ClosedEmpty t where

@@ -1,10 +0,0 @@-{-# LANGUAGE TypeOperators #-}
-module Decl.CtorOp where
-
-data a :+: b = a :+: b
-
-data (a :!: b) c = a c :!: b c
-
-data ((:-:) a) b = a :-: b
-
-data (:*:) a b = a :*: b

@@ -1,6 +0,0 @@-{-# LANGUAGE TypeFamilies #-}
-module Decl.DataFamily where
-
-data family Array :: * -> *
-
-data instance Array () = UnitArray Int deriving Show

@@ -1,5 +0,0 @@-module Decl.DataType where
-
-data EmptyData
-
-data A = B Int | C

@@ -1,5 +0,0 @@-module Decl.DataTypeDerivings where
-
-data A = A deriving (Eq, Show)
-data B = B deriving (Eq)
-data C = C deriving Eq

@@ -1,3 +0,0 @@-module Decl.DefaultDecl where
-
-default ()

@@ -1,4 +0,0 @@-module Decl.FunBind where
-
-f 0 = 1
-f x = x

@@ -1,5 +0,0 @@-module Decl.FunFixity where
-
-infixl `snoc`
-snoc :: [a] -> a -> [a]
-snoc xs x = xs ++ [x]

@@ -1,5 +0,0 @@-module Decl.FunGuards where
-
-f 0 = 1
-f x | even x = 0
-    | otherwise = 2

@@ -1,6 +0,0 @@-{-# LANGUAGE FunctionalDependencies, MultiParamTypeClasses #-}
-module Decl.FunctionalDeps where
-
-class C a b | a -> b, b -> a where
-  trf :: a -> b
-  

@@ -1,9 +0,0 @@-{-# LANGUAGE GADTs, KindSignatures, DeriveDataTypeable #-}
-module Decl.GADT where
-
-import Data.Typeable
-
-data DMap k f where
-    Tip :: DMap k f
-    Bin :: !Int -> !(k v) -> f v -> !(DMap k f) -> !(DMap k f) -> DMap k f
-    deriving Typeable

@@ -1,5 +0,0 @@-{-# LANGUAGE GADTs #-}
-module Decl.GadtConWithCtx where
-
-data Concurrently m a where
-  Concurrently :: Monad m => { runConcurrently :: m a } -> Concurrently m a

@@ -1,9 +0,0 @@-{-# LANGUAGE DataKinds, TypeOperators, KindSignatures, TypeFamilies #-}
-module Decl.InfixAssertion where
-
-import GHC.TypeLits
-
-data Proxy (n :: Nat) = Proxy
-
-divSNat :: (1 <= b) => Proxy b -> Proxy b
-divSNat n = n

@@ -1,8 +0,0 @@-{-# LANGUAGE TypeOperators, TypeFamilies #-}
-module Decl.InfixInstances where
-
-data Zipper h i a = Zipper
-data (:@) a i
-infixl 8 :>
-type family (:>) h p
-type instance h :> (a :@ i) = Zipper h i a

@@ -1,10 +0,0 @@-{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
-module Decl.InfixPatSyn where
-
-pattern x :. xs <- (uncons -> Just (x,xs)) where
-  x:.xs = cons x xs
-infixr 5 :.
-
-cons x xs = x:xs
-uncons (x:xs) = Just (x,xs)
-uncons [] = Nothing

@@ -1,6 +0,0 @@-{-# LANGUAGE TypeFamilies, TypeFamilyDependencies #-}
-module Decl.InjectiveTypeFamily where
-
-type family Array a = r | r -> a
-
-type instance Array () = Int