Remove IdeResponse, integrate it into IdeM as FreeT IdeDefer

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 T.Text
+                        | ModuleFailed
                         -- ^ The module has no cache but something went wrong
                         | ModuleCached CachedModule IsStale
                         -- ^ A cache exists for the module

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

@@ -4,7 +4,6 @@
 
 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)
@@ -23,7 +22,7 @@ data UriCache = UriCache
   { cachedModule :: !CachedModule
   , cachedData   :: !(Map.Map TypeRep Dynamic)
   , isStale      :: !Bool
-  } | UriCacheFailed T.Text deriving Show
+  } | UriCacheFailed deriving Show
 
 data CachedModule = CachedModule
   { tcMod          :: !TypecheckedModule

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

@@ -6,12 +6,11 @@ module Haskell.Ide.Engine.ModuleCache where
 import           Control.Monad
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Control
-import qualified Data.Aeson as J
+import           Control.Monad.Trans.Free
 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
@@ -80,22 +79,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 T.Text
+                        | ModuleFailed
                         -- ^ 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 :: (GM.MonadIO m, HasGhcModuleCache m)
+getCachedModule :: (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 err) -> ModuleFailed err
+    Just uriCache@UriCache {} -> ModuleCached (cachedModule uriCache) (isStale uriCache)
+    Just UriCacheFailed -> ModuleFailed
 
 -- | Returns true if there is a CachedModule for a given URI
 isCached :: (GM.MonadIO m, HasGhcModuleCache m)
@@ -108,22 +107,10 @@ isCached uri = do
 
 -- | Version of `withCachedModuleAndData` that doesn't provide
 -- any extra cached data.
-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
+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
 
 -- | Calls its argument with the CachedModule for a given URI
 -- along with any data that might be stored in the ModuleCache.
@@ -134,77 +121,66 @@ withCachedModuleDefault uri mdef callback = do
 -- 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 -> (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
+                        => 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
 
 -- | 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
 
-  modifyCache (\gmc ->
-      gmc { uriCaches = Map.insert
-                          uri'
-                          (UriCache cm Map.empty False)
-                          (uriCaches gmc)
-          }
-    )
+  let uc = UriCache cm Map.empty False
+
+  modifyCache $ \gmc ->
+      gmc { uriCaches = Map.insert uri' uc (uriCaches gmc) }
 
   -- execute any queued actions for the module
-  runDeferredActions uri' (Right cm)
+  runDeferredActions uri' uc
 
 -- | Marks a module that it failed to load and triggers
 -- any deferred responses waiting on it
-failModule :: FilePath -> T.Text -> IdeGhcM ()
-failModule fp err = do
+failModule :: FilePath -> IdeGhcM ()
+failModule fp = do
   fp' <- liftIO $ canonicalizePath fp
 
   maybeUriCache <- fmap (Map.lookup fp' . uriCaches) getModuleCache
 
+  let uc = UriCacheFailed
+
   case maybeUriCache of
     Just _ -> return ()
-    Nothing -> do
+    Nothing ->
       -- If there's no cache for the module mark it as failed
       modifyCache (\gmc ->
           gmc {
-            uriCaches = Map.insert fp' (UriCacheFailed err) (uriCaches gmc)
+            uriCaches = Map.insert fp' uc (uriCaches gmc)
           }
         )
 
       -- Fail the queued actions
-      runDeferredActions fp' (Left err)
+  runDeferredActions fp' uc
 
 
-runDeferredActions :: FilePath -> Either T.Text CachedModule -> IdeGhcM ()
+runDeferredActions :: FilePath -> UriCache -> 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 $ getPlugins
+  (IdePlugins m) <- lift $ 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,7 +8,6 @@ module Haskell.Ide.Engine.PluginUtils
   (
     mapEithers
   , pluginGetFile
-  , pluginGetFileResponse
   , makeDiffResult
   , WithDeletions(..)
   , makeAdditiveDiffResult
@@ -122,16 +121,6 @@ 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]