module Futhark.LSP.Compile (tryTakeStateFromMVar, tryReCompile) where
import Control.Concurrent.MVar (MVar, putMVar, takeMVar)
import Control.Monad.IO.Class (MonadIO (liftIO))
import qualified Data.Map as M
import qualified Data.Text as T
import Futhark.Compiler.Program (LoadedProg, lpWarnings, noLoadedProg, reloadProg)
import Futhark.LSP.Diagnostic (diagnosticSource, maxDiagnostic, publishErrorDiagnostics, publishWarningDiagnostics)
import Futhark.LSP.State (State (..), emptyState)
import Futhark.Util (debug)
import Language.Futhark.Warnings (listWarnings)
import Language.LSP.Server (LspT, flushDiagnosticsBySource, getVirtualFiles)
import Language.LSP.Types (fromNormalizedFilePath, uriToNormalizedFilePath)
import Language.LSP.VFS (VFS (vfsMap), virtualFileText)
tryTakeStateFromMVar :: MVar State -> Maybe FilePath -> LspT () IO State
tryTakeStateFromMVar :: MVar State -> Maybe FilePath -> LspT () IO State
tryTakeStateFromMVar MVar State
state_mvar Maybe FilePath
file_path = do
State
old_state <- IO State -> LspT () IO State
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO State -> LspT () IO State) -> IO State -> LspT () IO State
forall a b. (a -> b) -> a -> b
$ MVar State -> IO State
forall a. MVar a -> IO a
takeMVar MVar State
state_mvar
case State -> Maybe LoadedProg
stateProgram State
old_state of
Maybe LoadedProg
Nothing -> do
State
new_state <- Maybe FilePath -> State -> LspT () IO State
tryCompile Maybe FilePath
file_path (Maybe LoadedProg -> State
State (Maybe LoadedProg -> State) -> Maybe LoadedProg -> State
forall a b. (a -> b) -> a -> b
$ LoadedProg -> Maybe LoadedProg
forall a. a -> Maybe a
Just LoadedProg
noLoadedProg)
IO () -> LspT () IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LspT () IO ()) -> IO () -> LspT () IO ()
forall a b. (a -> b) -> a -> b
$ MVar State -> State -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar State
state_mvar State
new_state
State -> LspT () IO State
forall (f :: * -> *) a. Applicative f => a -> f a
pure State
new_state
Just LoadedProg
_ -> do
IO () -> LspT () IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LspT () IO ()) -> IO () -> LspT () IO ()
forall a b. (a -> b) -> a -> b
$ MVar State -> State -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar State
state_mvar State
old_state
State -> LspT () IO State
forall (f :: * -> *) a. Applicative f => a -> f a
pure State
old_state
tryReCompile :: MVar State -> Maybe FilePath -> LspT () IO ()
tryReCompile :: MVar State -> Maybe FilePath -> LspT () IO ()
tryReCompile MVar State
state_mvar Maybe FilePath
file_path = do
FilePath -> LspT () IO ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
debug FilePath
"(Re)-compiling ..."
State
old_state <- IO State -> LspT () IO State
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO State -> LspT () IO State) -> IO State -> LspT () IO State
forall a b. (a -> b) -> a -> b
$ MVar State -> IO State
forall a. MVar a -> IO a
takeMVar MVar State
state_mvar
State
new_state <- Maybe FilePath -> State -> LspT () IO State
tryCompile Maybe FilePath
file_path State
old_state
case State -> Maybe LoadedProg
stateProgram State
new_state of
Maybe LoadedProg
Nothing -> do
FilePath -> LspT () IO ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
debug FilePath
"Failed to (re)-compile, using old state or Nothing"
IO () -> LspT () IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LspT () IO ()) -> IO () -> LspT () IO ()
forall a b. (a -> b) -> a -> b
$ MVar State -> State -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar State
state_mvar State
old_state
Just LoadedProg
_ -> do
FilePath -> LspT () IO ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
debug FilePath
"(Re)-compile successful"
IO () -> LspT () IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LspT () IO ()) -> IO () -> LspT () IO ()
forall a b. (a -> b) -> a -> b
$ MVar State -> State -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar State
state_mvar State
new_state
tryCompile :: Maybe FilePath -> State -> LspT () IO State
tryCompile :: Maybe FilePath -> State -> LspT () IO State
tryCompile Maybe FilePath
Nothing State
_ = State -> LspT () IO State
forall (f :: * -> *) a. Applicative f => a -> f a
pure State
emptyState
tryCompile (Just FilePath
path) State
state = do
let old_loaded_prog :: LoadedProg
old_loaded_prog = State -> LoadedProg
getLoadedProg State
state
VFS
vfs <- LspT () IO VFS
forall config (m :: * -> *). MonadLsp config m => m VFS
getVirtualFiles
Either (NonEmpty ProgError) LoadedProg
res <- IO (Either (NonEmpty ProgError) LoadedProg)
-> LspT () IO (Either (NonEmpty ProgError) LoadedProg)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either (NonEmpty ProgError) LoadedProg)
-> LspT () IO (Either (NonEmpty ProgError) LoadedProg))
-> IO (Either (NonEmpty ProgError) LoadedProg)
-> LspT () IO (Either (NonEmpty ProgError) LoadedProg)
forall a b. (a -> b) -> a -> b
$ LoadedProg
-> [FilePath] -> VFS -> IO (Either (NonEmpty ProgError) LoadedProg)
reloadProg LoadedProg
old_loaded_prog [FilePath
path] (VFS -> VFS
transformVFS VFS
vfs)
Int -> Maybe DiagnosticSource -> LspT () IO ()
forall config (m :: * -> *).
MonadLsp config m =>
Int -> Maybe DiagnosticSource -> m ()
flushDiagnosticsBySource Int
maxDiagnostic Maybe DiagnosticSource
diagnosticSource
case Either (NonEmpty ProgError) LoadedProg
res of
Right LoadedProg
new_loaded_prog -> do
[(SrcLoc, Doc)] -> LspT () IO ()
publishWarningDiagnostics ([(SrcLoc, Doc)] -> LspT () IO ())
-> [(SrcLoc, Doc)] -> LspT () IO ()
forall a b. (a -> b) -> a -> b
$ Warnings -> [(SrcLoc, Doc)]
listWarnings (Warnings -> [(SrcLoc, Doc)]) -> Warnings -> [(SrcLoc, Doc)]
forall a b. (a -> b) -> a -> b
$ LoadedProg -> Warnings
lpWarnings LoadedProg
new_loaded_prog
State -> LspT () IO State
forall (f :: * -> *) a. Applicative f => a -> f a
pure (State -> LspT () IO State) -> State -> LspT () IO State
forall a b. (a -> b) -> a -> b
$ Maybe LoadedProg -> State
State (LoadedProg -> Maybe LoadedProg
forall a. a -> Maybe a
Just LoadedProg
new_loaded_prog)
Left NonEmpty ProgError
prog_error -> do
FilePath -> LspT () IO ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
debug FilePath
"Compilation failed, publishing diagnostics"
NonEmpty ProgError -> LspT () IO ()
publishErrorDiagnostics NonEmpty ProgError
prog_error
State -> LspT () IO State
forall (f :: * -> *) a. Applicative f => a -> f a
pure State
emptyState
transformVFS :: VFS -> M.Map FilePath T.Text
transformVFS :: VFS -> VFS
transformVFS VFS
vfs =
(NormalizedUri -> VirtualFile -> VFS -> VFS)
-> VFS -> Map NormalizedUri VirtualFile -> VFS
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey
( \NormalizedUri
uri VirtualFile
virtual_file VFS
acc ->
case NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath NormalizedUri
uri of
Maybe NormalizedFilePath
Nothing -> VFS
acc
Just NormalizedFilePath
file_path ->
FilePath -> DiagnosticSource -> VFS -> VFS
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (NormalizedFilePath -> FilePath
fromNormalizedFilePath NormalizedFilePath
file_path) (VirtualFile -> DiagnosticSource
virtualFileText VirtualFile
virtual_file) VFS
acc
)
VFS
forall k a. Map k a
M.empty
(VFS -> Map NormalizedUri VirtualFile
vfsMap VFS
vfs)
getLoadedProg :: State -> LoadedProg
getLoadedProg :: State -> LoadedProg
getLoadedProg (State (Just LoadedProg
loaded_prog)) = LoadedProg
loaded_prog
getLoadedProg (State Maybe LoadedProg
Nothing) = LoadedProg
noLoadedProg