2222module Ide.Plugin.Eval where
2323
2424import Control.Monad (void )
25- import Control.Monad.Catch (finally )
25+ import Control.Monad.Catch (MonadMask , bracket )
2626import Control.Monad.IO.Class (MonadIO (liftIO ))
2727import Control.Monad.Trans.Class (MonadTrans (lift ))
2828import Control.Monad.Trans.Except (ExceptT (.. ), runExceptT ,
@@ -31,7 +31,6 @@ import Data.Aeson (FromJSON, ToJSON, Value (Null),
3131 toJSON )
3232import Data.Bifunctor (Bifunctor (first ))
3333import qualified Data.HashMap.Strict as Map
34- import qualified Data.Rope.UTF16 as Rope
3534import Data.String (IsString (fromString ))
3635import Data.Text (Text )
3736import qualified Data.Text as T
@@ -58,9 +57,9 @@ import Ide.Plugin
5857import Ide.Types
5958import Language.Haskell.LSP.Core (LspFuncs (getVirtualFileFunc ))
6059import Language.Haskell.LSP.Types
61- import Language.Haskell.LSP.VFS (VirtualFile ( .. ) )
60+ import Language.Haskell.LSP.VFS (virtualFileText )
6261import PrelNames (pRELUDE )
63- import System.IO (IOMode (WriteMode ), hClose , openFile )
62+ import System.IO (Handle , IOMode (WriteMode ), hClose , openFile )
6463import System.IO.Extra (newTempFile )
6564
6665descriptor :: PluginId -> PluginDescriptor
@@ -104,7 +103,7 @@ provider :: CodeLensProvider
104103provider lsp _state plId CodeLensParams {_textDocument} = response $ do
105104 let TextDocumentIdentifier uri = _textDocument
106105 contents <- liftIO $ getVirtualFileFunc lsp $ toNormalizedUri uri
107- let text = Rope. toText . (_text :: VirtualFile -> Rope. Rope ) <$> contents
106+ let text = virtualFileText <$> contents
108107 let matches = extractMatches text
109108
110109 cmd <- liftIO $ mkLspCommand plId evalCommandName " Evaluate..." (Just [] )
@@ -147,7 +146,7 @@ runEvalCmd lsp state EvalParams {..} = response' $ do
147146 let TextDocumentIdentifier {_uri} = module_
148147 fp <- handleMaybe " uri" $ uriToFilePath' _uri
149148 contents <- liftIO $ getVirtualFileFunc lsp $ toNormalizedUri _uri
150- text <- handleMaybe " contents" $ Rope. toText . (_text :: VirtualFile -> Rope. Rope ) <$> contents
149+ text <- handleMaybe " contents" $ virtualFileText <$> contents
151150
152151 session <-
153152 liftIO
@@ -165,10 +164,7 @@ runEvalCmd lsp state EvalParams {..} = response' $ do
165164
166165 now <- liftIO getCurrentTime
167166
168- (temp, clean) <- liftIO newTempFile
169- (tempLog, cleanLog) <- liftIO newTempFile
170- hLog <- liftIO $ openFile tempLog WriteMode
171- flip finally (liftIO $ hClose hLog >> cleanLog >> clean) $ do
167+ withTempFile $ \ temp -> withTempFile $ \ tempLog -> withFile tempLog WriteMode $ \ hLog -> do
172168 let modName = moduleName $ ms_mod ms
173169 thisModuleTarget = Target (TargetFile fp Nothing ) False (Just (textToStringBuffer text, now))
174170
@@ -297,3 +293,16 @@ setupDynFlagsForGHCiLike env dflags = do
297293 `gopt_set` Opt_IgnoreOptimChanges
298294 `gopt_set` Opt_IgnoreHpcChanges
299295 initializePlugins env dflags4
296+
297+
298+ withTempFile :: (MonadIO m , MonadMask m ) => (FilePath -> m a ) -> m a
299+ withTempFile k = bracket alloc release (k . fst )
300+ where
301+ alloc = liftIO newTempFile
302+ release = liftIO . snd
303+
304+ withFile :: (MonadMask m , MonadIO m ) => FilePath -> IOMode -> (Handle -> m b ) -> m b
305+ withFile f mode = bracket alloc release
306+ where
307+ alloc = liftIO $ openFile f mode
308+ release = liftIO . hClose
0 commit comments