haskell-tools-refactor 0.9.0.0 → 1.0.0.0
raw patch · 12 files changed
+291/−98 lines, 12 filesdep ~Cabaldep ~basedep ~ghc
Dependency ranges changed: Cabal, base, ghc, haskell-tools-ast, haskell-tools-backend-ghc, haskell-tools-prettyprint, haskell-tools-rewrite, template-haskell
Files
- Language/Haskell/Tools/Refactor.hs +7/−3
- Language/Haskell/Tools/Refactor/Monad.hs +1/−5
- Language/Haskell/Tools/Refactor/Prepare.hs +50/−37
- Language/Haskell/Tools/Refactor/Representation.hs +1/−5
- Language/Haskell/Tools/Refactor/Utils/AST.hs +1/−1
- Language/Haskell/Tools/Refactor/Utils/BindingElem.hs +1/−3
- Language/Haskell/Tools/Refactor/Utils/Extensions.hs +179/−0
- Language/Haskell/Tools/Refactor/Utils/Helpers.hs +1/−4
- Language/Haskell/Tools/Refactor/Utils/Lists.hs +25/−3
- Language/Haskell/Tools/Refactor/Utils/Monadic.hs +10/−23
- Language/Haskell/Tools/Refactor/Utils/Name.hs +5/−5
- haskell-tools-refactor.cabal +10/−9
Language/Haskell/Tools/Refactor.hs view
@@ -16,12 +16,14 @@ , 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(..) + , shortShowSpan, shortShowSpanWithFile, SrcTemplateStage, SourceInfoTraversal(..) -- elements of source templates , sourceTemplateNodeRange, sourceTemplateNodeElems , sourceTemplateListRange, srcTmpListBefore, srcTmpListAfter, srcTmpDefaultSeparator, srcTmpIndented, srcTmpSeparators , sourceTemplateOptRange, srcTmpOptBefore, srcTmpOptAfter , SourceTemplateTextElem(..), sourceTemplateText + , UnsupportedExtension(..), SpliceInsertionProblem(..), ConvertionProblem(..) + , TransformationProblem(..), BreakUpProblem(..), PrettyPrintProblem(..) ) where -- Important: Haddock doesn't support the rename all exported modules and export them at once hack @@ -29,13 +31,15 @@ import Language.Haskell.Tools.AST.Helpers import Language.Haskell.Tools.AST.References import Language.Haskell.Tools.AST.SemaInfoClasses +import Language.Haskell.Tools.BackendGHC (SpliceInsertionProblem(..), ConvertionProblem(..)) +import Language.Haskell.Tools.PrettyPrint (PrettyPrintProblem(..)) 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.Refactoring import Language.Haskell.Tools.Refactor.Representation +import Language.Haskell.Tools.Refactor.Utils.BindingElem +import Language.Haskell.Tools.Refactor.Utils.Helpers import Language.Haskell.Tools.Refactor.Utils.Indentation import Language.Haskell.Tools.Refactor.Utils.Lists import Language.Haskell.Tools.Refactor.Utils.Monadic
Language/Haskell/Tools/Refactor/Monad.hs view
@@ -1,8 +1,4 @@-{-# LANGUAGE TypeSynonymInstances - , FlexibleInstances - , DeriveFunctor - , GeneralizedNewtypeDeriving - #-} +{-# LANGUAGE FlexibleInstances, 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.
Language/Haskell/Tools/Refactor/Prepare.hs view
@@ -1,17 +1,8 @@-{-# LANGUAGE StandaloneDeriving - , DeriveGeneric - , LambdaCase - , ScopedTypeVariables - , BangPatterns - , MultiWayIf - , FlexibleContexts - , TypeFamilies - , TupleSections - , ViewPatterns - #-} +{-# LANGUAGE FlexibleContexts, LambdaCase, MultiWayIf, ScopedTypeVariables, TypeFamilies #-} -- | Defines utility methods that prepare Haskell modules for refactoring module Language.Haskell.Tools.Refactor.Prepare where +import Control.Exception (Exception(..), throwIO, throw) import Control.Monad import Control.Monad.IO.Class (MonadIO(..)) import Data.List ((\\), isSuffixOf) @@ -27,6 +18,10 @@ import GHC hiding (loadModule) import qualified GHC (loadModule) import GHC.Paths ( libdir ) +import GhcMonad +import HscTypes (HscEnv(..), ModSummary(..)) +import Linker (unload) +import Outputable (Outputable(..), showSDocUnsafe) import Packages (initPackages) import SrcLoc import StringBuffer (hGetStringBuffer) @@ -60,14 +55,19 @@ _ -> error "correctRefactorSpan: no real span" updateSrcFile fn loc = mkRealSrcLoc fn (srcLocLine loc) (srcLocCol loc) --- | Set the given flags for the GHC session +-- | Set the given flags for the GHC session. +-- Also gives back a change function that you can use to apply the settings to any flags. +-- Prints out errors and warnings 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) = change dynflags + let ((leftovers, errs, warnings), newDynFlags) = change dynflags + when (not (null warnings)) + $ liftIO $ putStrLn $ showSDocUnsafe $ ppr warnings + when (not (null errs)) + $ liftIO $ putStrLn $ showSDocUnsafe $ ppr errs void $ setSessionDynFlags newDynFlags when (any ("-package-db" `isSuffixOf`) args) reloadPkgDb return $ (map unLoc leftovers, snd . change) @@ -82,12 +82,16 @@ initGhcFlags = initGhcFlags' False initGhcFlagsForTest :: Ghc () -initGhcFlagsForTest = initGhcFlags' True +initGhcFlagsForTest = do initGhcFlags' True + dfs <- getSessionDynFlags + void $ setSessionDynFlags $ dfs { hscTarget = HscAsm } -- | Sets up basic flags and settings for GHC initGhcFlags' :: Bool -> Ghc () initGhcFlags' needsCodeGen = do dflags <- getSessionDynFlags + env <- getSession + liftIO $ unload env [] -- clear linker state if ghc was used in the same process void $ setSessionDynFlags $ flip gopt_set Opt_KeepRawTokenStream $ flip gopt_set Opt_NoHsMain @@ -154,47 +158,56 @@ -- | Get the typed representation from a type-correct program. 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 - hasOverloadedLabels = OverloadedLabels `xopt` ms_hspp_opts modSum - ms = if hasStaticFlags then forceAsmGen (modSumNormalizeFlags modSum) else (modSumNormalizeFlags modSum)- when hasApplicativeDo $ error "The ApplicativeDo extension is not supported" - when hasOverloadedLabels $ error "The OverloadedLabels extension is not supported" + let hasCppExtension = Cpp `xopt` ms_hspp_opts modSum + ms = modSumNormalizeFlags modSum + when (ApplicativeDo `xopt` ms_hspp_opts modSum) $ liftIO $ throwIO $ UnsupportedExtension "ApplicativeDo" + when (OverloadedLabels `xopt` ms_hspp_opts modSum) $ liftIO $ throwIO $ UnsupportedExtension "OverloadedLabels" + when (ImplicitParams `xopt` ms_hspp_opts modSum) $ liftIO $ throwIO $ UnsupportedExtension "ImplicitParams" p <- parseModule ms - tc <- typecheckModule p -- template haskell needs the correct working directory in the type check phase + tc <- typecheckModule p void $ GHC.loadModule tc -- when used with loadModule, the module will be loaded twice let annots = pm_annotations p srcBuffer <- if hasCppExtension then liftIO $ hGetStringBuffer (getModSumOrig ms) else return (fromJust $ ms_hspp_buf $ pm_mod_summary p) - (if hasCppExtension then prepareASTCpp else prepareAST) srcBuffer . placeComments (fst annots) (getNormalComments $ snd annots) - <$> (addTypeInfos (typecheckedSource tc) - =<< (do parseTrf <- runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModule ms (pm_parsed_source p) - runTrf (fst annots) (getPragmaComments $ snd annots) - $ trfModuleRename ms parseTrf - (fromJust $ tm_renamed_source tc) - (pm_parsed_source p))) + withTempSession (\e -> e { hsc_dflags = ms_hspp_opts ms }) + $ (if hasCppExtension then prepareASTCpp else prepareAST) srcBuffer . placeComments (fst annots) (getNormalComments $ snd annots) + <$> (addTypeInfos (typecheckedSource tc) + =<< (do parseTrf <- runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModule ms (pm_parsed_source p) + runTrf (fst annots) (getPragmaComments $ snd annots) + $ trfModuleRename ms parseTrf + (fromJust $ tm_renamed_source tc) + (pm_parsed_source p))) +data UnsupportedExtension = UnsupportedExtension String + deriving Show + +instance Exception UnsupportedExtension + +trfProblem :: String -> a +trfProblem = throw . UnsupportedExtension + -- | Modifies the dynamic flags for performing a ghc task withAlteredDynFlags :: GhcMonad m => (DynFlags -> m DynFlags) -> m a -> m a withAlteredDynFlags modDFs action = do dfs <- getSessionDynFlags - void $ setSessionDynFlags =<< modDFs dfs + newFlags <- modDFs dfs + void $ modifySession $ \s -> s { hsc_dflags = newFlags } res <- action - void $ setSessionDynFlags dfs + void $ modifySession $ \s -> s { hsc_dflags = dfs } return res -- | Forces the code generation for a given module forceCodeGen :: ModSummary -> ModSummary -forceCodeGen ms = ms { ms_hspp_opts = modOpts' } - where modOpts = (ms_hspp_opts ms) { hscTarget = HscInterpreted } - modOpts' = modOpts { ghcLink = LinkInMemory } +forceCodeGen ms = ms { ms_hspp_opts = codeGenDfs (ms_hspp_opts ms) } +codeGenDfs :: DynFlags -> DynFlags +codeGenDfs dfs = dfs { hscTarget = HscInterpreted, ghcLink = LinkInMemory } + -- | Forces ASM code generation for a given module forceAsmGen :: ModSummary -> ModSummary forceAsmGen ms = ms { ms_hspp_opts = modOpts' } - where modOpts = (ms_hspp_opts ms) { hscTarget = HscAsm } + where modOpts = (ms_hspp_opts ms) { hscTarget = defaultObjectTarget (targetPlatform (ms_hspp_opts ms)) } modOpts' = modOpts { ghcLink = LinkInMemory } -- | Normalizes the flags for a module summary
Language/Haskell/Tools/Refactor/Representation.hs view
@@ -1,8 +1,4 @@-{-# LANGUAGE RecordWildCards - , TypeSynonymInstances - , FlexibleInstances - , TemplateHaskell - #-} +{-# LANGUAGE FlexibleInstances, TemplateHaskell #-} -- | Representation of modules, their collections, refactoring changes and exceptions. module Language.Haskell.Tools.Refactor.Representation where
Language/Haskell/Tools/Refactor/Utils/AST.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE LambdaCase, TupleSections, AllowAmbiguousTypes #-} +{-# LANGUAGE AllowAmbiguousTypes, LambdaCase #-} -- | Operations for changing the AST module Language.Haskell.Tools.Refactor.Utils.AST (removeChild, removeSeparator) where
Language/Haskell/Tools/Refactor/Utils/BindingElem.hs view
@@ -1,6 +1,4 @@-{-# LANGUAGE FlexibleContexts - , TypeFamilies - #-} +{-# LANGUAGE FlexibleContexts, TypeFamilies #-} -- | Utilities for transformations that work on both top-level and local definitions module Language.Haskell.Tools.Refactor.Utils.BindingElem where
+ Language/Haskell/Tools/Refactor/Utils/Extensions.hs view
@@ -0,0 +1,179 @@+ -- all extensions should be matched + +module Language.Haskell.Tools.Refactor.Utils.Extensions where + +import Control.Reference ((^.), _1, _2, _3) +import Language.Haskell.Extension (KnownExtension(..)) +import qualified Language.Haskell.TH.LanguageExtensions as GHC (Extension(..)) + + + +expandExtension :: GHC.Extension -> [GHC.Extension] +expandExtension ext = ext : implied + where fst' = (^. _1) :: (a,b,c) -> a + snd' = (^. _2) :: (a,b,c) -> b + trd' = (^. _3) :: (a,b,c) -> c + + implied = map trd' . filter snd' . filter ((== ext) . fst') $ impliedXFlags + + +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 TypeFamilyDependencies = Just GHC.TypeFamilyDependencies +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
Language/Haskell/Tools/Refactor/Utils/Helpers.hs view
@@ -1,7 +1,4 @@-{-# LANGUAGE LambdaCase - , RankNTypes - , FlexibleContexts - #-} +{-# LANGUAGE FlexibleContexts, LambdaCase, RankNTypes #-} -- | Helper functions for defining refactorings. module Language.Haskell.Tools.Refactor.Utils.Helpers where
Language/Haskell/Tools/Refactor/Utils/Lists.hs view
@@ -1,10 +1,11 @@-{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} -- | 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.Char (isSpace) import Data.List (findIndices) import Language.Haskell.Tools.AST @@ -33,10 +34,16 @@ -- | 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 ls@(AnnListG _ elems) + | all (uncurry pred) (zip [0..] elems) + = return ls 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 + return $ AnnListG (NodeInfo sema (srcTmpIndented .- fmap filterIndents + $ srcTmpSeparators .- filterSeparators + $ srcTmpListBefore .- (++ movedBefore) + $ src)) filteredElems where elementsKept = findIndices (uncurry pred) (zip [0..] elems) filteredElems = sublist elementsKept elems removedSeparators :: [([SourceTemplateTextElem], SrcSpan)] @@ -46,7 +53,11 @@ removedElems = notSublist elementsKept elems filterIndents = sublist elementsKept filterSeparators = take (length elementsKept - 1) . sublist elementsKept - + -- if only one element remains we want to keep the whitespace before the first element + movedBefore = case elementsKept of + [e] | e > 0 && any @[] isStayingText (removedSeparators ^? traversal & _1 & traversal) && maybe True (not . and) (src ^. srcTmpIndented) + -> concatMap (takeWhile isSpace . (^. sourceTemplateText)) . reverse . takeWhile (not . isStayingText) . reverse $ (src ^? srcTmpSeparators & traversal & _1) !! (e - 1) + _ -> "" -- | Selects the given indices from a list sublist :: [Int] -> [a] -> [a] @@ -100,3 +111,14 @@ | otherwise = zip (([], noSrcSpan) : seps ++ repeat (_2 .= noSrcSpan $ last seps)) elems where seps = src ^. srcTmpSeparators + +-- sortList :: Ord a => (Ann e dom -> a) -> AnnList e dom -> AnnList e dom +-- sortList comp (AnnListG annot elems) +-- = AnnListG ( .- permuteList permute $ annot) sortedElems +-- where (permute, sortedElems) = unzip (sortBy (comp . snd)) indElems +-- indElems = zip [0..] elems +-- +-- permuteList :: [Int] -> [a] -> [a] +-- permuteList permute = map snd . sortBy fst . zip permute + +
Language/Haskell/Tools/Refactor/Utils/Monadic.hs view
@@ -1,42 +1,29 @@-{-# LANGUAGE GeneralizedNewtypeDeriving - , TypeFamilies - , ViewPatterns - , StandaloneDeriving - , LambdaCase - , FlexibleInstances - , FlexibleContexts - , TypeSynonymInstances - , MultiWayIf - , TemplateHaskell - , ViewPatterns - , TypeApplications - , RecordWildCards - #-} +{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiWayIf, TypeApplications, TypeFamilies #-} -- | Basic utilities and types for defining refactorings. module Language.Haskell.Tools.Refactor.Utils.Monadic where -import Control.Monad.Reader +import Control.Monad.Reader (Monad(..), ReaderT(..), MonadReader(..)) import Control.Monad.State.Strict -import Control.Monad.Trans.Except -import Control.Monad.Writer +import Control.Monad.Trans.Except (runExceptT) +import Control.Monad.Writer (Monad(..), WriterT(..), MonadWriter(..)) import Control.Reference hiding (element) import Data.Either import Data.Function (on) import Data.List -import Data.List.Split +import Data.List.Split (splitOn) import Data.Maybe import GHC hiding (mkModuleName, moduleNameString) -import qualified Module as GHC +import qualified Module as GHC (Module(..), moduleNameString) import qualified Name as GHC -import qualified PrelNames as GHC -import qualified TyCon as GHC -import qualified TysWiredIn as GHC +import qualified PrelNames as GHC (basicKnownKeyNames) +import qualified TyCon as GHC (TyCon(..)) +import qualified TysWiredIn as GHC (wiredInTyCons) 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.Refactor.Representation (RefactorChange(..), ModuleDom, UnnamedModule) import Language.Haskell.Tools.Rewrite -- | Performs the given refactoring, transforming it into a Ghc action
Language/Haskell/Tools/Refactor/Utils/Name.hs view
@@ -55,14 +55,14 @@ 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 (c : nameRest) | isUpper c && isLetter c && all isIdChar 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 (c : nameRest) | ((isLower c && isLetter c) || c == '\'' || c == '_') && all isIdChar 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 == '_' +isIdChar :: Char -> Bool +isIdChar c = isLetter c || isDigit c || c == '\'' || c == '_' isOperatorChar :: Char -> Bool -isOperatorChar c = (isPunctuation c || isSymbol c) && isAscii c +isOperatorChar c = isPunctuation c || isSymbol c
haskell-tools-refactor.cabal view
@@ -1,5 +1,5 @@ name: haskell-tools-refactor -version: 0.9.0.0 +version: 1.0.0.0 synopsis: Refactoring Tool for Haskell description: Contains a set of refactorings based on the Haskell-Tools framework to easily transform a Haskell program. For the descriptions of the implemented refactorings, see the homepage. homepage: https://github.com/haskell-tools/haskell-tools @@ -25,8 +25,9 @@ , Language.Haskell.Tools.Refactor.Utils.AST , Language.Haskell.Tools.Refactor.Refactoring , Language.Haskell.Tools.Refactor.Utils.Indentation + , Language.Haskell.Tools.Refactor.Utils.Extensions - build-depends: base >= 4.9 && < 4.10 + build-depends: base >= 4.10 && < 4.11 , mtl >= 2.2 && < 2.3 , uniplate >= 1.6 && < 1.7 , ghc-paths >= 0.1 && < 0.2 @@ -36,11 +37,11 @@ , references >= 0.3 && < 0.4 , split >= 0.2 && < 0.3 , filepath >= 1.4 && < 1.5 - , template-haskell >= 2.11 && < 2.12 - , ghc >= 8.0 && < 8.1 - , Cabal >= 1.24 && < 1.25 - , haskell-tools-ast >= 0.9 && < 0.10 - , haskell-tools-backend-ghc >= 0.9 && < 0.10 - , haskell-tools-rewrite >= 0.9 && < 0.10 - , haskell-tools-prettyprint >= 0.9 && < 0.10 + , template-haskell >= 2.12 && < 2.13 + , ghc >= 8.2 && < 8.3 + , Cabal >= 2.0 && < 2.1 + , haskell-tools-ast >= 1.0 && < 1.1 + , haskell-tools-backend-ghc >= 1.0 && < 1.1 + , haskell-tools-rewrite >= 1.0 && < 1.1 + , haskell-tools-prettyprint >= 1.0 && < 1.1 default-language: Haskell2010