haskell-tools-daemon 0.7.0.0 → 0.8.0.0

raw patch · 7 files changed

+58/−34 lines, 7 filesdep ~haskell-tools-astdep ~haskell-tools-daemondep ~haskell-tools-prettyprintPVP ok

version bump matches the API change (PVP)

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

API changes (from Hackage documentation)

Files

• Language/Haskell/Tools/Refactor/Daemon.hs +21/−27
• Language/Haskell/Tools/Refactor/Daemon/State.hs +1/−0
• examples/Project/unused-mod/Main.hs +3/−0
• examples/Project/unused-mod/Unused.hs +1/−0
• examples/Project/unused-mod/some-test-package.cabal +19/−0
• haskell-tools-daemon.cabal +8/−6
• test/Main.hs +5/−1

@@ -5,6 +5,7 @@            , TemplateHaskell
            , FlexibleContexts
            , MultiWayIf
+           , TypeApplications
            #-}
 module Language.Haskell.Tools.Refactor.Daemon where
 
@@ -126,11 +127,11 @@     return True
 updateClient _ (RemovePackages packagePathes) = do
     mcs <- gets (^. refSessMCs)
-    let existing = map ms_mod (mcs ^? traversal & filtered isRemoved & mcModules & traversal & modRecMS)
-    lift $ forM_ existing (\modName -> removeTarget (TargetModule (GHC.moduleName modName)))
+    let existingFiles = concatMap @[] (map (^. sfkFileName) . Map.keys) (mcs ^? traversal & filtered isRemoved & mcModules)
+    lift $ forM_ existingFiles (\fs -> removeTarget (TargetFile fs Nothing))
     lift $ deregisterDirs (mcs ^? traversal & filtered isRemoved & mcSourceDirs & traversal)
     modify $ refSessMCs .- filter (not . isRemoved)
-    modifySession (\s -> s { hsc_mod_graph = filter (not . (`elem` existing) . ms_mod) (hsc_mod_graph s) })
+    modifySession (\s -> s { hsc_mod_graph = filter ((`notElem` existingFiles) . getModSumOrig) (hsc_mod_graph s) })
     mcs <- gets (^. refSessMCs)
     when (null mcs) $ modify (packageDBSet .= False)
     return True
@@ -139,12 +140,11 @@ updateClient resp (ReLoad added changed removed) =
   -- TODO: check for changed cabal files and reload their packages
   do mcs <- gets (^. refSessMCs)
-     removedMods <- gets (map ms_mod . filter ((`elem` removed) . getModSumOrig) . (^? refSessMCs & traversal & mcModules & traversal & modRecMS))
-     lift $ forM_ removedMods (\modName -> removeTarget (TargetModule (GHC.moduleName modName)))
+     lift $ forM_ removed (\src -> removeTarget (TargetFile src Nothing))
      -- 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) })
+                .- Map.filter (\m -> maybe True ((`notElem` removed) . getModSumOrig) (m ^? modRecMS))
+     modifySession (\s -> s { hsc_mod_graph = filter (\mod -> getModSumOrig mod `notElem` removed) (hsc_mod_graph s) })
      -- reload changed modules
      -- TODO: filter those that are in reloaded packages
      reloadRes <- reloadChangedModules (\ms -> resp (LoadedModules [(getModSumOrig ms, getModSumName ms)]))
@@ -183,20 +183,18 @@ 
               let Just otherMS = otherMR ^? modRecMS
                   Just mc = lookupModuleColl (otherM ^. sfkModuleName) mcs
-              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
+              modify $ refSessMCs & traversal & filtered (\mc' -> (mc' ^. mcId) == (mc ^. mcId)) & mcModules
+                         .- Map.insert (SourceFileKey loc n) (ModuleNotLoaded False False)
               liftIO $ withBinaryFile loc WriteMode $ \handle -> do
                 hSetEncoding handle utf8
                 hPutStr handle (prettyPrint m)
-              lift $ addTarget (Target (TargetModule (GHC.mkModuleName n)) True Nothing)
-              return $ Right (SourceFileKey NormalHs n, loc, RemoveAdded loc)
+              lift $ addTarget (Target (TargetFile loc Nothing) True Nothing)
+              return $ Right (SourceFileKey loc n, loc, RemoveAdded loc)
             ContentChanged (n,m) -> do
-              Just (_, mr) <- gets (lookupModInSCs n . (^. refSessMCs))
-              let Just ms = mr ^? modRecMS
               let newCont = prettyPrint m
-                  file = getModSumOrig ms
+                  file = n ^. sfkFileName
               origCont <- liftIO $ withBinaryFile file ReadMode $ \handle -> do
                 hSetEncoding handle utf8
                 StrictIO.hGetContents handle
@@ -206,12 +204,12 @@                 hPutStr handle newCont
               return $ Right (n, file, UndoChanges file undo)
             ModuleRemoved mod -> do
-              Just (_,m) <- gets (lookupModInSCs (SourceFileKey NormalHs mod) . (^. refSessMCs))
+              Just (_,m) <- gets (lookupModuleInSCs 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)
+              lift $ removeTarget (TargetFile file Nothing)
               modify $ (refSessMCs .- removeModule mod)
               liftIO $ removeFile file
               return $ Left $ RestoreRemoved file origCont
@@ -232,25 +230,21 @@     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)
+      let existing = (existingMCs ^? traversal & filtered isTheAdded & mcModules & traversal & modRecMS)
+          existingModNames = map ms_mod existing
+      needToReload <- handleErrors $ (filter (\ms -> not $ ms_mod ms `elem` existingModNames))
+                                       <$> getReachableModules (\_ -> return ()) (\ms -> ms_mod ms `elem` existingModNames)
       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) })
+      forM_ existing $ \ms -> removeTarget (TargetFile (getModSumOrig ms) Nothing)
+      modifySession (\s -> s { hsc_mod_graph = filter (not . (`elem` existingModNames) . ms_mod) (hsc_mod_graph s) })
       -- load new modules
       pkgDBok <- initializePackageDBIfNeeded
       if pkgDBok then do
         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
+          Right modules -> 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)
       else liftIO $ resp $ ErrorMessage $ "Attempted to load two packages with different package DB. "
                                             ++ "Stack, cabal-sandbox and normal packages cannot be combined"

@@ -4,6 +4,7 @@ import Control.Reference
 
 import Language.Haskell.Tools.Refactor.Daemon.PackageDB
+import Language.Haskell.Tools.Refactor.RefactorBase
 import Language.Haskell.Tools.Refactor.Session
 
 data DaemonSessionState

@@ -0,0 +1,3 @@+module Main where
+
+main = putStrLn "Hello World"

@@ -0,0 +1,1 @@+Not a valid haskell program

@@ -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
+
+executable foo
+  main-is:             Main.hs
+  build-depends:       base
+  default-language:    Haskell2010
+  other-modules:       Unused

@@ -1,5 +1,5 @@ name:                haskell-tools-daemon
-version:             0.7.0.0
+version:             0.8.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
@@ -58,6 +58,8 @@                   , 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
+                  , examples/Project/unused-mod/*.hs
+                  , examples/Project/unused-mod/*.cabal
 
 
 library
@@ -76,9 +78,9 @@                      , references                >= 0.3.2 && < 1.0
                      , network                   >= 2.6   && < 3.0
                      , Diff                      >= 0.3   && < 0.4
-                     , haskell-tools-ast         >= 0.7   && < 0.8
-                     , haskell-tools-prettyprint >= 0.7   && < 0.8
-                     , haskell-tools-refactor    >= 0.7   && < 0.8
+                     , haskell-tools-ast         >= 0.8   && < 0.9
+                     , haskell-tools-prettyprint >= 0.8   && < 0.9
+                     , haskell-tools-refactor    >= 0.8   && < 0.9
   exposed-modules:     Language.Haskell.Tools.Refactor.Daemon
                      , Language.Haskell.Tools.Refactor.Daemon.State
                      , Language.Haskell.Tools.Refactor.Daemon.PackageDB
@@ -89,7 +91,7 @@ executable ht-daemon
   ghc-options:         -rtsopts
   build-depends:       base                      >= 4.9 && < 5.0
-                     , haskell-tools-daemon      >= 0.7 && < 0.8
+                     , haskell-tools-daemon      >= 0.8 && < 0.9
   hs-source-dirs:      exe
   main-is:             Main.hs
   default-language:    Haskell2010
@@ -110,5 +112,5 @@                      , bytestring                >= 0.10 && < 0.11
                      , network                   >= 2.6  && < 2.7
                      , aeson                     >= 1.0 && < 1.3
-                     , haskell-tools-daemon      >= 0.7  && < 0.8
+                     , haskell-tools-daemon      >= 0.8  && < 0.9
   default-language:    Haskell2010

@@ -58,7 +58,7 @@              then testGroup "pkg-db-tests" $ map (makePkgDbTest portCounter) pkgDbTests
              else testCase "IGNORED pkg-db-tests" (return ())
           -- cannot execute this when the source is not present
-          , if isSource then selfLoadingTest portCounter else testCase "IGNORED self-load" (return ())
+          -- , if isSource then selfLoadingTest portCounter else testCase "IGNORED self-load" (return ())
           ]
 
 testSuffix = "_test"
@@ -121,6 +121,10 @@       , LoadedModules [(testRoot </> "th-added-later" </> "package1" </> "A.hs", "A")]
       , LoadingModules [ testRoot </> "th-added-later" </> "package2" </> "B.hs" ]
       , LoadedModules [(testRoot </> "th-added-later" </> "package2" </> "B.hs", "B")] ] )
+  , ( "unused-module"
+    , [ AddPackages [testRoot </> "unused-mod"] ]
+    , [ LoadingModules [ testRoot </> "unused-mod" </> "Main.hs" ]
+      , LoadedModules [ (testRoot </> "unused-mod" </> "Main.hs", "Main") ] ] )
   ]
 
 compProblemTests :: [(String, [Either (IO ()) ClientMessage], [ResponseMsg] -> Bool)]