module Language.Rzk.VSCode.Env where

import           Control.Concurrent.STM
import           Control.Monad.Reader
import           Language.LSP.Server
import           Rzk.TypeCheck          (Decl')

type RzkTypecheckCache = [(FilePath, [Decl'])]

data RzkEnv = RzkEnv
  { RzkEnv -> TVar RzkTypecheckCache
rzkEnvTypecheckCache :: TVar RzkTypecheckCache
  }

defaultRzkEnv :: IO RzkEnv
defaultRzkEnv :: IO RzkEnv
defaultRzkEnv = do
  TVar RzkTypecheckCache
typecheckCache <- forall a. a -> IO (TVar a)
newTVarIO []
  forall (m :: * -> *) a. Monad m => a -> m a
return RzkEnv
    { rzkEnvTypecheckCache :: TVar RzkTypecheckCache
rzkEnvTypecheckCache = TVar RzkTypecheckCache
typecheckCache }


type LSP = LspT () (ReaderT RzkEnv IO)

-- | Override the cache with given typechecked modules.
cacheTypecheckedModules :: RzkTypecheckCache -> LSP ()
cacheTypecheckedModules :: RzkTypecheckCache -> LSP ()
cacheTypecheckedModules RzkTypecheckCache
cache = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ do
  TVar RzkTypecheckCache
typecheckCache <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RzkEnv -> TVar RzkTypecheckCache
rzkEnvTypecheckCache
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
    forall a. TVar a -> a -> STM ()
writeTVar TVar RzkTypecheckCache
typecheckCache RzkTypecheckCache
cache

-- | Completely invalidate the cache of typechecked files.
resetCacheForAllFiles :: LSP ()
resetCacheForAllFiles :: LSP ()
resetCacheForAllFiles = RzkTypecheckCache -> LSP ()
cacheTypecheckedModules []

-- | Invalidate the cache for a list of file paths.
resetCacheForFiles :: [FilePath] -> LSP ()
resetCacheForFiles :: [FilePath] -> LSP ()
resetCacheForFiles [FilePath]
paths = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ do
  TVar RzkTypecheckCache
typecheckCache <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RzkEnv -> TVar RzkTypecheckCache
rzkEnvTypecheckCache
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
    forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar RzkTypecheckCache
typecheckCache (forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath]
paths) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst))

-- | Get the current state of the cache.
getCachedTypecheckedModules :: LSP RzkTypecheckCache
getCachedTypecheckedModules :: LSP RzkTypecheckCache
getCachedTypecheckedModules = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ do
  TVar RzkTypecheckCache
typecheckCache <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RzkEnv -> TVar RzkTypecheckCache
rzkEnvTypecheckCache
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> IO a
readTVarIO TVar RzkTypecheckCache
typecheckCache