Merge pull request #100 from zliu41/parsed

Add applyRefactorings'

Author: zliu41

src/Refact/Apply.hs

@@ -2,17 +2,20 @@
 
 module Refact.Apply
   ( applyRefactorings
+  , applyRefactorings'
   , runRefactoring
   , parseExtensions
   ) where
 
 import Control.Monad (unless)
 import Data.List (intercalate)
-import Refact.Fixity
+import Language.Haskell.GHC.ExactPrint.Types (Anns)
+import Refact.Fixity (applyFixities)
 import Refact.Internal
-import Refact.Types
+import Refact.Types (Refactoring, SrcSpan)
+import Refact.Utils (Module)
 
--- | Apply a set of refactorings as supplied by hlint
+-- | Apply a set of refactorings as supplied by HLint
 applyRefactorings
   :: Maybe (Int, Int)
   -- ^ Apply hints relevant to a specific position
@@ -39,4 +42,16 @@ applyRefactorings optionsPos inp file exts = do
   unless (null invalid) . fail $ "Unsupported extensions: " ++ intercalate ", " invalid
   (as, m) <- either (onError "apply") (uncurry applyFixities)
               =<< parseModuleWithArgs (enabled, disabled) file
-  apply optionsPos False ((mempty,) <$> inp) file Silent as m
+  apply optionsPos False ((mempty,) <$> inp) (Just file) Silent as m
+
+-- | Like 'applyRefactorings', but takes a parsed module rather than a file path to parse.
+applyRefactorings'
+  :: Maybe (Int, Int)
+  -> [[Refactoring SrcSpan]]
+  -> Anns
+  -- ^ ghc-exactprint AST annotations. This can be obtained from
+  -- 'Language.Haskell.GHC.ExactPrint.Parsers.postParseTransform'.
+  -> Module
+  -- ^ Parsed module
+  -> IO String
+applyRefactorings' optionsPos inp = apply optionsPos False ((mempty,) <$> inp) Nothing Silent

src/Refact/Internal.hs

@@ -49,6 +49,7 @@ import Data.Maybe
 import Data.List
 import Data.Ord
 import DynFlags hiding (initDynFlags)
+import FastString (unpackFS)
 import HeaderInfo (getOptions)
 import HscTypes (handleSourceError)
 import GHC.IO.Exception (IOErrorType(..))
@@ -82,7 +83,7 @@ import qualified RdrName as GHC
 import Refact.Types hiding (SrcSpan)
 import qualified Refact.Types as R
 import Refact.Utils (Stmt, Pat, Name, Decl, M, Module, Expr, Type, FunBind
-                    , modifyAnnKey, replaceAnnKey, Import, toGhcSrcSpan, setSrcSpanFile)
+                    , modifyAnnKey, replaceAnnKey, Import, toGhcSrcSpan, toGhcSrcSpan', setSrcSpanFile)
 
 #if __GLASGOW_HASKELL__ >= 810
 type Errors = ErrorMessages
@@ -117,14 +118,22 @@ apply
   :: Maybe (Int, Int)
   -> Bool
   -> [(String, [Refactoring R.SrcSpan])]
-  -> FilePath
+  -> Maybe FilePath
   -> Verbosity
   -> Anns
   -> Module
   -> IO String
-apply mpos step inp file verb as0 m0 = do
+apply mpos step inp mbfile verb as0 m0 = do
+  toGhcSS <-
+    maybe
+      ( case getLoc m0 of
+          UnhelpfulSpan s -> fail $ "Module has UnhelpfulSpan: " ++ unpackFS s
+          RealSrcSpan s -> pure $ toGhcSrcSpan' (srcSpanFile s)
+      )
+      (pure . toGhcSrcSpan)
+      mbfile
   let noOverlapInp = removeOverlap verb inp
-      allRefacts = (fmap . fmap . fmap) (toGhcSrcSpan file) <$> noOverlapInp
+      allRefacts = (fmap . fmap . fmap) toGhcSS <$> noOverlapInp
 
       posFilter (_, rs) =
         case mpos of

src/Refact/Run.hs

@@ -90,7 +90,7 @@ runPipe Options{..} file = do
     (as, m) <- either (onError "runPipe") (uncurry applyFixities)
                 =<< parseModuleWithArgs (enabledExts, disabledExts) file
     when optionsDebug (putStrLn (showAnnData as 0 m))
-    apply optionsPos optionsStep inp file verb as m
+    apply optionsPos optionsStep inp (Just file) verb as m
 
   if optionsInplace && isJust optionsTarget
     then writeFileUTF8 file output

src/Refact/Utils.hs

@@ -23,6 +23,7 @@ module Refact.Utils ( -- * Synonyms
                     , modifyAnnKey
                     , replaceAnnKey
                     , toGhcSrcSpan
+                    , toGhcSrcSpan'
                     , setSrcSpanFile
                     , findParent
 
@@ -189,12 +190,15 @@ replaceAnnKey :: AnnKey -> AnnKey -> AnnKey -> AnnKey -> Anns -> Anns
 replaceAnnKey old new inp deltainfo a =
   fromMaybe a (replace old new inp deltainfo a)
 
-
 -- | Convert a @Refact.Types.SrcSpan@ to a @SrcLoc.SrcSpan@
 toGhcSrcSpan :: FilePath -> R.SrcSpan -> SrcSpan
-toGhcSrcSpan file R.SrcSpan{..} = mkSrcSpan (f startLine startCol) (f endLine endCol)
+toGhcSrcSpan = toGhcSrcSpan' . GHC.mkFastString
+
+-- | Convert a @Refact.Types.SrcSpan@ to a @SrcLoc.SrcSpan@
+toGhcSrcSpan' :: FastString -> R.SrcSpan -> SrcSpan
+toGhcSrcSpan' file R.SrcSpan{..} = mkSrcSpan (f startLine startCol) (f endLine endCol)
   where
-    f = mkSrcLoc (GHC.mkFastString file)
+    f = mkSrcLoc file
 
 setSrcSpanFile :: FastString -> SrcSpan -> SrcSpan
 setSrcSpanFile file s