module Language.Rzk.VSCode.Env where
import Control.Concurrent.STM
import Control.Monad.Reader
import Language.LSP.Server
import Language.Rzk.Free.Syntax (VarIdent)
import Language.Rzk.VSCode.Config (ServerConfig)
import Rzk.TypeCheck (Decl', TypeErrorInScopedContext)
data RzkCachedModule = RzkCachedModule
{ RzkCachedModule -> [Decl']
cachedModuleDecls :: [Decl']
, RzkCachedModule -> [TypeErrorInScopedContext VarIdent]
cachedModuleErrors :: [TypeErrorInScopedContext VarIdent]
}
type RzkTypecheckCache = [(FilePath, RzkCachedModule)]
newtype RzkEnv = RzkEnv
{ RzkEnv -> TVar RzkTypecheckCache
rzkEnvTypecheckCache :: TVar RzkTypecheckCache
}
defaultRzkEnv :: IO RzkEnv
defaultRzkEnv :: IO RzkEnv
defaultRzkEnv = do
typecheckCache <- RzkTypecheckCache -> IO (TVar RzkTypecheckCache)
forall a. a -> IO (TVar a)
newTVarIO []
return RzkEnv
{ rzkEnvTypecheckCache = typecheckCache }
type LSP = LspT ServerConfig (ReaderT RzkEnv IO)
cacheTypecheckedModules :: RzkTypecheckCache -> LSP ()
cacheTypecheckedModules :: RzkTypecheckCache -> LSP ()
cacheTypecheckedModules RzkTypecheckCache
cache = ReaderT RzkEnv IO () -> LSP ()
forall (m :: * -> *) a. Monad m => m a -> LspT ServerConfig m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT RzkEnv IO () -> LSP ()) -> ReaderT RzkEnv IO () -> LSP ()
forall a b. (a -> b) -> a -> b
$ do
typecheckCache <- (RzkEnv -> TVar RzkTypecheckCache)
-> ReaderT RzkEnv IO (TVar RzkTypecheckCache)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RzkEnv -> TVar RzkTypecheckCache
rzkEnvTypecheckCache
liftIO $ atomically $ do
writeTVar typecheckCache cache
resetCacheForAllFiles :: LSP ()
resetCacheForAllFiles :: LSP ()
resetCacheForAllFiles = RzkTypecheckCache -> LSP ()
cacheTypecheckedModules []
resetCacheForFiles :: [FilePath] -> LSP ()
resetCacheForFiles :: [FilePath] -> LSP ()
resetCacheForFiles [FilePath]
paths = ReaderT RzkEnv IO () -> LSP ()
forall (m :: * -> *) a. Monad m => m a -> LspT ServerConfig m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT RzkEnv IO () -> LSP ()) -> ReaderT RzkEnv IO () -> LSP ()
forall a b. (a -> b) -> a -> b
$ do
typecheckCache <- (RzkEnv -> TVar RzkTypecheckCache)
-> ReaderT RzkEnv IO (TVar RzkTypecheckCache)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RzkEnv -> TVar RzkTypecheckCache
rzkEnvTypecheckCache
liftIO $ atomically $ do
modifyTVar typecheckCache (takeWhile ((`notElem` paths) . fst))
getCachedTypecheckedModules :: LSP RzkTypecheckCache
getCachedTypecheckedModules :: LSP RzkTypecheckCache
getCachedTypecheckedModules = ReaderT RzkEnv IO RzkTypecheckCache -> LSP RzkTypecheckCache
forall (m :: * -> *) a. Monad m => m a -> LspT ServerConfig m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT RzkEnv IO RzkTypecheckCache -> LSP RzkTypecheckCache)
-> ReaderT RzkEnv IO RzkTypecheckCache -> LSP RzkTypecheckCache
forall a b. (a -> b) -> a -> b
$ do
typecheckCache <- (RzkEnv -> TVar RzkTypecheckCache)
-> ReaderT RzkEnv IO (TVar RzkTypecheckCache)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RzkEnv -> TVar RzkTypecheckCache
rzkEnvTypecheckCache
liftIO $ readTVarIO typecheckCache