haskell-tools-daemon 0.5.0.0 → 0.6.0.0

raw patch · 15 files changed

+545/−239 lines, 15 filesdep +Diffdep +strictdep ~HUnitdep ~haskell-tools-astdep ~haskell-tools-daemonPVP ok

version bump matches the API change (PVP)

Dependencies added: Diff, strict

Dependency ranges changed: HUnit, haskell-tools-ast, haskell-tools-daemon, haskell-tools-prettyprint, haskell-tools-refactor

API changes (from Hackage documentation)

Files

• Language/Haskell/Tools/Refactor/Daemon.hs +134/−73
• Language/Haskell/Tools/Refactor/Daemon/PackageDB.hs +32/−3
• examples/Project/additional-files/A.hs +5/−0
• examples/Project/additional-files/B.hs +3/−0
• examples/Project/additional-files/some-test-package.cabal +19/−0
• examples/Project/cabal-sandbox/UseGroups.hs +7/−0
• examples/Project/cabal-sandbox/groups-0.4.0.0/LICENSE +30/−0
• examples/Project/cabal-sandbox/groups-0.4.0.0/Setup.hs +2/−0
• examples/Project/cabal-sandbox/groups-0.4.0.0/groups.cabal +19/−0
• examples/Project/cabal-sandbox/groups-0.4.0.0/src/Data/Group.hs +92/−0
• examples/Project/cabal-sandbox/some-test-package.cabal +18/−0
• examples/Project/th-added-later/package1/package1.cabal +2/−2
• examples/Project/th-added-later/package2/package2.cabal +2/−2
• haskell-tools-daemon.cabal +21/−12
• test/Main.hs +159/−147

@@ -1,5 +1,5 @@ {-# LANGUAGE ScopedTypeVariables
-           , OverloadedStrings 
+           , OverloadedStrings
            , DeriveGeneric
            , LambdaCase
            , TemplateHaskell
@@ -15,9 +15,12 @@ import Control.Reference
 import qualified Data.Aeson as A ((.=))
 import Data.Aeson hiding ((.=))
+import Data.Algorithm.Diff
+import qualified Data.ByteString.Char8 as StrictBS
 import Data.ByteString.Lazy.Char8 (ByteString)
 import Data.ByteString.Lazy.Char8 (unpack)
 import qualified Data.ByteString.Lazy.Char8 as BS
+import Data.Either
 import Data.IORef
 import Data.List hiding (insert)
 import qualified Data.Map as Map
@@ -29,6 +32,7 @@ import System.Directory
 import System.Environment
 import System.IO
+import System.IO.Strict as StrictIO (hGetContents)
 
 import Bag
 import DynFlags
@@ -53,8 +57,6 @@ 
 import Debug.Trace
 
--- TODO: handle boot files
-
 runDaemonCLI :: IO ()
 runDaemonCLI = getArgs >>= runDaemon
 
@@ -62,14 +64,13 @@ runDaemon args = withSocketsDo $
     do let finalArgs = args ++ drop (length args) defaultArgs
            isSilent = read (finalArgs !! 1)
+       hSetBuffering stdout LineBuffering
+       hSetBuffering stderr LineBuffering
        when (not isSilent) $ putStrLn $ "Starting Haskell Tools daemon"
-       addrinfos <- getAddrInfo
-                    (Just (defaultHints {addrFlags = [AI_PASSIVE]}))
-                    Nothing (Just (finalArgs !! 0))
-       let serveraddr = head addrinfos
-       sock <- socket (addrFamily serveraddr) Stream defaultProtocol
+       sock <- socket AF_INET Stream 0
        setSocketOption sock ReuseAddr 1
-       bind sock (addrAddress serveraddr)
+       when (not isSilent) $ putStrLn $ "Listening on port " ++ finalArgs !! 0
+       bind sock (SockAddrInet (read (finalArgs !! 0)) iNADDR_ANY)
        listen sock 1
        clientLoop isSilent sock
 
@@ -117,38 +118,10 @@ updateClient :: (ResponseMsg -> IO ()) -> ClientMessage -> StateT DaemonSessionState Ghc Bool
 updateClient resp KeepAlive = liftIO (resp KeepAliveResponse) >> return True
 updateClient resp Disconnect = liftIO (resp Disconnected) >> return False
-updateClient _ (SetPackageDB pkgDB) = modify (packageDB .= pkgDB) >> return True 
+updateClient _ (SetPackageDB pkgDB) = modify (packageDB .= pkgDB) >> return True
 updateClient resp (AddPackages packagePathes) = do
-    existingMCs <- gets (^. refSessMCs)
-    let existing = map ms_mod $ (existingMCs ^? traversal & filtered isTheAdded & mcModules & traversal & modRecMS)
-    needToReload <- (filter (\ms -> not $ ms_mod ms `elem` existing)) 
-                      <$> getReachableModules (\ms -> ms_mod ms `elem` existing)
-    modify $ refSessMCs .- filter (not . isTheAdded) -- remove the added package from the database
-    forM_ existing $ \mn -> removeTarget (TargetModule (GHC.moduleName mn))
-    modifySession (\s -> s { hsc_mod_graph = filter (not . (`elem` existing) . ms_mod) (hsc_mod_graph s) })
-    initializePackageDBIfNeeded
-    res <- loadPackagesFrom (return . getModSumOrig) packagePathes
-    case res of 
-      Right (modules, ignoredMods) -> do
-        mapM_ (reloadModule (\_ -> return ())) needToReload -- don't report consequent reloads (not expected)
-        liftIO $ resp 
-          $ if not (null ignoredMods) 
-              then ErrorMessage 
-                     $ "The following modules are ignored: " 
-                         ++ concat (intersperse ", " ignoredMods)
-                         ++ ". Multiple modules with the same qualified name are not supported."
-              else LoadedModules modules
-      Left err -> liftIO $ resp $ either ErrorMessage CompilationProblem (getProblems err) 
+    addPackages resp packagePathes
     return True
-  where isTheAdded mc = (mc ^. mcRoot) `elem` packagePathes
-        initializePackageDBIfNeeded = do
-          pkgDBAlreadySet <- gets (^. packageDBSet)
-          when (not pkgDBAlreadySet) $ do
-            pkgDB <- gets (^. packageDB)
-            pkgDBLocs <- liftIO $ packageDBLocs pkgDB packagePathes
-            usePackageDB pkgDBLocs
-            modify (packageDBSet .= True)
-
 updateClient _ (RemovePackages packagePathes) = do
     mcs <- gets (^. refSessMCs)
     let existing = map ms_mod (mcs ^? traversal & filtered isRemoved & mcModules & traversal & modRecMS)
@@ -159,14 +132,22 @@     return True
   where isRemoved mc = (mc ^. mcRoot) `elem` packagePathes
 
-updateClient resp (ReLoad changed removed) =
+updateClient resp (ReLoad added changed removed) =
+  -- TODO: check for changed cabal files and reload their packages
   do removedMods <- gets (map ms_mod . filter ((`elem` removed) . getModSumOrig) . (^? refSessMCs & traversal & mcModules & traversal & modRecMS))
      lift $ forM_ removedMods (\modName -> removeTarget (TargetModule (GHC.moduleName modName)))
-     modify $ refSessMCs & traversal & mcModules 
+     -- remove targets deleted
+     modify $ refSessMCs & traversal & mcModules
                 .- Map.filter (\m -> maybe True (not . (`elem` removed) . getModSumOrig) (m ^? modRecMS))
      modifySession (\s -> s { hsc_mod_graph = filter (not . (`elem` removedMods) . ms_mod) (hsc_mod_graph s) })
-     reloadRes <- reloadChangedModules (\ms -> resp (LoadedModules [getModSumOrig ms]))
+     -- reload changed modules
+     -- TODO: filter those that are in reloaded packages
+     reloadRes <- reloadChangedModules (\ms -> resp (LoadedModules [(getModSumOrig ms, getModSumName ms)]))
+                                       (\mss -> resp (LoadingModules (map getModSumOrig mss)))
                                        (\ms -> getModSumOrig ms `elem` changed)
+     mcs <- gets (^. refSessMCs)
+     let mcsToReload = filter (\mc -> any ((mc ^. mcRoot) `isPrefixOf`) added && isNothing (moduleCollectionPkgId (mc ^. mcId))) mcs
+     addPackages resp (map (^. mcRoot) mcsToReload) -- reload packages containing added modules
      liftIO $ case reloadRes of Left errs -> resp (either ErrorMessage CompilationProblem (getProblems errs))
                                 Right _ -> return ()
      return True
@@ -174,51 +155,129 @@ updateClient _ Stop = modify (exiting .= True) >> return False
 
 updateClient resp (PerformRefactoring refact modPath selection args) = do
-    (Just actualMod, otherMods) <- getFileMods modPath
-    let cmd = analyzeCommand refact (selection:args)
-    res <- lift $ performCommand cmd actualMod otherMods
-    case res of
-      Left err -> liftIO $ resp $ ErrorMessage err
-      Right diff -> do changedMods <- catMaybes <$> applyChanges diff
-                       liftIO $ resp $ ModulesChanged (map snd changedMods)
-                       -- when a new module is added, we need to compile it with the correct package db
-                       void $ reloadChanges (map ((^. sfkModuleName) . fst) changedMods)
+    (selectedMod, otherMods) <- getFileMods modPath
+    case selectedMod of
+      Just actualMod -> do
+        case analyzeCommand refact (selection:args) of
+           Right cmd -> do res <- lift $ performCommand cmd actualMod otherMods
+                           case res of
+                             Left err -> liftIO $ resp $ ErrorMessage err
+                             Right diff -> do changedMods <- applyChanges diff
+                                              liftIO $ resp $ ModulesChanged (map (either id (\(_,_,ch) -> ch)) changedMods)
+                                              void $ reloadChanges (map ((^. sfkModuleName) . (\(key,_,_) -> key)) (rights changedMods))
+           Left err -> liftIO $ resp $ ErrorMessage err
+      Nothing -> liftIO $ resp $ ErrorMessage $ "The following file is not loaded to Haskell-tools: "
+                                                   ++ modPath ++ ". Please add the containing package."
     return True
-  where applyChanges changes = do 
-          forM changes $ \case 
-            ModuleCreated n m otherM -> do 
+
+  where applyChanges changes = do
+          forM changes $ \case
+            ModuleCreated n m otherM -> do
               mcs <- gets (^. refSessMCs)
               Just (_, otherMR) <- gets (lookupModInSCs otherM . (^. refSessMCs))
 
               let Just otherMS = otherMR ^? modRecMS
                   Just mc = lookupModuleColl (otherM ^. sfkModuleName) mcs
-              modify $ refSessMCs & traversal & filtered (\mc' -> (mc' ^. mcId) == (mc ^. mcId)) & mcModules 
+              modify $ refSessMCs & traversal & filtered (\mc' -> (mc' ^. mcId) == (mc ^. mcId)) & mcModules
                          .- Map.insert (SourceFileKey NormalHs n) (ModuleNotLoaded False)
               otherSrcDir <- liftIO $ getSourceDir otherMS
               let loc = toFileName otherSrcDir n
-              liftIO $ withBinaryFile loc WriteMode (`hPutStr` prettyPrint m)
+              liftIO $ withBinaryFile loc WriteMode $ \handle -> do
+                hSetEncoding handle utf8
+                hPutStr handle (prettyPrint m)
               lift $ addTarget (Target (TargetModule (GHC.mkModuleName n)) True Nothing)
-              return $ Just (SourceFileKey NormalHs n, loc)
+              return $ Right (SourceFileKey NormalHs n, loc, RemoveAdded loc)
             ContentChanged (n,m) -> do
               Just (_, mr) <- gets (lookupModInSCs n . (^. refSessMCs))
               let Just ms = mr ^? modRecMS
-              liftIO $ withBinaryFile (getModSumOrig ms) WriteMode (`hPutStr` prettyPrint m)
-              return $ Just (n, getModSumOrig ms)
+              let newCont = prettyPrint m
+                  file = getModSumOrig ms
+              origCont <- liftIO $ withBinaryFile file ReadMode $ \handle -> do
+                hSetEncoding handle utf8
+                StrictIO.hGetContents handle
+              let undo = createUndo 0 $ getGroupedDiff origCont newCont
+              origCont <- liftIO $ withBinaryFile file WriteMode $ \handle -> do
+                hSetEncoding handle utf8
+                hPutStr handle newCont
+              return $ Right (n, file, UndoChanges file undo)
             ModuleRemoved mod -> do
               Just (_,m) <- gets (lookupModInSCs (SourceFileKey NormalHs mod) . (^. refSessMCs))
               let modName = GHC.moduleName $ fromJust $ fmap semanticsModule (m ^? typedRecModule) <|> fmap semanticsModule (m ^? renamedRecModule)
               ms <- getModSummary modName
+              let file = getModSumOrig ms
+              origCont <- liftIO (StrictBS.unpack <$> StrictBS.readFile file)
               lift $ removeTarget (TargetModule modName)
               modify $ (refSessMCs .- removeModule mod)
-              liftIO $ removeFile (getModSumOrig ms)
-              return Nothing
-          
-        reloadChanges changedMods 
-          = do reloadRes <- reloadChangedModules (\ms -> resp (LoadedModules [getModSumOrig ms])) 
+              liftIO $ removeFile file
+              return $ Left $ RestoreRemoved file origCont
+
+        reloadChanges changedMods
+          = do reloadRes <- reloadChangedModules (\ms -> resp (LoadedModules [(getModSumOrig ms, getModSumName ms)]))
+                                                 (\mss -> resp (LoadingModules (map getModSumOrig mss)))
                                                  (\ms -> modSumName ms `elem` changedMods)
                liftIO $ case reloadRes of Left errs -> resp (either ErrorMessage (ErrorMessage . ("The result of the refactoring contains errors: " ++) . show) (getProblems errs))
                                           Right _ -> return ()
 
+addPackages :: (ResponseMsg -> IO ()) -> [FilePath] -> StateT DaemonSessionState Ghc ()
+addPackages resp [] = return ()
+addPackages resp packagePathes = do
+  nonExisting <- filterM ((return . not) <=< liftIO . doesDirectoryExist) packagePathes
+  if (not (null nonExisting))
+    then liftIO $ resp $ ErrorMessage $ "The following packages are not found: " ++ concat (intersperse ", " nonExisting)
+    else do
+      -- clear existing removed packages
+      existingMCs <- gets (^. refSessMCs)
+      let existing = map ms_mod $ (existingMCs ^? traversal & filtered isTheAdded & mcModules & traversal & modRecMS)
+      needToReload <- handleErrors $ (filter (\ms -> not $ ms_mod ms `elem` existing))
+                                       <$> getReachableModules (\_ -> return ()) (\ms -> ms_mod ms `elem` existing)
+      modify $ refSessMCs .- filter (not . isTheAdded) -- remove the added package from the database
+      forM_ existing $ \mn -> removeTarget (TargetModule (GHC.moduleName mn))
+      modifySession (\s -> s { hsc_mod_graph = filter (not . (`elem` existing) . ms_mod) (hsc_mod_graph s) })
+      -- load new modules
+      initializePackageDBIfNeeded
+      res <- loadPackagesFrom (\ms -> resp (LoadedModules [(getModSumOrig ms, getModSumName ms)]) >> return (getModSumOrig ms))
+                              (resp . LoadingModules . map getModSumOrig) (\st fp -> maybeToList <$> detectAutogen fp (st ^. packageDB)) packagePathes
+      case res of
+        Right (modules, ignoredMods) -> do
+          mapM_ (reloadModule (\_ -> return ())) (either (const []) id needToReload) -- don't report consequent reloads (not expected)
+          liftIO $ when (not $ null ignoredMods)
+                     $ resp $ ErrorMessage
+                                $ "The following modules are ignored: "
+                                     ++ concat (intersperse ", " ignoredMods)
+                                     ++ ". Multiple modules with the same qualified name are not supported."
+        Left err -> liftIO $ resp $ either ErrorMessage CompilationProblem (getProblems err)
+  where isTheAdded mc = (mc ^. mcRoot) `elem` packagePathes
+        initializePackageDBIfNeeded = do
+          pkgDBAlreadySet <- gets (^. packageDBSet)
+          when (not pkgDBAlreadySet) $ do
+            pkgDB <- gets (^. packageDB)
+            pkgDBLocs <- liftIO $ packageDBLocs pkgDB packagePathes
+            usePackageDB pkgDBLocs
+            modify (packageDBSet .= True)
+
+
+data UndoRefactor = RemoveAdded { undoRemovePath :: FilePath }
+                  | RestoreRemoved { undoRestorePath :: FilePath
+                                   , undoRestoreContents :: String
+                                   }
+                  | UndoChanges { undoChangedPath :: FilePath
+                                , undoDiff :: FileDiff
+                                }
+  deriving (Show, Generic)
+
+instance ToJSON UndoRefactor
+
+type FileDiff = [(Int, Int, String)]
+
+createUndo :: Eq a => Int -> [Diff [a]] -> [(Int, Int, [a])]
+createUndo i (Both str _ : rest) = createUndo (i + length str) rest
+createUndo i (First rem : Second add : rest)
+  = (i, i + length add, rem) : createUndo (i + length add) rest
+createUndo i (First rem : rest) = (i, i, rem) : createUndo i rest
+createUndo i (Second add : rest)
+  = (i, i + length add, []) : createUndo (i + length add) rest
+createUndo _ [] = []
+
 initGhcSession :: IO Session
 initGhcSession = Session <$> (newIORef =<< runGhc (Just libdir) (initGhcFlags >> getSession))
 
@@ -226,9 +285,9 @@ usePackageDB [] = return ()
 usePackageDB pkgDbLocs
   = do dfs <- getSessionDynFlags
-       dfs' <- liftIO $ fmap fst $ initPackages 
+       dfs' <- liftIO $ fmap fst $ initPackages
                  $ dfs { extraPkgConfs = (map PkgConfFile pkgDbLocs ++) . extraPkgConfs dfs
-                       , pkgDatabase = Nothing 
+                       , pkgDatabase = Nothing
                        }
        void $ setSessionDynFlags dfs'
 
@@ -248,19 +307,21 @@                        }
   | Stop
   | Disconnect
-  | ReLoad { changedModules :: [FilePath]
+  | ReLoad { addedModules :: [FilePath]
+           , changedModules :: [FilePath]
            , removedModules :: [FilePath]
            }
   deriving (Show, Generic)
 
-instance FromJSON ClientMessage 
+instance FromJSON ClientMessage
 
 data ResponseMsg
   = KeepAliveResponse
   | ErrorMessage { errorMsg :: String }
   | CompilationProblem { errorMarkers :: [(SrcSpan, String)] }
-  | ModulesChanged { moduleChanges :: [FilePath] }
-  | LoadedModules { loadedModules :: [FilePath] }
+  | ModulesChanged { undoChanges :: [UndoRefactor] }
+  | LoadedModules { loadedModules :: [(FilePath, String)] }
+  | LoadingModules { modulesToLoad :: [FilePath] }
   | Disconnected
   deriving (Show, Generic)
 
@@ -268,9 +329,9 @@ 
 instance ToJSON SrcSpan where
   toJSON (RealSrcSpan sp) = object [ "file" A..= unpackFS (srcSpanFile sp)
-                                   , "startRow" A..= srcLocLine (realSrcSpanStart sp) 
-                                   , "startCol" A..= srcLocCol (realSrcSpanStart sp) 
-                                   , "endRow" A..= srcLocLine (realSrcSpanEnd sp) 
+                                   , "startRow" A..= srcLocLine (realSrcSpanStart sp)
+                                   , "startCol" A..= srcLocCol (realSrcSpanStart sp)
+                                   , "endRow" A..= srcLocLine (realSrcSpanEnd sp)
                                    , "endCol" A..= srcLocCol (realSrcSpanEnd sp)
                                    ]
   toJSON _ = Null

@@ -1,11 +1,13 @@ {-# LANGUAGE DeriveGeneric #-}
 module Language.Haskell.Tools.Refactor.Daemon.PackageDB where
 
+import Control.Applicative (Applicative(..), (<$>), Alternative(..))
+import Control.Monad
 import Data.Aeson (FromJSON(..))
 import Data.Char (isSpace)
 import Data.List
 import GHC.Generics (Generic(..))
-import System.Directory (withCurrentDirectory, doesFileExist, doesDirectoryExist)
+import System.Directory
 import System.FilePath (FilePath, (</>))
 import System.Process (readProcessWithExitCode)
 
@@ -19,7 +21,7 @@ instance FromJSON PackageDB
 
 packageDBLocs :: PackageDB -> [FilePath] -> IO [FilePath]
-packageDBLocs pack = fmap concat . mapM (packageDBLoc pack) 
+packageDBLocs pack = fmap concat . mapM (packageDBLoc pack)
 
 packageDBLoc :: PackageDB -> FilePath -> IO [FilePath]
 packageDBLoc AutoDB path = (++) <$> packageDBLoc StackDB path <*> packageDBLoc CabalSandboxDB path
@@ -40,6 +42,33 @@   if hasDir then return [path </> dir]
             else return []
 
+-- | Gets the (probable) location of autogen folder depending on which type of
+-- build we are using.
+detectAutogen :: FilePath -> PackageDB -> IO (Maybe FilePath)
+detectAutogen root AutoDB = choose [ detectAutogen root DefaultDB
+                                   , detectAutogen root CabalSandboxDB
+                                   , detectAutogen root StackDB
+                                   ]
+detectAutogen root DefaultDB = ifExists (root </> "dist" </> "build" </> "autogen")
+detectAutogen root (ExplicitDB _) = ifExists (root </> "dist" </> "build" </> "autogen")
+detectAutogen root CabalSandboxDB = ifExists (root </> "dist" </> "build" </> "autogen")
+detectAutogen root StackDB = do
+  distExists <- doesDirectoryExist (root </> ".stack-work" </> "dist")
+  existing <- if distExists then (do
+    contents <- listDirectory (root </> ".stack-work" </> "dist")
+    dirs <- filterM doesDirectoryExist contents
+    mapM (ifExists . (</> "build" </> "autogen")) dirs) else return []
+  return (choose existing)
+
+
 trim :: String -> String
 trim = f . f
-   where f = reverse . dropWhile isSpace+   where f = reverse . dropWhile isSpace
+
+choose :: Alternative f => [f a] -> f a
+choose = foldl (<|>) empty
+
+ifExists :: FilePath -> IO (Maybe FilePath)
+ifExists fp = do exists <- doesDirectoryExist fp
+                 if exists then return (Just fp)
+                           else return Nothing

@@ -0,0 +1,5 @@+module A where
+
+import B
+
+a = b

@@ -0,0 +1,3 @@+module B where
+
+b = ()

@@ -0,0 +1,19 @@+name:                some-test-package
+version:             1.2.3.4
+synopsis:            A package just for testing Haskell-tools support. Don't install it.
+description:         
+
+homepage:            https://github.com/nboldi/haskell-tools
+license:             BSD3
+license-file:        LICENSE
+author:              Boldizsar Nemeth
+maintainer:          nboldi@elte.hu
+category:            Language
+build-type:          Simple
+cabal-version:       >=1.10
+extra-src-files:     B.hs
+
+library
+  exposed-modules:     A
+  build-depends:       base
+  default-language:    Haskell2010

@@ -0,0 +1,7 @@+module UseGroups where
+
+import Data.Group
+import Data.Monoid
+
+x :: Sum Int
+x = 3 `pow` 5

@@ -0,0 +1,30 @@+Copyright (c) 2013, Nathan "Taneb" van Doorn
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Nathan "Taneb" van Doorn nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain

@@ -0,0 +1,19 @@+name:                groups
+version:             0.4.0.0
+synopsis:            Haskell 98 groups
+description:         
+  Haskell 98 groups. A group is a monoid with invertibility.
+license:             BSD3
+license-file:        LICENSE
+author:              Nathan "Taneb" van Doorn
+maintainer:          nvd1234@gmail.com
+copyright:           Copyright (C) 2013 Nathan van Doorn
+category:            Algebra, Data, Math
+build-type:          Simple
+cabal-version:       >=1.8
+
+library
+  exposed-modules:     Data.Group
+  -- other-modules:       
+  build-depends:       base <5
+  hs-source-dirs:      src

@@ -0,0 +1,92 @@+module Data.Group where
+
+import Data.Monoid
+
+-- |A 'Group' is a 'Monoid' plus a function, 'invert', such that: 
+--
+-- @a \<> invert a == mempty@
+--
+-- @invert a \<> a == mempty@
+class Monoid m => Group m where
+  invert :: m -> m
+  -- |@'pow' a n == a \<> a \<> ... \<> a @
+  --
+  -- @ (n lots of a) @
+  --
+  -- If n is negative, the result is inverted.
+  pow :: Integral x => m -> x -> m
+  pow x0 n0 = case compare n0 0 of
+    LT -> invert . f x0 $ negate n0
+    EQ -> mempty
+    GT -> f x0 n0
+    where
+      f x n 
+        | even n = f (x `mappend` x) (n `quot` 2)
+        | n == 1 = x
+        | otherwise = g (x `mappend` x) ((n - 1) `quot` 2) x
+      g x n c
+        | even n = g (x `mappend` x) (n `quot` 2) c
+        | n == 1 = x `mappend` c
+        | otherwise = g (x `mappend` x) ((n - 1) `quot` 2) (x `mappend` c)
+  
+instance Group () where
+  invert () = ()
+  pow () _ = ()
+
+instance Num a => Group (Sum a) where
+  invert = Sum . negate . getSum
+  {-# INLINE invert #-}
+  pow (Sum a) b = Sum (a * fromIntegral b)
+  
+instance Fractional a => Group (Product a) where
+  invert = Product . recip . getProduct
+  {-# INLINE invert #-}
+  pow (Product a) b = Product (a ^^ b)
+
+instance Group a => Group (Dual a) where
+  invert = Dual . invert . getDual
+  {-# INLINE invert #-}
+  pow (Dual a) n = Dual (pow a n)
+
+instance Group b => Group (a -> b) where
+  invert f = invert . f
+  pow f n e = pow (f e) n
+
+instance (Group a, Group b) => Group (a, b) where
+  invert (a, b) = (invert a, invert b)
+  pow (a, b) n = (pow a n, pow b n)
+  
+instance (Group a, Group b, Group c) => Group (a, b, c) where
+  invert (a, b, c) = (invert a, invert b, invert c)
+  pow (a, b, c) n = (pow a n, pow b n, pow c n)
+
+instance (Group a, Group b, Group c, Group d) => Group (a, b, c, d) where
+  invert (a, b, c, d) = (invert a, invert b, invert c, invert d)
+  pow (a, b, c, d) n = (pow a n, pow b n, pow c n, pow d n)
+
+instance (Group a, Group b, Group c, Group d, Group e) => Group (a, b, c, d, e) where
+  invert (a, b, c, d, e) = (invert a, invert b, invert c, invert d, invert e)
+  pow (a, b, c, d, e) n = (pow a n, pow b n, pow c n, pow d n, pow e n)
+
+-- |An 'Abelian' group is a 'Group' that follows the rule:
+-- 
+-- @a \<> b == b \<> a@
+class Group g => Abelian g
+
+instance Abelian ()
+
+instance Num a => Abelian (Sum a)
+
+instance Fractional a => Abelian (Product a)
+
+instance Abelian a => Abelian (Dual a)
+
+instance Abelian b => Abelian (a -> b)
+
+instance (Abelian a, Abelian b) => Abelian (a, b)
+
+instance (Abelian a, Abelian b, Abelian c) => Abelian (a, b, c)
+
+instance (Abelian a, Abelian b, Abelian c, Abelian d) => Abelian (a, b, c, d)
+
+instance (Abelian a, Abelian b, Abelian c, Abelian d, Abelian e) => Abelian (a, b, c, d, e)

@@ -0,0 +1,18 @@+name:                some-test-package
+version:             1.2.3.4
+synopsis:            A package just for testing Haskell-tools support. Don't install it.
+description:         
+
+homepage:            https://github.com/nboldi/haskell-tools
+license:             BSD3
+author:              Boldizsar Nemeth
+maintainer:          nboldi@elte.hu
+category:            Language
+build-type:          Simple
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     UseGroups
+  build-depends:       base
+                     , groups
+  default-language:    Haskell2010

@@ -1,7 +1,7 @@ name:                package1
 version:             1.2.3.4
 synopsis:            A package just for testing Haskell-tools support. Don't install it.
-description:         
+description:
 
 homepage:            https://github.com/nboldi/haskell-tools
 license:             BSD3
@@ -14,5 +14,5 @@ 
 library
   exposed-modules:     A
-  build-depends:       base
+  build-depends:       base, template-haskell
   default-language:    Haskell2010

@@ -1,7 +1,7 @@ name:                package2
 version:             1.2.3.4
 synopsis:            A package just for testing Haskell-tools support. Don't install it.
-description:         
+description:
 
 homepage:            https://github.com/nboldi/haskell-tools
 license:             BSD3
@@ -14,5 +14,5 @@ 
 library
   exposed-modules:     B
-  build-depends:       base, package1
+  build-depends:       base, package1, template-haskell
   default-language:    Haskell2010

@@ -1,5 +1,5 @@ name:                haskell-tools-daemon
-version:             0.5.0.0
+version:             0.6.0.0
 synopsis:            Background process for Haskell-tools refactor that editors can connect to.
 description:         Background process for Haskell-tools refactor that editors can connect to.
 homepage:            https://github.com/haskell-tools/haskell-tools
@@ -50,13 +50,22 @@                   , examples/Project/load-error/*.hs
                   , examples/Project/source-error/*.hs
                   , examples/Project/empty/*.hs
+                  , examples/Project/additional-files/*.hs
+                  , examples/Project/additional-files/*.cabal
+                  , examples/Project/cabal-sandbox/*.hs
+                  , examples/Project/cabal-sandbox/*.cabal
+                  , examples/Project/cabal-sandbox/groups-0.4.0.0/LICENSE
+                  , examples/Project/cabal-sandbox/groups-0.4.0.0/Setup.hs
+                  , examples/Project/cabal-sandbox/groups-0.4.0.0/groups.cabal
+                  , examples/Project/cabal-sandbox/groups-0.4.0.0/src/Data/Group.hs
 
+
 library
-  ghc-options:         -O2
   build-depends:       base                      >= 4.9   && < 5.0
                      , aeson                     >= 1.0  && < 1.2
                      , bytestring                >= 0.10  && < 1.0
                      , filepath                  >= 1.4   && < 2.0
+                     , strict                    >= 0.3 && < 0.4
                      , containers                >= 0.5   && < 0.6
                      , mtl                       >= 2.2   && < 2.3
                      , split                     >= 0.2   && < 1.0
@@ -66,9 +75,10 @@                      , ghc-paths                 >= 0.1   && < 0.2
                      , references                >= 0.3.2 && < 1.0
                      , network                   >= 2.6   && < 3.0
-                     , haskell-tools-ast         >= 0.5   && < 0.6
-                     , haskell-tools-prettyprint >= 0.5   && < 0.6
-                     , haskell-tools-refactor    >= 0.5   && < 0.6
+                     , Diff                      >= 0.3   && < 0.4
+                     , haskell-tools-ast         >= 0.6   && < 0.7
+                     , haskell-tools-prettyprint >= 0.6   && < 0.7
+                     , haskell-tools-refactor    >= 0.6   && < 0.7
   exposed-modules:     Language.Haskell.Tools.Refactor.Daemon
                      , Language.Haskell.Tools.Refactor.Daemon.State
                      , Language.Haskell.Tools.Refactor.Daemon.PackageDB
@@ -76,20 +86,19 @@ 
 
 executable ht-daemon
-  ghc-options:         -O2
   build-depends:       base                      >= 4.9 && < 5.0
-                     , haskell-tools-daemon      >= 0.5 && < 0.6
+                     , haskell-tools-daemon      >= 0.6 && < 0.7
   hs-source-dirs:      exe
   main-is:             Main.hs
   default-language:    Haskell2010
 
 test-suite haskell-tools-daemon-tests
   type:                exitcode-stdio-1.0
-  ghc-options:         -with-rtsopts=-M2.5g -O2
+  ghc-options:         -with-rtsopts=-M2.5g
   hs-source-dirs:      test
-  main-is:             Main.hs  
+  main-is:             Main.hs
   build-depends:       base                      >= 4.9  && < 4.10
-                     , HUnit                     >= 1.5  && < 1.6
+                     , HUnit                     >= 1.5  && < 1.7
                      , ghc                       >= 8.0   && < 8.1
                      , tasty                     >= 0.11 && < 0.12
                      , tasty-hunit               >= 0.9  && < 0.10
@@ -99,5 +108,5 @@                      , bytestring                >= 0.10 && < 0.11
                      , network                   >= 2.6  && < 2.7
                      , aeson                     >= 1.0 && < 1.2
-                     , haskell-tools-daemon      >= 0.5  && < 0.6
-  default-language:    Haskell2010+                     , haskell-tools-daemon      >= 0.6  && < 0.7
+  default-language:    Haskell2010

@@ -17,6 +17,7 @@ import Network.Socket.ByteString.Lazy as Sock
 import qualified Data.ByteString.Lazy.Char8 as BS
 import qualified Data.List as List
+import Data.List (sort)
 import Data.Aeson
 import Data.Maybe
 import System.IO
@@ -32,24 +33,24 @@ 
 main :: IO ()
 main = do unsetEnv "GHC_PACKAGE_PATH"
-          portCounter <- newMVar pORT_NUM_START 
+          portCounter <- newMVar pORT_NUM_START
           tr <- canonicalizePath testRoot
           isStackRun <- isJust <$> lookupEnv "STACK_EXE"
           defaultMain (allTests isStackRun tr portCounter)
 
 allTests :: Bool -> FilePath -> MVar Int -> TestTree
 allTests isSource testRoot portCounter
-  = localOption (mkTimeout ({- 10s -} 1000 * 1000 * 10)) 
-      $ testGroup "daemon-tests" 
-          [ testGroup "simple-tests" 
-              $ map (makeDaemonTest portCounter . (\(label, input, output) -> (Nothing, label, input, output))) simpleTests
-          , testGroup "loading-tests" 
-              $ map (makeDaemonTest portCounter . (\(label, input, output) -> (Nothing, label, input, output))) loadingTests
-          , testGroup "refactor-tests" 
-              $ map (makeDaemonTest portCounter . (\(label, dir, input, output) -> (Just (testRoot </> dir), label, input, output))) (refactorTests testRoot)
-          , testGroup "reload-tests" 
+  = localOption (mkTimeout ({- 10s -} 1000 * 1000 * 10))
+      $ testGroup "daemon-tests"
+          [ testGroup "simple-tests"
+              $ map (makeDaemonTest portCounter) simpleTests
+          , testGroup "loading-tests"
+              $ map (makeDaemonTest portCounter) loadingTests
+          , testGroup "refactor-tests"
+              $ map (makeRefactorTest portCounter) (refactorTests testRoot)
+          , testGroup "reload-tests"
               $ map (makeReloadTest portCounter) reloadingTests
-          , testGroup "compilation-problem-tests" 
+          , testGroup "compilation-problem-tests"
               $ map (makeCompProblemTest portCounter) compProblemTests
           -- if not a stack build, we cannot guarantee that stack is on the path
           , if isSource
@@ -62,7 +63,7 @@ testSuffix = "_test"
 
 simpleTests :: [(String, [ClientMessage], [ResponseMsg])]
-simpleTests = 
+simpleTests =
   [ ( "empty-test", [], [] )
   , ( "keep-alive", [KeepAlive], [KeepAliveResponse] )
   ]
@@ -71,199 +72,205 @@ loadingTests =
   [ ( "load-package"
     , [AddPackages [testRoot </> "has-cabal"]]
-    , [LoadedModules [testRoot </> "has-cabal" </> "A.hs"]] )
+    , [ LoadingModules [testRoot </> "has-cabal" </> "A.hs"]
+      , LoadedModules [(testRoot </> "has-cabal" </> "A.hs", "A")]] )
   , ( "no-cabal"
     , [AddPackages [testRoot </> "no-cabal"]]
-    , [LoadedModules [testRoot </> "no-cabal" </> "A.hs"]] )
+    , [ LoadingModules [testRoot </> "no-cabal" </> "A.hs"]
+      , LoadedModules [(testRoot </> "no-cabal" </> "A.hs", "A")]] )
   , ( "source-dir"
     , [AddPackages [testRoot </> "source-dir"]]
-    , [LoadedModules [testRoot </> "source-dir" </> "src" </> "A.hs"]] )
+    , [ LoadingModules [testRoot </> "source-dir" </> "src" </> "A.hs"]
+      , LoadedModules [(testRoot </> "source-dir" </> "src" </> "A.hs", "A")]] )
   , ( "source-dir-outside"
     , [AddPackages [testRoot </> "source-dir-outside"]]
-    , [LoadedModules [testRoot </> "source-dir-outside" </> ".." </> "src" </> "A.hs"]] )
+    , [ LoadingModules [testRoot </> "source-dir-outside" </> ".." </> "src" </> "A.hs"]
+      , LoadedModules [(testRoot </> "source-dir-outside" </> ".." </> "src" </> "A.hs", "A")]] )
   , ( "multi-packages"
     , [ AddPackages [ testRoot </> "multi-packages" </> "package1"
                     , testRoot </> "multi-packages" </> "package2" ]]
-    , [ LoadedModules [ testRoot </> "multi-packages" </> "package2" </> "B.hs"
-                      , testRoot </> "multi-packages" </> "package1" </> "A.hs"]] )
+    , [ LoadingModules [ testRoot </> "multi-packages" </> "package1" </> "A.hs"
+                       , testRoot </> "multi-packages" </> "package2" </> "B.hs" ]
+      , LoadedModules [ (testRoot </> "multi-packages" </> "package2" </> "B.hs", "B") ]
+      , LoadedModules [ (testRoot </> "multi-packages" </> "package1" </> "A.hs", "A") ] ] )
   , ( "multi-packages-flags"
     , [ AddPackages [ testRoot </> "multi-packages-flags" </> "package1"
                     , testRoot </> "multi-packages-flags" </> "package2" ]]
-    , [ LoadedModules [ testRoot </> "multi-packages-flags" </> "package2" </> "B.hs"
-                      , testRoot </> "multi-packages-flags" </> "package1" </> "A.hs"]] )
+    , [ LoadingModules [ testRoot </> "multi-packages-flags" </> "package1" </> "A.hs"
+                       , testRoot </> "multi-packages-flags" </> "package2" </> "B.hs" ]
+      , LoadedModules [ (testRoot </> "multi-packages-flags" </> "package2" </> "B.hs", "B") ]
+      , LoadedModules [ (testRoot </> "multi-packages-flags" </> "package1" </> "A.hs", "A") ] ] )
   , ( "multi-packages-dependent"
     , [ AddPackages [ testRoot </> "multi-packages-dependent" </> "package1"
                     , testRoot </> "multi-packages-dependent" </> "package2" ]]
-    , [ LoadedModules [ testRoot </> "multi-packages-dependent" </> "package1" </> "A.hs"
-                      , testRoot </> "multi-packages-dependent" </> "package2" </> "B.hs"]] )
+    , [ LoadingModules [ testRoot </> "multi-packages-dependent" </> "package1" </> "A.hs"
+                       , testRoot </> "multi-packages-dependent" </> "package2" </> "B.hs" ]
+      , LoadedModules [ (testRoot </> "multi-packages-dependent" </> "package1" </> "A.hs", "A") ]
+      , LoadedModules [ (testRoot </> "multi-packages-dependent" </> "package2" </> "B.hs", "B") ] ] )
   , ( "has-th"
     , [AddPackages [testRoot </> "has-th"]]
-    , [LoadedModules [testRoot </> "has-th" </> "TH.hs", testRoot </> "has-th" </> "A.hs"]] )
+    , [ LoadingModules [ testRoot </> "has-th" </> "A.hs",  testRoot </> "has-th" </> "TH.hs" ]
+      , LoadedModules [ (testRoot </> "has-th" </> "TH.hs", "TH") ]
+      , LoadedModules [ (testRoot </> "has-th" </> "A.hs", "A") ] ] )
   , ( "th-added-later"
     , [ AddPackages [testRoot </> "th-added-later" </> "package1"]
       , AddPackages [testRoot </> "th-added-later" </> "package2"]
       ]
-    , [ LoadedModules [testRoot </> "th-added-later" </> "package1" </> "A.hs"] 
-      , LoadedModules [testRoot </> "th-added-later" </> "package2" </> "B.hs"]] )
+    , [ LoadingModules [ testRoot </> "th-added-later" </> "package1" </> "A.hs" ]
+      , LoadedModules [(testRoot </> "th-added-later" </> "package1" </> "A.hs", "A")]
+      , LoadingModules [ testRoot </> "th-added-later" </> "package1" </> "A.hs"
+                       , testRoot </> "th-added-later" </> "package2" </> "B.hs" ]
+      , LoadedModules [(testRoot </> "th-added-later" </> "package1" </> "A.hs", "A")]
+      , LoadedModules [(testRoot </> "th-added-later" </> "package2" </> "B.hs", "B")] ] )
   ]
 
 compProblemTests :: [(String, [Either (IO ()) ClientMessage], [ResponseMsg] -> Bool)]
-compProblemTests = 
+compProblemTests =
   [ ( "load-error"
-    , [ Right $ AddPackages [testRoot </> "load-error"] ] 
-    , \case [CompilationProblem {}] -> True; _ -> False)
+    , [ Right $ AddPackages [testRoot </> "load-error"] ]
+    , \case [LoadingModules{}, CompilationProblem {}] -> True; _ -> False)
   , ( "source-error"
-    , [ Right $ AddPackages [testRoot </> "source-error"] ] 
-    , \case [CompilationProblem {}] -> True; _ -> False)
+    , [ Right $ AddPackages [testRoot </> "source-error"] ]
+    , \case [LoadingModules{}, CompilationProblem {}] -> True; _ -> False)
   , ( "reload-error"
-    , [ Right $ AddPackages [testRoot </> "empty"] 
+    , [ Right $ AddPackages [testRoot </> "empty"]
       , Left $ appendFile (testRoot </> "empty" </> "A.hs") "\n\nimport No.Such.Module"
-      , Right $ ReLoad [testRoot </> "empty" </> "A.hs"] [] 
+      , Right $ ReLoad [] [testRoot </> "empty" </> "A.hs"] []
       , Left $ writeFile (testRoot </> "empty" </> "A.hs") "module A where"]
-    , \case [LoadedModules {}, CompilationProblem {}] -> True; _ -> False)
+    , \case [LoadingModules {}, LoadedModules {}, LoadingModules {}, CompilationProblem {}] -> True; _ -> False)
   , ( "reload-source-error"
-    , [ Right $ AddPackages [testRoot </> "empty"] 
+    , [ Right $ AddPackages [testRoot </> "empty"]
       , Left $ appendFile (testRoot </> "empty" </> "A.hs") "\n\naa = 3 + ()"
-      , Right $ ReLoad [testRoot </> "empty" </> "A.hs"] [] 
+      , Right $ ReLoad [] [testRoot </> "empty" </> "A.hs"] []
       , Left $ writeFile (testRoot </> "empty" </> "A.hs") "module A where"]
-    , \case [LoadedModules {}, CompilationProblem {}] -> True; _ -> False)
+    , \case [LoadingModules {}, LoadedModules {}, LoadingModules {}, CompilationProblem {}] -> True; _ -> False)
+  , ( "no-such-file"
+    , [ Right $ PerformRefactoring "RenameDefinition" (testRoot </> "simple-refactor" ++ testSuffix </> "A.hs") "3:1-3:2" ["y"] ]
+    , \case [ ErrorMessage _ ] -> True; _ -> False )
+  , ( "additional-files"
+    , [ Right $ AddPackages [testRoot </> "additional-files"] ]
+    , \case [ LoadingModules {}, ErrorMessage _ ] -> True; _ -> False )
   ]
 
 sourceRoot = ".." </> ".." </> "src"
 
 selfLoadingTest :: MVar Int -> TestTree
-selfLoadingTest port = localOption (mkTimeout ({- 5 min -} 1000 * 1000 * 60 * 5)) $ testCase "self-load" $ do  
+selfLoadingTest port = localOption (mkTimeout ({- 5 min -} 1000 * 1000 * 60 * 5)) $ testCase "self-load" $ do
     actual <- communicateWithDaemon port
                 [ Right $ AddPackages (map (sourceRoot </>) ["ast", "backend-ghc", "prettyprint", "rewrite", "refactor", "daemon"]) ]
-    assertBool ("The expected result is a nonempty response message list that does not contain errors. Actual result: " ++ show actual) 
+    assertBool ("The expected result is a nonempty response message list that does not contain errors. Actual result: " ++ show actual)
                (not (null actual) && all (\case ErrorMessage {} -> False; _ -> True) actual)
 
 
-refactorTests :: FilePath -> [(String, FilePath, [ClientMessage], [ResponseMsg])]
+refactorTests :: FilePath -> [(String, FilePath, [ClientMessage], [ResponseMsg] -> Bool)]
 refactorTests testRoot =
-  [ ( "simple-refactor", "simple-refactor"
+  [ ( "simple-refactor", testRoot </> "simple-refactor"
     , [ AddPackages [ testRoot </> "simple-refactor" ++ testSuffix ]
       , PerformRefactoring "RenameDefinition" (testRoot </> "simple-refactor" ++ testSuffix </> "A.hs") "3:1-3:2" ["y"]
       ]
-    , [ LoadedModules [ testRoot </> "simple-refactor" ++ testSuffix </> "A.hs" ]
-      , ModulesChanged [ testRoot </> "simple-refactor" ++ testSuffix </> "A.hs" ] 
-      , LoadedModules [ testRoot </> "simple-refactor" ++ testSuffix </> "A.hs" ]
-      ] )
-  , ( "hs-boots", "hs-boots"
+    , \case [ LoadingModules{}, LoadedModules [ (aPath, _) ], ModulesChanged _, LoadingModules{}, LoadedModules [ (aPath', _) ]]
+              -> aPath == testRoot </> "simple-refactor" ++ testSuffix </> "A.hs" && aPath == aPath'; _ -> False )
+  , ( "hs-boots", testRoot </> "hs-boots"
     , [ AddPackages [ testRoot </> "hs-boots" ++ testSuffix ]
       , PerformRefactoring "RenameDefinition" (testRoot </> "hs-boots" ++ testSuffix </> "A.hs") "5:1-5:2" ["aa"]
       ]
-    , [ LoadedModules [ testRoot </> "hs-boots" ++ testSuffix </> "B.hs-boot", testRoot </> "hs-boots" ++ testSuffix </> "A.hs-boot"
-                      , testRoot </> "hs-boots" ++ testSuffix </> "A.hs", testRoot </> "hs-boots" ++ testSuffix </> "B.hs" ]
-      , ModulesChanged [ testRoot </> "hs-boots" ++ testSuffix </> "A.hs", testRoot </> "hs-boots" ++ testSuffix </> "B.hs"
-                       , testRoot </> "hs-boots" ++ testSuffix </> "A.hs-boot" ] 
-      , LoadedModules [ testRoot </> "hs-boots" ++ testSuffix </> "A.hs-boot" ]
-      , LoadedModules [ testRoot </> "hs-boots" ++ testSuffix </> "B.hs-boot" ]
-      , LoadedModules [ testRoot </> "hs-boots" ++ testSuffix </> "A.hs" ]
-      , LoadedModules [ testRoot </> "hs-boots" ++ testSuffix </> "B.hs" ]
-      ] )
-  , ( "remove-module", "simple-refactor"
+    , \case [ LoadingModules{}, LoadedModules _, LoadedModules _, LoadedModules _, LoadedModules _, ModulesChanged _
+              , LoadingModules{}, LoadedModules [ (path1, _) ], LoadedModules [ (path2, _) ]
+              , LoadedModules [ (path3, _) ], LoadedModules [ (path4, _) ]
+              ] -> let allPathes = map ((testRoot </> "hs-boots" ++ testSuffix) </>) ["A.hs","B.hs","A.hs-boot","B.hs-boot"]
+                    in sort [path1,path2,path3,path4] == sort allPathes
+            _ -> False )
+  , ( "remove-module", testRoot </> "simple-refactor"
     , [ AddPackages [ testRoot </> "simple-refactor" ++ testSuffix ]
       , PerformRefactoring "RenameDefinition" (testRoot </> "simple-refactor" ++ testSuffix </> "A.hs") "1:8-1:9" ["AA"]
       ]
-    , [ LoadedModules [ testRoot </> "simple-refactor" ++ testSuffix </> "A.hs" ]
-      , ModulesChanged [ testRoot </> "simple-refactor" ++ testSuffix </> "AA.hs" ] 
-      , LoadedModules [ testRoot </> "simple-refactor" ++ testSuffix </> "AA.hs" ]
-      ] )
+    , \case [ LoadingModules{},LoadedModules [ (aPath, _) ], ModulesChanged _, LoadingModules{},LoadedModules [ (aaPath, _) ]]
+              -> aPath == testRoot </> "simple-refactor" ++ testSuffix </> "A.hs"
+                   && aaPath == testRoot </> "simple-refactor" ++ testSuffix </> "AA.hs"
+            _ -> False )
   ]
 
-reloadingTests :: [(String, FilePath, [ClientMessage], IO (), [ClientMessage], [ResponseMsg])]
+reloadingTests :: [(String, FilePath, [ClientMessage], IO (), [ClientMessage], [ResponseMsg] -> Bool)]
 reloadingTests =
   [ ( "reloading-module", testRoot </> "reloading", [ AddPackages [ testRoot </> "reloading" ++ testSuffix ]]
-    , writeFile (testRoot </> "reloading" ++ testSuffix </> "C.hs") "module C where\nc = ()" 
-    , [ ReLoad [testRoot </> "reloading" ++ testSuffix </> "C.hs"] []
-      , PerformRefactoring "RenameDefinition" (testRoot </> "reloading" ++ testSuffix </> "C.hs") "2:1-2:2" ["d"] 
-      ]
-    , [ LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "C.hs"
-                      , testRoot </> "reloading" ++ testSuffix </> "B.hs"
-                      , testRoot </> "reloading" ++ testSuffix </> "A.hs" ]
-      , LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "C.hs" ]
-      , LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "B.hs" ]
-      , LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "A.hs" ]
-      , ModulesChanged [ testRoot </> "reloading" ++ testSuffix </> "C.hs"
-                       , testRoot </> "reloading" ++ testSuffix </> "B.hs" ]
-      , LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "C.hs" ]
-      , LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "B.hs" ]
-      , LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "A.hs" ]
+    , writeFile (testRoot </> "reloading" ++ testSuffix </> "C.hs") "module C where\nc = ()"
+    , [ ReLoad [] [testRoot </> "reloading" ++ testSuffix </> "C.hs"] []
+      , PerformRefactoring "RenameDefinition" (testRoot </> "reloading" ++ testSuffix </> "C.hs") "2:1-2:2" ["d"]
       ]
-    )
+    , \case [ LoadingModules{}, LoadedModules [(pathC'',_)], LoadedModules [(pathB'',_)], LoadedModules [(pathA'',_)]
+              , LoadingModules{}, LoadedModules [(pathC,_)], LoadedModules [(pathB,_)], LoadedModules [(pathA,_)]
+              , ModulesChanged _, LoadingModules{},LoadedModules [(pathC',_)], LoadedModules [(pathB',_)], LoadedModules [(pathA',_)]
+              ] -> let allPathes = map ((testRoot </> "reloading" ++ testSuffix) </>) ["C.hs","B.hs","A.hs"]
+                    in [pathC,pathB,pathA] == allPathes
+                         && [pathC',pathB',pathA'] == allPathes
+                         && [pathC'',pathB'',pathA''] == allPathes
+            _ -> False )
   , ( "reloading-package", testRoot </> "changing-cabal"
     , [ AddPackages [ testRoot </> "changing-cabal" ++ testSuffix ]]
-    , appendFile (testRoot </> "changing-cabal" ++ testSuffix </> "some-test-package.cabal") ", B" 
+    , appendFile (testRoot </> "changing-cabal" ++ testSuffix </> "some-test-package.cabal") ", B"
     , [ AddPackages [testRoot </> "changing-cabal" ++ testSuffix]
-      , PerformRefactoring "RenameDefinition" (testRoot </> "changing-cabal" ++ testSuffix </> "A.hs") "3:1-3:2" ["z"] 
-      ]
-    , [ LoadedModules [ testRoot </> "changing-cabal" ++ testSuffix </> "A.hs" ]
-      , LoadedModules [ testRoot </> "changing-cabal" ++ testSuffix </> "A.hs"
-                      , testRoot </> "changing-cabal" ++ testSuffix </> "B.hs" ]
-      , ModulesChanged [ testRoot </> "changing-cabal" ++ testSuffix </> "A.hs"
-                       , testRoot </> "changing-cabal" ++ testSuffix </> "B.hs" ]
-      , LoadedModules [ testRoot </> "changing-cabal" ++ testSuffix </> "A.hs" ]
-      , LoadedModules [ testRoot </> "changing-cabal" ++ testSuffix </> "B.hs" ]
+      , PerformRefactoring "RenameDefinition" (testRoot </> "changing-cabal" ++ testSuffix </> "A.hs") "3:1-3:2" ["z"]
       ]
-    )
+    , \case [ LoadingModules{}, LoadedModules [(pathA,_)], LoadingModules{}, LoadedModules [(pathA',_)]
+              , LoadedModules [(pathB',_)], ModulesChanged _
+              , LoadingModules{}, LoadedModules [(pathA'',_)], LoadedModules [(pathB'',_)]
+              ] -> let [pA,pB] = map ((testRoot </> "changing-cabal" ++ testSuffix) </>) ["A.hs","B.hs"]
+                    in pA == pathA && pA == pathA' && pA == pathA'' && pB == pathB' && pB == pathB''
+            _ -> False )
+  , ( "adding-module", testRoot </> "reloading", [AddPackages [ testRoot </> "reloading" ++ testSuffix ]]
+    , writeFile (testRoot </> "reloading" ++ testSuffix </> "D.hs") "module D where\nd = ()"
+    , [ ReLoad [testRoot </> "reloading" ++ testSuffix </> "D.hs"] [] [] ]
+    , \case [ LoadingModules {}, LoadedModules {}, LoadedModules {}, LoadedModules {}, LoadingModules {}
+              , LoadingModules {}, LoadedModules {}, LoadedModules {}, LoadedModules {}, LoadedModules {}] -> True
+            _ -> False )
   , ( "reloading-remove", testRoot </> "reloading", [ AddPackages [ testRoot </> "reloading" ++ testSuffix ]]
     , do removeFile (testRoot </> "reloading" ++ testSuffix </> "A.hs")
          removeFile (testRoot </> "reloading" ++ testSuffix </> "B.hs")
-    , [ ReLoad [testRoot </> "reloading" ++ testSuffix </> "C.hs"] 
-               [testRoot </> "reloading" ++ testSuffix </> "A.hs", testRoot </> "reloading" ++ testSuffix </> "B.hs"]
-      , PerformRefactoring "RenameDefinition" (testRoot </> "reloading" ++ testSuffix </> "C.hs") "3:1-3:2" ["d"] 
-      ]
-    , [ LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "C.hs"
-                      , testRoot </> "reloading" ++ testSuffix </> "B.hs"
-                      , testRoot </> "reloading" ++ testSuffix </> "A.hs" ]
-      , LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "C.hs" ]
-      , ModulesChanged [ testRoot </> "reloading" ++ testSuffix </> "C.hs" ]
-      , LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "C.hs" ]
+    , [ ReLoad [] [testRoot </> "reloading" ++ testSuffix </> "C.hs"]
+                  [testRoot </> "reloading" ++ testSuffix </> "A.hs", testRoot </> "reloading" ++ testSuffix </> "B.hs"]
+      , PerformRefactoring "RenameDefinition" (testRoot </> "reloading" ++ testSuffix </> "C.hs") "3:1-3:2" ["d"]
       ]
-    )
+    , \case [ LoadingModules{}, LoadedModules [(pathC,_)], LoadedModules [(pathB,_)], LoadedModules [(pathA,_)]
+              , LoadingModules{}, LoadedModules [(pathC',_)], ModulesChanged _, LoadingModules{}, LoadedModules [(pathC'',_)] ]
+              -> let [pC,pB,pA] = map ((testRoot </> "reloading" ++ testSuffix) </>) ["C.hs","B.hs","A.hs"]
+                  in pA == pathA && pB == pathB && pC == pathC && pC == pathC' && pC == pathC''
+            _ -> False )
   , ( "remove-package", testRoot </> "multi-packages-dependent"
     , [ AddPackages [ testRoot </> "multi-packages-dependent" ++ testSuffix </> "package1"
                     , testRoot </> "multi-packages-dependent" ++ testSuffix </> "package2" ]]
     , removeDirectoryRecursive (testRoot </> "multi-packages-dependent" ++ testSuffix </> "package2")
-    , [ RemovePackages [testRoot </> "multi-packages-dependent" ++ testSuffix </> "package2"] 
-      , PerformRefactoring "RenameDefinition" (testRoot </> "multi-packages-dependent" ++ testSuffix </> "package1" </> "A.hs") 
-                                              "3:1-3:2" ["d"] 
-      ]
-    , [ LoadedModules [ testRoot </> "multi-packages-dependent" ++ testSuffix </> "package1" </> "A.hs"
-                      , testRoot </> "multi-packages-dependent" ++ testSuffix </> "package2" </> "B.hs" ]
-      , ModulesChanged [ testRoot </> "multi-packages-dependent" ++ testSuffix </> "package1" </> "A.hs" ]
-      , LoadedModules [ testRoot </> "multi-packages-dependent" ++ testSuffix </> "package1" </> "A.hs" ]
+    , [ RemovePackages [testRoot </> "multi-packages-dependent" ++ testSuffix </> "package2"]
+      , PerformRefactoring "RenameDefinition" (testRoot </> "multi-packages-dependent" ++ testSuffix </> "package1" </> "A.hs")
+                                              "3:1-3:2" ["d"]
       ]
-    )
+    , \case [ LoadingModules{}, LoadedModules [(pathA',_)], LoadedModules [(pathB',_)], ModulesChanged _, LoadingModules{}, LoadedModules [(pathA,_)] ]
+              -> let [pA,pB] = map ((testRoot </> "multi-packages-dependent" ++ testSuffix) </>) [ "package1" </> "A.hs", "package2" </> "B.hs"]
+                  in pA == pathA && pA == pathA' && pB == pathB'
+            _ -> False )
   ]
 
 pkgDbTests :: [(String, IO (), [ClientMessage], [ResponseMsg])]
-pkgDbTests 
-  = [ {- ( "stack"
-       , withCurrentDirectory (testRoot </> "stack") initStack
-       , [SetPackageDB StackDB, AddPackages [testRoot </> "stack"]]
-       , [LoadedModules [testRoot </> "stack" </> "UseGroups.hs"]] )
-    , -} ( "cabal-sandbox"
+pkgDbTests
+  = [ ( "cabal-sandbox"
       , withCurrentDirectory (testRoot </> "cabal-sandbox") initCabalSandbox
       , [SetPackageDB CabalSandboxDB, AddPackages [testRoot </> "cabal-sandbox"]]
-      , [LoadedModules [testRoot </> "cabal-sandbox" </> "UseGroups.hs"]] )
+      , [ LoadingModules [testRoot </> "cabal-sandbox" </> "UseGroups.hs"]
+        , LoadedModules [(testRoot </> "cabal-sandbox" </> "UseGroups.hs", "UseGroups")]] )
     , ( "cabal-sandbox-auto"
       , withCurrentDirectory (testRoot </> "cabal-sandbox") initCabalSandbox
       , [SetPackageDB AutoDB, AddPackages [testRoot </> "cabal-sandbox"]]
-      , [LoadedModules [testRoot </> "cabal-sandbox" </> "UseGroups.hs"]] )
-    -- , ( "stack-auto"
-    --   , withCurrentDirectory (testRoot </> "stack") initStack
-    --   , [SetPackageDB AutoDB, AddPackages [testRoot </> "stack"]]
-    --   , [LoadedModules [testRoot </> "stack" </> "UseGroups.hs"]] )
+      , [ LoadingModules [testRoot </> "cabal-sandbox" </> "UseGroups.hs"]
+        , LoadedModules [(testRoot </> "cabal-sandbox" </> "UseGroups.hs", "UseGroups")]] )
     , ( "pkg-db-reload"
       , withCurrentDirectory (testRoot </> "cabal-sandbox") initCabalSandbox
       , [ SetPackageDB AutoDB
         , AddPackages [testRoot </> "cabal-sandbox"]
-        , ReLoad [testRoot </> "cabal-sandbox" </> "UseGroups.hs"] []]
-      , [ LoadedModules [testRoot </> "cabal-sandbox" </> "UseGroups.hs"]
-        , LoadedModules [testRoot </> "cabal-sandbox" </> "UseGroups.hs"] ])
-    ] 
+        , ReLoad [] [testRoot </> "cabal-sandbox" </> "UseGroups.hs"] []]
+      , [ LoadingModules [testRoot </> "cabal-sandbox" </> "UseGroups.hs"]
+        , LoadedModules [(testRoot </> "cabal-sandbox" </> "UseGroups.hs", "UseGroups")]
+        , LoadingModules [testRoot </> "cabal-sandbox" </> "UseGroups.hs"]
+        , LoadedModules [(testRoot </> "cabal-sandbox" </> "UseGroups.hs", "UseGroups")] ])
+    ]
   where initCabalSandbox = do
           sandboxExists <- doesDirectoryExist ".cabal-sandbox"
           when sandboxExists $ tryToExecute "cabal" ["sandbox", "delete"]
@@ -277,48 +284,50 @@ 
 
 execute :: String -> [String] -> IO ()
-execute cmd args 
+execute cmd args
   = do let command = (cmd ++ concat (map (" " ++) args))
        (_, Just stdOut, Just stdErr, handle) <- createProcess ((shell command) { std_out = CreatePipe, std_err = CreatePipe })
        exitCode <- waitForProcess handle
-       when (exitCode /= ExitSuccess) $ do 
+       when (exitCode /= ExitSuccess) $ do
          output <- hGetContents stdOut
          errors <- hGetContents stdErr
          error ("Command exited with nonzero: " ++ command ++ " output:\n" ++ output ++ "\nerrors:\n" ++ errors)
 
 tryToExecute :: String -> [String] -> IO ()
-tryToExecute cmd args 
+tryToExecute cmd args
   = do let command = (cmd ++ concat (map (" " ++) args))
        (_, _, _, handle) <- createProcess ((shell command) { std_out = NoStream, std_err = NoStream })
        void $ waitForProcess handle
 
-makeDaemonTest :: MVar Int -> (Maybe FilePath, String, [ClientMessage], [ResponseMsg]) -> TestTree
-makeDaemonTest port (Nothing, label, input, expected) = testCase label $ do  
+makeDaemonTest :: MVar Int -> (String, [ClientMessage], [ResponseMsg]) -> TestTree
+makeDaemonTest port (label, input, expected) = testCase label $ do
     actual <- communicateWithDaemon port (map Right (SetPackageDB DefaultDB : input))
     assertEqual "" expected actual
-makeDaemonTest port (Just dir, label, input, expected) = testCase label $ do 
+
+makeRefactorTest :: MVar Int -> (String, FilePath, [ClientMessage], [ResponseMsg] -> Bool) -> TestTree
+makeRefactorTest port (label, dir, input, validator) = testCase label $ do
     exists <- doesDirectoryExist (dir ++ testSuffix)
     -- clear the target directory from possible earlier test runs
     when exists $ removeDirectoryRecursive (dir ++ testSuffix)
     copyDir dir (dir ++ testSuffix)
     actual <- communicateWithDaemon port (map Right (SetPackageDB DefaultDB : input))
-    assertEqual "" expected actual
+    assertBool ("The responses are not the expected: " ++ show actual) (validator actual)
   `finally` removeDirectoryRecursive (dir ++ testSuffix)
 
-makeReloadTest :: MVar Int -> (String, FilePath, [ClientMessage], IO (), [ClientMessage], [ResponseMsg]) -> TestTree
-makeReloadTest port (label, dir, input1, io, input2, expected) = testCase label $ do  
+makeReloadTest :: MVar Int -> (String, FilePath, [ClientMessage], IO (), [ClientMessage], [ResponseMsg] -> Bool) -> TestTree
+makeReloadTest port (label, dir, input1, io, input2, validator) = testCase label $ do
     exists <- doesDirectoryExist (dir ++ testSuffix)
     -- clear the target directory from possible earlier test runs
     when exists $ removeDirectoryRecursive (dir ++ testSuffix)
     copyDir dir (dir ++ testSuffix)
     actual <- communicateWithDaemon port (map Right (SetPackageDB DefaultDB : input1) ++ [Left io] ++ map Right input2)
-    assertEqual "" expected actual
+    assertBool ("The responses are not the expected: " ++ show actual) (validator actual)
   `finally` removeDirectoryRecursive (dir ++ testSuffix)
 
 makePkgDbTest :: MVar Int -> (String, IO (), [ClientMessage], [ResponseMsg]) -> TestTree
-makePkgDbTest port (label, prepare, inputs, expected) 
-  = localOption (mkTimeout ({- 30s -} 1000 * 1000 * 30)) 
-      $ testCase label $ do  
+makePkgDbTest port (label, prepare, inputs, expected)
+  = localOption (mkTimeout ({- 30s -} 1000 * 1000 * 30))
+      $ testCase label $ do
           actual <- communicateWithDaemon port ([Left prepare] ++ map Right inputs)
           assertEqual "" expected actual
 
@@ -344,14 +353,14 @@     sendAll sock $ encode Stop
     close sock
     return (concat intermedRes ++ resps)
-  where waitToConnect sock addr 
+  where waitToConnect sock addr
           = connect sock addr `catch` \(e :: SomeException) -> waitToConnect sock addr
-        retryConnect port = do portNum <- readMVar port 
+        retryConnect port = do portNum <- readMVar port
                                forkIO $ runDaemon [show portNum, "True"]
                                return portNum
           `catch` \(e :: SomeException) -> do putStrLn ("exception caught: `" ++ show e ++ "` trying with a new port")
-                                              modifyMVar_ port (\i -> if i < pORT_NUM_END 
-                                                                        then return (i+1) 
+                                              modifyMVar_ port (\i -> if i < pORT_NUM_END
+                                                                        then return (i+1)
                                                                         else error "The port number reached the maximum")
                                               retryConnect port
 
@@ -359,19 +368,22 @@ readSockResponsesUntil :: Socket -> ResponseMsg -> BS.ByteString -> IO [ResponseMsg]
 readSockResponsesUntil sock rsp bs
   = do resp <- recv sock 2048
+       -- putStrLn $ "###" ++ BS.unpack resp
        let fullBS = bs `BS.append` resp
-       if BS.null resp 
+       if BS.null resp
          then return []
          else
            let splitted = BS.split '\n' fullBS
                recognized = catMaybes $ map decode splitted
-            in if rsp `elem` recognized 
-                 then return $ List.delete rsp recognized 
+            in if rsp `elem` recognized
+                 then return $ List.delete rsp recognized
                  else readSockResponsesUntil sock rsp fullBS
 
 testRoot = "examples" </> "Project"
 
+deriving instance Eq UndoRefactor
 deriving instance Eq ResponseMsg
+instance FromJSON UndoRefactor
 instance FromJSON ResponseMsg
 instance ToJSON ClientMessage
 instance ToJSON PackageDB
@@ -400,15 +412,15 @@ longestCommonPrefix = foldl1 commonPrefix
 
 instance FromJSON SrcSpan where
-    parseJSON (Object v) = mkSrcSpanReal <$> v .: "file" 
-                                         <*> v .: "startRow" 
-                                         <*> v .: "startCol" 
+    parseJSON (Object v) = mkSrcSpanReal <$> v .: "file"
+                                         <*> v .: "startRow"
+                                         <*> v .: "startCol"
                                          <*> v .: "endRow"
                                          <*> v .: "endCol"
     parseJSON _          = fail "not an object"
 
 
 mkSrcSpanReal :: String -> Int -> Int -> Int -> Int -> SrcSpan
-mkSrcSpanReal file startRow startCol endRow endCol 
+mkSrcSpanReal file startRow startCol endRow endCol
   = mkSrcSpan (mkSrcLoc (mkFastString file) startRow startCol)
               (mkSrcLoc (mkFastString file) endRow endCol)