Revert #777 and #782, performance was awful

docs/Architecture.md

@@ -40,7 +40,7 @@ getCachedModule :: Uri -> IdeM (CachedModuleResult)
 -- along with the cache or error if present
 data CachedModuleResult = ModuleLoading
                         -- ^ The module has no cache yet and has not failed
-                        | ModuleFailed
+                        | ModuleFailed T.Text
                         -- ^ The module has no cache but something went wrong
                         | ModuleCached CachedModule IsStale
                         -- ^ A cache exists for the module
@@ -80,8 +80,7 @@ class Typeable a => ModuleCache a where
     cacheDataProducer :: CachedModule -> IdeM a
 
 withCachedModuleAndData :: forall a b. ModuleCache a
-                        => FilePath -> b
-                        -> (CachedModule -> a -> IdeM b) -> IdeM b
+  => Uri -> IdeM b -> (CachedModule -> a -> IdeM b) -> IdeM b
 withCachedModuleAndData uri noCache callback = ...
 ```
 
@@ -107,7 +106,7 @@ This data is used to find all references to a symbol, and to find the name corre
 a particular position in the source.
 
 ```haskell
-getReferencesInDoc :: Uri -> Position -> IdeM (IdeResult [J.DocumentHighlight])
+getReferencesInDoc :: Uri -> Position -> IdeM (IdeResponse [J.DocumentHighlight])
 getReferencesInDoc uri pos = do
   let noCache = return $ nonExistentCacheErr "getReferencesInDoc"
   withCachedModuleAndData uri noCache $
@@ -146,7 +145,7 @@ data GhcRequest m = forall a. GhcRequest
 data IdeRequest m = forall a. IdeRequest
   { pureReqId :: J.LspId
   , pureReqCallback :: RequestCallback m a
-  , pureReq :: IdeM (IdeResult a)
+  , pureReq :: IdeM (IdeResponse a)
   }
 
 ```
@@ -177,26 +176,75 @@ for handling the "definition" request
       ...
 
 -- HaRePlugin.hs
-findDef :: Uri -> Position -> IdeM (IdeResult Location)
+findDef :: Uri -> Position -> IdeM (IdeResponse Location)
 ```
 
 The request uses the `findDef` function in the `HaRe` plugin to get the `Location` 
 of the definition of the symbol at the given position. The callback makes a LSP 
 response message out of the location, and forwards it to thread #4 which sends
-it to the IDE via stdout.
+it to the IDE via stdout
 
-## Deferred requests
+## Responses and results
 
-Should you find yourself wanting to access a typechecked module from within `IdeM`, 
-use `withCachedModule` to get access to a cached version of that module.
-If there is no cached module available, then it will automatically defer your result,
-or return a default if that then fails to typecheck:
+While working in the `IdeGhcM` thread, you return results back to the dispatcher with
+`IdeResult`:
 
 ```haskell
-withCachedModule file (IdeResultOk []) $ \cm -> do
-  -- poke about with cm here
+runHareCommand :: String -> RefactGhc [ApplyRefacResult]
+                 -> IdeGhcM (IdeResult WorkspaceEdit)
+runHareCommand name cmd = do
+     eitherRes <- runHareCommand' cmd
+     case eitherRes of
+       Left err ->
+         pure (IdeResultFail
+                 (IdeError PluginError
+                           (T.pack $ name <> ": \"" <> err <> "\"")
+                           Null))
+       Right res -> do
+            let changes = getRefactorResult res
+            refactRes <- makeRefactorResult changes
+            pure (IdeResultOk refactRes)
 ```
 
-Internally, a deferred response is represented by `IdeDefer`, which takes a file path
-to a module, and a callback which will be executed with a `UriCache` passed as an
-argument as soon as the module is loaded, or a `UriCacheFailed` if it failed.
+On `IdeM`, you must wrap any `IdeResult` in an `IdeResponse`:
+
+```haskell
+getDynFlags :: Uri -> IdeM (IdeResponse DynFlags)
+getDynFlags uri =
+  pluginGetFileResponse "getDynFlags: " uri $ \fp -> do
+      mcm <- getCachedModule fp
+      case mcm of
+        ModuleCached cm _ -> return $
+          IdeResponseOk $ ms_hspp_opts $ pm_mod_summary $ tm_parsed_module $ tcMod cm
+        _ -> return $
+          IdeResponseFail $
+            IdeError PluginError ("getDynFlags: \"" <> "module not loaded" <> "\"") Null
+```
+
+Sometimes a request may need access to the typechecked module from ghc-mod, but
+it is desirable to keep it on the `IdeM` thread. For this a deferred response can
+be made:
+
+```haskell
+getDynFlags :: Uri -> IdeM (IdeResponse DynFlags)
+getDynFlags uri =
+  pluginGetFileResponse "getDynFlags: " uri $ \fp -> do
+    mcm <- getCachedModule fp
+    return $ case mcm of
+      ModuleCached cm _ -> IdeResponseOk $ getFlags cm
+      _ -> IdeResponseDeferred fp getFlags
+  where getFlags = ms_hspp_opts $ pm_mod_summary $ tm_parsed_module $ tcMod cm
+```
+
+A deferred response takes a file path to a module, and a callback which will be executed
+as with the cached module passed as an argument as soon as the module is loaded.
+
+This is wrapped with the helper function `withCachedModule` which will immediately return
+the cached module if it is already available to use, and only defer it otherwise.
+
+```haskell
+getDynFlags :: Uri -> IdeM (IdeResponse DynFlags)
+getDynFlags uri =
+  pluginGetFileResponse "getDynFlags: " uri $ \fp ->
+    withCachedModule fp (return . IdeResponseOk . ms_hspp_opts . pm_mod_summary . tm_parsed_module . tcMod)
+```

hie-plugin-api/Haskell/Ide/Engine/GhcModuleCache.hs

@@ -4,6 +4,7 @@
 
 module Haskell.Ide.Engine.GhcModuleCache where
 
+import qualified Data.Text as T
 import qualified Data.Map as Map
 import           Data.Dynamic (Dynamic)
 import           Data.Typeable (TypeRep)
@@ -22,7 +23,7 @@ data UriCache = UriCache
   { cachedModule :: !CachedModule
   , cachedData   :: !(Map.Map TypeRep Dynamic)
   , isStale      :: !Bool
-  } | UriCacheFailed deriving Show
+  } | UriCacheFailed T.Text deriving Show
 
 data CachedModule = CachedModule
   { tcMod          :: !TypecheckedModule

hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs

@@ -6,11 +6,12 @@ module Haskell.Ide.Engine.ModuleCache where
 import           Control.Monad
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Control
-import           Control.Monad.Trans.Free
+import qualified Data.Aeson as J
 import           Data.Dynamic (toDyn, fromDynamic)
 import           Data.Generics (Proxy(..), typeRep, typeOf)
 import qualified Data.Map as Map
 import           Data.Maybe
+import qualified Data.Text as T
 import           Data.Typeable (Typeable)
 import           Exception (ExceptionMonad)
 import           System.Directory
@@ -79,22 +80,22 @@ getCradle fp = do
 -- along with the cache or error if present
 data CachedModuleResult = ModuleLoading
                         -- ^ The module has no cache yet and has not failed
-                        | ModuleFailed
+                        | ModuleFailed T.Text
                         -- ^ The module has no cache because something went wrong
                         | ModuleCached CachedModule IsStale
                         -- ^ A cache exists for the module
 type IsStale = Bool
 
 -- | looks up a CachedModule for a given URI
-getCachedModule :: (MonadIO m, HasGhcModuleCache m)
+getCachedModule :: (GM.MonadIO m, HasGhcModuleCache m)
                 => FilePath -> m CachedModuleResult
 getCachedModule uri = do
   uri' <- liftIO $ canonicalizePath uri
   maybeUriCache <- fmap (Map.lookup uri' . uriCaches) getModuleCache
   return $ case maybeUriCache of
     Nothing -> ModuleLoading
-    Just uriCache@UriCache {} -> ModuleCached (cachedModule uriCache) (isStale uriCache)
-    Just UriCacheFailed -> ModuleFailed
+    Just uriCache@(UriCache {}) -> ModuleCached (cachedModule uriCache) (isStale uriCache)
+    Just (UriCacheFailed err) -> ModuleFailed err
 
 -- | Returns true if there is a CachedModule for a given URI
 isCached :: (GM.MonadIO m, HasGhcModuleCache m)
@@ -107,10 +108,22 @@ isCached uri = do
 
 -- | Version of `withCachedModuleAndData` that doesn't provide
 -- any extra cached data.
-withCachedModule :: FilePath -> a -> (CachedModule -> IdeM a) -> IdeM a
-withCachedModule fp def callback = wrap (IdeDefer fp go)
-  where go UriCache{cachedModule = cm} = callback cm
-        go _ = return def
+withCachedModule :: FilePath -> (CachedModule -> IdeM (IdeResponse b)) -> IdeM (IdeResponse b)
+withCachedModule uri callback = withCachedModuleDefault uri Nothing callback
+
+-- | Version of `withCachedModuleAndData` that doesn't provide
+-- any extra cached data.
+withCachedModuleDefault :: FilePath -> Maybe (IdeResponse b)
+                        -> (CachedModule -> IdeM (IdeResponse b)) -> IdeM (IdeResponse b)
+withCachedModuleDefault uri mdef callback = do
+  mcm <- getCachedModule uri
+  uri' <- liftIO $ canonicalizePath uri
+  case mcm of
+    ModuleCached cm _ -> callback cm
+    ModuleLoading -> return $ IdeResponseDeferred uri' callback
+    ModuleFailed err -> case mdef of
+      Nothing -> return $ IdeResponseFail (IdeError NoModuleAvailable err J.Null)
+      Just def -> return def
 
 -- | Calls its argument with the CachedModule for a given URI
 -- along with any data that might be stored in the ModuleCache.
@@ -121,66 +134,77 @@ withCachedModule fp def callback = wrap (IdeDefer fp go)
 -- If the data doesn't exist in the cache, new data is generated
 -- using by calling the `cacheDataProducer` function.
 withCachedModuleAndData :: forall a b. ModuleCache a
-                        => FilePath -> b
-                        -> (CachedModule -> a -> IdeM b) -> IdeM b
-withCachedModuleAndData fp def callback = wrap (IdeDefer fp go)
-  where go UriCacheFailed = return def
-        go UriCache{cachedModule = cm, cachedData = dat} = do
-          fp' <- liftIO $ canonicalizePath fp
-          let proxy :: Proxy a
-              proxy = Proxy
-          a <- case Map.lookup (typeRep proxy) dat of
-                Nothing -> do
-                  val <- cacheDataProducer cm
-                  let dat' = Map.insert (typeOf val) (toDyn val) dat
-                  modifyCache (\s -> s {uriCaches = Map.insert fp' (UriCache cm dat' False)
-                                                              (uriCaches s)})
-                  return val
-                Just x ->
-                  case fromDynamic x of
-                    Just val -> return val
-                    Nothing  -> error "impossible"
-          callback cm a
+                        => FilePath -> (CachedModule -> a -> IdeM (IdeResponse b)) -> IdeM (IdeResponse b)
+withCachedModuleAndData uri callback = withCachedModuleAndDataDefault uri Nothing callback
+
+withCachedModuleAndDataDefault :: forall a b. ModuleCache a
+                        => FilePath -> Maybe (IdeResponse b)
+                        -> (CachedModule -> a -> IdeM (IdeResponse b)) -> IdeM (IdeResponse b)
+withCachedModuleAndDataDefault uri mdef callback = do
+  uri' <- liftIO $ canonicalizePath uri
+  mcache <- getModuleCache
+  let mc = (Map.lookup uri' . uriCaches) mcache
+  case mc of
+    Nothing -> return $ IdeResponseDeferred uri' $ \_ -> withCachedModuleAndData uri callback
+    Just (UriCacheFailed err) -> case mdef of
+      Nothing -> return $ IdeResponseFail (IdeError NoModuleAvailable err J.Null)
+      Just def -> return def
+    Just UriCache{cachedModule = cm, cachedData = dat} -> do
+      let proxy :: Proxy a
+          proxy = Proxy
+      a <- case Map.lookup (typeRep proxy) dat of
+             Nothing -> do
+               val <- cacheDataProducer cm
+               let dat' = Map.insert (typeOf val) (toDyn val) dat
+               modifyCache (\s -> s {uriCaches = Map.insert uri' (UriCache cm dat' False)
+                                                                 (uriCaches s)})
+               return val
+             Just x ->
+               case fromDynamic x of
+                 Just val -> return val
+                 Nothing  -> error "impossible"
+      callback cm a
 
 -- | Saves a module to the cache and executes any deferred
 -- responses waiting on that module.
 cacheModule :: FilePath -> CachedModule -> IdeGhcM ()
 cacheModule uri cm = do
   uri' <- liftIO $ canonicalizePath uri
 
-  let uc = UriCache cm Map.empty False
-
-  modifyCache $ \gmc ->
-      gmc { uriCaches = Map.insert uri' uc (uriCaches gmc) }
+  modifyCache (\gmc ->
+      gmc { uriCaches = Map.insert
+                          uri'
+                          (UriCache cm Map.empty False)
+                          (uriCaches gmc)
+          }
+    )
 
   -- execute any queued actions for the module
-  runDeferredActions uri' uc
+  runDeferredActions uri' (Right cm)
 
 -- | Marks a module that it failed to load and triggers
 -- any deferred responses waiting on it
-failModule :: FilePath -> IdeGhcM ()
-failModule fp = do
+failModule :: FilePath -> T.Text -> IdeGhcM ()
+failModule fp err = do
   fp' <- liftIO $ canonicalizePath fp
 
   maybeUriCache <- fmap (Map.lookup fp' . uriCaches) getModuleCache
 
-  let uc = UriCacheFailed
-
   case maybeUriCache of
     Just _ -> return ()
-    Nothing ->
+    Nothing -> do
       -- If there's no cache for the module mark it as failed
       modifyCache (\gmc ->
           gmc {
-            uriCaches = Map.insert fp' uc (uriCaches gmc)
+            uriCaches = Map.insert fp' (UriCacheFailed err) (uriCaches gmc)
           }
         )
 
       -- Fail the queued actions
-  runDeferredActions fp' uc
+      runDeferredActions fp' (Left err)
 
 
-runDeferredActions :: FilePath -> UriCache -> IdeGhcM ()
+runDeferredActions :: FilePath -> Either T.Text CachedModule -> IdeGhcM ()
 runDeferredActions uri cached = do
       actions <- fmap (fromMaybe [] . Map.lookup uri) (requestQueue <$> readMTS)
       liftToGhc $ forM_ actions (\a -> a cached)

hie-plugin-api/Haskell/Ide/Engine/Monad.hs

@@ -2,7 +2,7 @@ module Haskell.Ide.Engine.Monad where
 
 import           Control.Exception
 import           Control.Monad.IO.Class
-import           Control.Monad.Reader
+import Control.Monad.Reader
 import qualified GhcMod.Monad                  as GM
 import qualified GhcMod.Types                  as GM
 import           Haskell.Ide.Engine.MonadTypes

hie-plugin-api/Haskell/Ide/Engine/PluginDescriptor.hs

@@ -43,7 +43,7 @@ toDynJSON = CD.toDyn
 -- arguments in the form of a JSON object.
 runPluginCommand :: PluginId -> CommandName -> Value -> IdeGhcM (IdeResult DynamicJSON)
 runPluginCommand p com arg = do
-  (IdePlugins m) <- lift $ lift $ lift getPlugins
+  (IdePlugins m) <- lift . lift $ getPlugins
   case Map.lookup p m of
     Nothing -> return $
       IdeResultFail $ IdeError UnknownPlugin ("Plugin " <> p <> " doesn't exist") Null

hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs

@@ -8,6 +8,7 @@ module Haskell.Ide.Engine.PluginUtils
   (
     mapEithers
   , pluginGetFile
+  , pluginGetFileResponse
   , makeDiffResult
   , WithDeletions(..)
   , makeAdditiveDiffResult
@@ -121,6 +122,16 @@ pluginGetFile name uri f =
     Nothing -> return $ IdeResultFail (IdeError PluginError
                  (name <> "Couldn't resolve uri" <> getUri uri) Null)
 
+-- | @pluginGetFile but for IdeResponse - use with IdeM
+pluginGetFileResponse
+  :: Monad m
+  => T.Text -> Uri -> (FilePath -> m (IdeResponse a)) -> m (IdeResponse a)
+pluginGetFileResponse name uri f =
+  case uriToFilePath uri of
+    Just file -> f file
+    Nothing -> return $ IdeResponseFail (IdeError PluginError
+                (name <> "Couldn't resolve uri" <> getUri uri) Null)
+
 -- ---------------------------------------------------------------------
 -- courtesy of http://stackoverflow.com/questions/19891061/mapeithers-function-in-haskell
 mapEithers :: (a -> Either b c) -> [a] -> Either b [c]