diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,11 @@ +v0.3.0.1 + + * Version bound tweaking to build with optparse-applicative 0.13 + +v0.3 + + * GHC 8.0 compatability + v0.2 * API refactoring to make the tool usable as a library. diff --git a/apply-refact.cabal b/apply-refact.cabal --- a/apply-refact.cabal +++ b/apply-refact.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: apply-refact -version: 0.3.0.0 +version: 0.3.0.1 synopsis: Perform refactorings specified by the refact library. description: Perform refactorings specified by the refact library. license: BSD3 @@ -33,7 +33,7 @@ build-depends: base >=4.8 && <4.10 , refact >= 0.2 , ghc-exactprint >= 0.5.2 - , ghc == 8.0.1 + , ghc >= 8.0.1 && < 8.1 , containers , syb , mtl @@ -54,13 +54,13 @@ build-depends: base >= 4.8 && < 4.10 , refact >= 0.2 , ghc-exactprint >= 0.5.2 - , ghc == 8.0.1 + , ghc >= 8.0.1 && < 8.1 , containers , syb , mtl , process , directory - , optparse-applicative + , optparse-applicative >= 0.13 , filemanip , unix-compat , filepath @@ -81,7 +81,7 @@ , base < 5 , refact >= 0.2 , ghc-exactprint >= 0.5.2 - , ghc == 8.0.1 + , ghc >= 8.0.1 && < 8.1 , containers , syb , mtl diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -26,6 +26,7 @@ import Options.Applicative import Data.Maybe +import Data.Monoid ( (<>) ) import Control.Monad.Trans.Maybe import Data.List hiding (find) diff --git a/src/Refact/Apply.hs b/src/Refact/Apply.hs --- a/src/Refact/Apply.hs +++ b/src/Refact/Apply.hs @@ -185,6 +185,7 @@ go imp@(GHC.L l i) | l == pos = GHC.L l (i { ideclAs = Nothing }) | otherwise = imp +-- Specialised parsers parseModuleName :: GHC.SrcSpan -> Parser (GHC.Located GHC.ModuleName) @@ -244,6 +245,10 @@ -- Used for Monad10, Monad11 tests. -- The issue being that in one case the information is attached to a VarPat -- but we need to move the annotations onto the actual name +-- +-- This looks convoluted but we can't match directly on a located name as +-- it is not specific enough. Instead we match on some bigger context which +-- is contains the located name we want to replace. identSub :: Data a => a -> [(String, GHC.SrcSpan)] -> FunBind -> M FunBind identSub m subs old@(GHC.FunBindMatch (GHC.L _ name) _) = resolveRdrName' subst (findName m) old subs name @@ -251,6 +256,8 @@ subst :: FunBind -> Name -> M FunBind subst (GHC.FunBindMatch n b) new = do let fakeExpr = GHC.L (getLoc new) (GHC.VarPat new) + -- Low level version as we need to combine the annotation information + -- from the template RdrName and the original VarPat. modify (\r -> replaceAnnKey r (mkAnnKey n) (mkAnnKey fakeExpr) (mkAnnKey new) (mkAnnKey fakeExpr)) return $ GHC.FunBindMatch new b subst o _ = return o @@ -260,9 +267,13 @@ -- g is usually modifyAnnKey -- f is usually a function which checks the locations are equal -resolveRdrName' :: - (a -> b -> M a) -> (SrcSpan -> b) -> a - -> [(String, GHC.SrcSpan)] -> GHC.RdrName -> M a +resolveRdrName' :: (a -> b -> M a) -- How to combine the value to insert and the replaced value + -> (SrcSpan -> b) -- How to find the new value, when given the location it is in + -> a -- The old thing which we are going to possibly replace + -> [(String, GHC.SrcSpan)] -- Substs + -> GHC.RdrName -- The name of the position in the template + --we are replacing into + -> M a resolveRdrName' g f old subs name = case name of -- Todo: this should replace anns as well? @@ -290,6 +301,7 @@ , annEntryDelta = DP (1,0) }) k as +-- Substitute the template into the original AST. doGenReplacement :: (Data ast, Data a) => a -> (GHC.Located ast -> Bool) diff --git a/src/Refact/Utils.hs b/src/Refact/Utils.hs --- a/src/Refact/Utils.hs +++ b/src/Refact/Utils.hs @@ -74,7 +74,14 @@ type FunBind = MatchFixity GHC.RdrName -- | Replaces an old expression with a new expression -replace :: AnnKey -> AnnKey -> AnnKey -> AnnKey -> Anns -> Maybe Anns +-- +-- Note that usually, new, inp and parent are all the same. +replace :: AnnKey -- The thing we are replacing + -> AnnKey -- The thing which has the annotations we need for the new thing + -> AnnKey -- The thing which is going to be inserted + -> AnnKey -- The "parent", the largest thing which has he same SrcSpan + -- Usually the same as inp and new + -> Anns -> Maybe Anns replace old new inp parent anns = do oldan <- Map.lookup old anns newan <- Map.lookup new anns @@ -97,7 +104,7 @@ AnnSemiSep -> False _ -> True) - -- Make sure to keep structural information when replacing. + -- Make sure to keep structural information in the template. extraComma [] = [] extraComma (last -> x) = case fst x of G GHC.AnnComma -> [x] @@ -105,6 +112,7 @@ G GHC.AnnSemi -> [x] _ -> [] + -- Keep the same delta if moving onto a new row newEntryDelta | deltaRow oldDelta > 0 = oldDelta | otherwise = annEntryDelta oldann @@ -113,12 +121,13 @@ findParent :: Data a => GHC.SrcSpan -> Anns -> a -> Maybe AnnKey findParent ss as = something (findParentWorker ss as) - +-- Note that a parent must also have an annotation. findParentWorker :: forall a . (Data a) => GHC.SrcSpan -> Anns -> a -> Maybe AnnKey findParentWorker oldSS as a | con == typeRepTyCon (typeRep (Proxy :: Proxy (GHC.Located GHC.RdrName))) && x == typeRep (Proxy :: Proxy GHC.SrcSpan) - = if ss == oldSS && isJust (Map.lookup (AnnKey ss cn) as) + = if ss == oldSS + && isJust (Map.lookup (AnnKey ss cn) as) then Just $ AnnKey ss cn else Nothing | otherwise = Nothing