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
  TVar RzkTypecheckCache
typecheckCache <- RzkTypecheckCache -> IO (TVar RzkTypecheckCache)
forall a. a -> IO (TVar a)
newTVarIO []
  RzkEnv -> IO RzkEnv
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RzkEnv
    { rzkEnvTypecheckCache :: TVar RzkTypecheckCache
rzkEnvTypecheckCache = TVar RzkTypecheckCache
typecheckCache }

type LSP = LspT ServerConfig (ReaderT RzkEnv IO)

-- | Override the cache with given typechecked modules.
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
  TVar RzkTypecheckCache
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
  IO () -> ReaderT RzkEnv IO ()
forall a. IO a -> ReaderT RzkEnv IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT RzkEnv IO ()) -> IO () -> ReaderT RzkEnv IO ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    TVar RzkTypecheckCache -> RzkTypecheckCache -> STM ()
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 = 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
  TVar RzkTypecheckCache
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
  IO () -> ReaderT RzkEnv IO ()
forall a. IO a -> ReaderT RzkEnv IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT RzkEnv IO ()) -> IO () -> ReaderT RzkEnv IO ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    TVar RzkTypecheckCache
-> (RzkTypecheckCache -> RzkTypecheckCache) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar RzkTypecheckCache
typecheckCache (((FilePath, RzkCachedModule) -> Bool)
-> RzkTypecheckCache -> RzkTypecheckCache
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath]
paths) (FilePath -> Bool)
-> ((FilePath, RzkCachedModule) -> FilePath)
-> (FilePath, RzkCachedModule)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, RzkCachedModule) -> FilePath
forall a b. (a, b) -> a
fst))

-- | Get the current state of the cache.
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
  TVar RzkTypecheckCache
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
  IO RzkTypecheckCache -> ReaderT RzkEnv IO RzkTypecheckCache
forall a. IO a -> ReaderT RzkEnv IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RzkTypecheckCache -> ReaderT RzkEnv IO RzkTypecheckCache)
-> IO RzkTypecheckCache -> ReaderT RzkEnv IO RzkTypecheckCache
forall a b. (a -> b) -> a -> b
$ TVar RzkTypecheckCache -> IO RzkTypecheckCache
forall a. TVar a -> IO a
readTVarIO TVar RzkTypecheckCache
typecheckCache