module Language.Haskell.Tools.Refactor.Refactoring where
import Control.Monad.Trans.Except (runExceptT)
import Data.List ((++), map, find)
import Data.Aeson()
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)
data RefactoringChoice
= NamingRefactoring { refactoringName :: String
, namingRefactoring :: RealSrcSpan -> String -> Refactoring
}
| SelectionRefactoring { refactoringName :: String
, selectionRefactoring :: RealSrcSpan -> Refactoring
}
| ModuleRefactoring { refactoringName :: String
, moduleRefactoring :: Refactoring
}
| ProjectRefactoring { refactoringName :: String
, projectRefactoring :: ProjectRefactoring
}
performCommand :: [RefactoringChoice]
-> [String]
-> Either FilePath ModuleDom
-> [ModuleDom]
-> Ghc (Either String [RefactorChange])
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
refactorCommands :: [RefactoringChoice] -> [String]
refactorCommands = map refactoringName