-- | The language server state definition.
module Futhark.LSP.State
  ( State (..),
    emptyState,
    getStaleContent,
    getStaleMapping,
    updateStaleContent,
    updateStaleMapping,
  )
where

import qualified Data.Map as M
import Futhark.Compiler.Program (LoadedProg)
import Futhark.LSP.PositionMapping (PositionMapping, StaleFile (..))
import Language.LSP.VFS (VirtualFile)

-- | The state of the language server.
data State = State
  { -- | The loaded program.
    State -> Maybe LoadedProg
stateProgram :: Maybe LoadedProg,
    -- | The stale data, stored to provide PositionMapping when requested.
    -- All files that have been opened have an entry.
    State -> Map FilePath StaleFile
staleData :: M.Map FilePath StaleFile
  }

-- | Initial state.
emptyState :: State
emptyState :: State
emptyState = Maybe LoadedProg -> Map FilePath StaleFile -> State
State Maybe LoadedProg
forall a. Maybe a
Nothing Map FilePath StaleFile
forall k a. Map k a
M.empty

-- | Get the contents of a stale (last successfully complied) file's contents.
getStaleContent :: State -> FilePath -> Maybe VirtualFile
getStaleContent :: State -> FilePath -> Maybe VirtualFile
getStaleContent State
state FilePath
file_path = (VirtualFile -> Maybe VirtualFile
forall a. a -> Maybe a
Just (VirtualFile -> Maybe VirtualFile)
-> (StaleFile -> VirtualFile) -> StaleFile -> Maybe VirtualFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaleFile -> VirtualFile
staleContent) (StaleFile -> Maybe VirtualFile)
-> Maybe StaleFile -> Maybe VirtualFile
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> Map FilePath StaleFile -> Maybe StaleFile
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
file_path (State -> Map FilePath StaleFile
staleData State
state)

-- | Get the PositionMapping for a file.
getStaleMapping :: State -> FilePath -> Maybe PositionMapping
getStaleMapping :: State -> FilePath -> Maybe PositionMapping
getStaleMapping State
state FilePath
file_path = StaleFile -> Maybe PositionMapping
staleMapping (StaleFile -> Maybe PositionMapping)
-> Maybe StaleFile -> Maybe PositionMapping
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> Map FilePath StaleFile -> Maybe StaleFile
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
file_path (State -> Map FilePath StaleFile
staleData State
state)

-- | Update the state with another pair of file_path and contents.
-- Could do a clean up becausae there is no need to store files that are not in lpFilePaths prog.
updateStaleContent :: FilePath -> VirtualFile -> LoadedProg -> State -> State
updateStaleContent :: FilePath -> VirtualFile -> LoadedProg -> State -> State
updateStaleContent FilePath
file_path VirtualFile
file_content LoadedProg
loadedProg State
state =
  -- NOTE: insert will replace the old value if the key already exists.
  -- updateStaleContent is only called after a successful type-check,
  -- so the PositionsMapping should be Nothing here, it's calculated after failed type-check.
  Maybe LoadedProg -> Map FilePath StaleFile -> State
State (LoadedProg -> Maybe LoadedProg
forall a. a -> Maybe a
Just LoadedProg
loadedProg) (FilePath
-> StaleFile -> Map FilePath StaleFile -> Map FilePath StaleFile
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FilePath
file_path (VirtualFile -> Maybe PositionMapping -> StaleFile
StaleFile VirtualFile
file_content Maybe PositionMapping
forall a. Maybe a
Nothing) (State -> Map FilePath StaleFile
staleData State
state))

-- | Update the state with another pair of file_path and PositionMapping.
updateStaleMapping :: Maybe FilePath -> Maybe PositionMapping -> State -> State
updateStaleMapping :: Maybe FilePath -> Maybe PositionMapping -> State -> State
updateStaleMapping (Just FilePath
file_path) Maybe PositionMapping
mapping State
state = do
  case FilePath -> Map FilePath StaleFile -> Maybe StaleFile
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
file_path (State -> Map FilePath StaleFile
staleData State
state) of
    Maybe StaleFile
Nothing -> State
state -- Only happends when the file have never been successfully type-checked before.
    Just (StaleFile VirtualFile
file_content Maybe PositionMapping
_mapping) ->
      Maybe LoadedProg -> Map FilePath StaleFile -> State
State (State -> Maybe LoadedProg
stateProgram State
state) (FilePath
-> StaleFile -> Map FilePath StaleFile -> Map FilePath StaleFile
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FilePath
file_path (VirtualFile -> Maybe PositionMapping -> StaleFile
StaleFile VirtualFile
file_content Maybe PositionMapping
mapping) (State -> Map FilePath StaleFile
staleData State
state))
updateStaleMapping Maybe FilePath
_ Maybe PositionMapping
_ State
state = State
state