{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE CPP           #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE ViewPatterns        #-}
{-# LANGUAGE RecordWildCards     #-}

module Language.Rzk.VSCode.Handlers (
  typecheckFromConfigFile,
  provideCompletions,
  formatDocument,
  provideSemanticTokens,
  handleFilesChanged,
) where

import           Control.Exception             (SomeException, evaluate, try)
import           Control.Lens
import           Control.Monad                 (forM_, when)
import           Control.Monad.Except          (ExceptT (ExceptT),
                                                MonadError (throwError),
                                                modifyError, runExceptT)
import           Control.Monad.IO.Class        (MonadIO (..))
import           Data.Default.Class
import           Data.List                     (isSuffixOf, sort, (\\))
import           Data.Maybe                    (fromMaybe, isNothing)
import qualified Data.Text                     as T
import qualified Data.Yaml                     as Yaml
import           Language.LSP.Diagnostics      (partitionBySource)
import           Language.LSP.Protocol.Lens    (HasDetail (detail),
                                                HasDocumentation (documentation),
                                                HasLabel (label),
                                                HasParams (params),
                                                HasTextDocument (textDocument),
                                                HasUri (uri), changes, uri)
import           Language.LSP.Protocol.Message
import           Language.LSP.Protocol.Types
import           Language.LSP.Server
import           Language.LSP.VFS              (virtualFileText)
import           System.FilePath               (makeRelative, (</>))
import           System.FilePath.Glob          (compile, globDir)

import           Data.Char                     (isDigit)
import           Language.Rzk.Free.Syntax      (RzkPosition (RzkPosition),
                                                VarIdent (getVarIdent))
import           Language.Rzk.Syntax           (Module, VarIdent' (VarIdent),
                                                parseModuleFile,
                                                parseModuleSafe, printTree)
import           Language.Rzk.VSCode.Config    (ServerConfig (ServerConfig, formatEnabled))
import           Language.Rzk.VSCode.Env
import           Language.Rzk.VSCode.Logging
import           Language.Rzk.VSCode.Tokenize  (tokenizeModule)
import           Rzk.Format                    (FormattingEdit (..),
                                                formatTextEdits)
import           Rzk.Project.Config            (ProjectConfig (include))
import           Rzk.TypeCheck
import           Text.Read                     (readMaybe)

-- | Given a list of file paths, reads them and parses them as Rzk modules,
--   returning the same list of file paths but with the parsed module (or parse error)
parseFiles :: [FilePath] -> IO [(FilePath, Either String Module)]
parseFiles :: [FilePath] -> IO [(FilePath, Either FilePath Module)]
parseFiles [] = [(FilePath, Either FilePath Module)]
-> IO [(FilePath, Either FilePath Module)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
parseFiles (FilePath
x:[FilePath]
xs) = do
  Either FilePath Module
errOrMod <- FilePath -> IO (Either FilePath Module)
parseModuleFile FilePath
x
  [(FilePath, Either FilePath Module)]
rest <- [FilePath] -> IO [(FilePath, Either FilePath Module)]
parseFiles [FilePath]
xs
  [(FilePath, Either FilePath Module)]
-> IO [(FilePath, Either FilePath Module)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(FilePath, Either FilePath Module)]
 -> IO [(FilePath, Either FilePath Module)])
-> [(FilePath, Either FilePath Module)]
-> IO [(FilePath, Either FilePath Module)]
forall a b. (a -> b) -> a -> b
$ (FilePath
x, Either FilePath Module
errOrMod) (FilePath, Either FilePath Module)
-> [(FilePath, Either FilePath Module)]
-> [(FilePath, Either FilePath Module)]
forall a. a -> [a] -> [a]
: [(FilePath, Either FilePath Module)]
rest

-- | Given the list of possible modules returned by `parseFiles`, this segregates the errors
--   from the successfully parsed modules and returns them in separate lists so the errors
--   can be reported and the modules can be typechecked.
collectErrors :: [(FilePath, Either String Module)] -> ([(FilePath, String)], [(FilePath, Module)])
collectErrors :: [(FilePath, Either FilePath Module)]
-> ([(FilePath, FilePath)], [(FilePath, Module)])
collectErrors [] = ([], [])
collectErrors ((FilePath
path, Either FilePath Module
result) : [(FilePath, Either FilePath Module)]
paths) =
  case Either FilePath Module
result of
    Left FilePath
err      -> ((FilePath
path, FilePath
err) (FilePath, FilePath)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. a -> [a] -> [a]
: [(FilePath, FilePath)]
errors, [])
    Right Module
module_ -> ([(FilePath, FilePath)]
errors, (FilePath
path, Module
module_) (FilePath, Module) -> [(FilePath, Module)] -> [(FilePath, Module)]
forall a. a -> [a] -> [a]
: [(FilePath, Module)]
modules)
  where
    ([(FilePath, FilePath)]
errors, [(FilePath, Module)]
modules) = [(FilePath, Either FilePath Module)]
-> ([(FilePath, FilePath)], [(FilePath, Module)])
collectErrors [(FilePath, Either FilePath Module)]
paths

-- | The maximum number of diagnostic messages to send to the client
maxDiagnosticCount :: Int
maxDiagnosticCount :: Int
maxDiagnosticCount = Int
100

filePathToNormalizedUri :: FilePath -> NormalizedUri
filePathToNormalizedUri :: FilePath -> NormalizedUri
filePathToNormalizedUri = Uri -> NormalizedUri
toNormalizedUri (Uri -> NormalizedUri)
-> (FilePath -> Uri) -> FilePath -> NormalizedUri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Uri
filePathToUri


typecheckFromConfigFile :: LSP ()
typecheckFromConfigFile :: LSP ()
typecheckFromConfigFile = do
  FilePath -> LSP ()
forall c (m :: * -> *). MonadLsp c m => FilePath -> m ()
logInfo FilePath
"Looking for rzk.yaml"
  Maybe FilePath
root <- LspT ServerConfig (ReaderT RzkEnv IO) (Maybe FilePath)
forall config (m :: * -> *).
MonadLsp config m =>
m (Maybe FilePath)
getRootPath
  case Maybe FilePath
root of
    Maybe FilePath
Nothing -> do
      FilePath -> LSP ()
forall c (m :: * -> *). MonadLsp c m => FilePath -> m ()
logWarning FilePath
"Workspace has no root path, cannot find rzk.yaml"
      SServerMethod 'Method_WindowShowMessage
-> MessageParams 'Method_WindowShowMessage -> LSP ()
forall (m :: Method 'ServerToClient 'Notification) (f :: * -> *)
       config.
MonadLsp config f =>
SServerMethod m -> MessageParams m -> f ()
sendNotification SServerMethod 'Method_WindowShowMessage
SMethod_WindowShowMessage (MessageType -> Text -> ShowMessageParams
ShowMessageParams MessageType
MessageType_Warning Text
"Cannot find the workspace root")
    Just FilePath
rootPath -> do
      let rzkYamlPath :: FilePath
rzkYamlPath = FilePath
rootPath FilePath -> FilePath -> FilePath
</> FilePath
"rzk.yaml"
      Either ParseException ProjectConfig
eitherConfig <- IO (Either ParseException ProjectConfig)
-> LspT
     ServerConfig
     (ReaderT RzkEnv IO)
     (Either ParseException ProjectConfig)
forall a. IO a -> LspT ServerConfig (ReaderT RzkEnv IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ParseException ProjectConfig)
 -> LspT
      ServerConfig
      (ReaderT RzkEnv IO)
      (Either ParseException ProjectConfig))
-> IO (Either ParseException ProjectConfig)
-> LspT
     ServerConfig
     (ReaderT RzkEnv IO)
     (Either ParseException ProjectConfig)
forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => FilePath -> IO (Either ParseException a)
Yaml.decodeFileEither @ProjectConfig FilePath
rzkYamlPath
      case Either ParseException ProjectConfig
eitherConfig of
        Left ParseException
err -> do
          FilePath -> LSP ()
forall c (m :: * -> *). MonadLsp c m => FilePath -> m ()
logError (FilePath
"Invalid or missing rzk.yaml: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ParseException -> FilePath
Yaml.prettyPrintParseException ParseException
err)

        Right ProjectConfig
config -> do
          FilePath -> LSP ()
forall c (m :: * -> *). MonadLsp c m => FilePath -> m ()
logDebug FilePath
"Starting typechecking"
          [[FilePath]]
rawPaths <- IO [[FilePath]]
-> LspT ServerConfig (ReaderT RzkEnv IO) [[FilePath]]
forall a. IO a -> LspT ServerConfig (ReaderT RzkEnv IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[FilePath]]
 -> LspT ServerConfig (ReaderT RzkEnv IO) [[FilePath]])
-> IO [[FilePath]]
-> LspT ServerConfig (ReaderT RzkEnv IO) [[FilePath]]
forall a b. (a -> b) -> a -> b
$ [Pattern] -> FilePath -> IO [[FilePath]]
globDir ((FilePath -> Pattern) -> [FilePath] -> [Pattern]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Pattern
compile (ProjectConfig -> [FilePath]
include ProjectConfig
config)) FilePath
rootPath
          let paths :: [FilePath]
paths = ([FilePath] -> [FilePath]) -> [[FilePath]] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [[FilePath]]
rawPaths

          RzkTypecheckCache
typecheckedCachedModules <- LSP RzkTypecheckCache
getCachedTypecheckedModules
          let cachedModules :: [(FilePath, [Decl'])]
cachedModules = ((FilePath, RzkCachedModule) -> (FilePath, [Decl']))
-> RzkTypecheckCache -> [(FilePath, [Decl'])]
forall a b. (a -> b) -> [a] -> [b]
map (\(FilePath
path, RzkCachedModule{[TypeErrorInScopedContext VarIdent]
[Decl']
cachedModuleDecls :: [Decl']
cachedModuleErrors :: [TypeErrorInScopedContext VarIdent]
cachedModuleErrors :: RzkCachedModule -> [TypeErrorInScopedContext VarIdent]
cachedModuleDecls :: RzkCachedModule -> [Decl']
..}) -> (FilePath
path, [Decl']
cachedModuleDecls)) RzkTypecheckCache
typecheckedCachedModules
          let cachedPaths :: [FilePath]
cachedPaths = ((FilePath, [Decl']) -> FilePath)
-> [(FilePath, [Decl'])] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, [Decl']) -> FilePath
forall a b. (a, b) -> a
fst [(FilePath, [Decl'])]
cachedModules
              modifiedFiles :: [FilePath]
modifiedFiles = [FilePath]
paths [FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath]
cachedPaths

          FilePath -> LSP ()
forall c (m :: * -> *). MonadLsp c m => FilePath -> m ()
logDebug (FilePath
"Found " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show ([FilePath] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
cachedPaths) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" files in the cache")
          FilePath -> LSP ()
forall c (m :: * -> *). MonadLsp c m => FilePath -> m ()
logDebug (Int -> FilePath
forall a. Show a => a -> FilePath
show ([FilePath] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
modifiedFiles) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" files have been modified")

          ([(FilePath, FilePath)]
parseErrors, [(FilePath, Module)]
parsedModules) <- IO ([(FilePath, FilePath)], [(FilePath, Module)])
-> LspT
     ServerConfig
     (ReaderT RzkEnv IO)
     ([(FilePath, FilePath)], [(FilePath, Module)])
forall a. IO a -> LspT ServerConfig (ReaderT RzkEnv IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([(FilePath, FilePath)], [(FilePath, Module)])
 -> LspT
      ServerConfig
      (ReaderT RzkEnv IO)
      ([(FilePath, FilePath)], [(FilePath, Module)]))
-> IO ([(FilePath, FilePath)], [(FilePath, Module)])
-> LspT
     ServerConfig
     (ReaderT RzkEnv IO)
     ([(FilePath, FilePath)], [(FilePath, Module)])
forall a b. (a -> b) -> a -> b
$ [(FilePath, Either FilePath Module)]
-> ([(FilePath, FilePath)], [(FilePath, Module)])
collectErrors ([(FilePath, Either FilePath Module)]
 -> ([(FilePath, FilePath)], [(FilePath, Module)]))
-> IO [(FilePath, Either FilePath Module)]
-> IO ([(FilePath, FilePath)], [(FilePath, Module)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath] -> IO [(FilePath, Either FilePath Module)]
parseFiles [FilePath]
modifiedFiles
          Either
  SomeException
  (Either
     (TypeErrorInScopedContext VarIdent)
     ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent]))
tcResults <- IO
  (Either
     SomeException
     (Either
        (TypeErrorInScopedContext VarIdent)
        ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])))
-> LspT
     ServerConfig
     (ReaderT RzkEnv IO)
     (Either
        SomeException
        (Either
           (TypeErrorInScopedContext VarIdent)
           ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])))
forall a. IO a -> LspT ServerConfig (ReaderT RzkEnv IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (Either
      SomeException
      (Either
         (TypeErrorInScopedContext VarIdent)
         ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])))
 -> LspT
      ServerConfig
      (ReaderT RzkEnv IO)
      (Either
         SomeException
         (Either
            (TypeErrorInScopedContext VarIdent)
            ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent]))))
-> IO
     (Either
        SomeException
        (Either
           (TypeErrorInScopedContext VarIdent)
           ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])))
-> LspT
     ServerConfig
     (ReaderT RzkEnv IO)
     (Either
        SomeException
        (Either
           (TypeErrorInScopedContext VarIdent)
           ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])))
forall a b. (a -> b) -> a -> b
$ IO
  (Either
     (TypeErrorInScopedContext VarIdent)
     ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent]))
-> IO
     (Either
        SomeException
        (Either
           (TypeErrorInScopedContext VarIdent)
           ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO
   (Either
      (TypeErrorInScopedContext VarIdent)
      ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent]))
 -> IO
      (Either
         SomeException
         (Either
            (TypeErrorInScopedContext VarIdent)
            ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent]))))
-> IO
     (Either
        (TypeErrorInScopedContext VarIdent)
        ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent]))
-> IO
     (Either
        SomeException
        (Either
           (TypeErrorInScopedContext VarIdent)
           ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])))
forall a b. (a -> b) -> a -> b
$ Either
  (TypeErrorInScopedContext VarIdent)
  ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])
-> IO
     (Either
        (TypeErrorInScopedContext VarIdent)
        ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent]))
forall a. a -> IO a
evaluate (Either
   (TypeErrorInScopedContext VarIdent)
   ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])
 -> IO
      (Either
         (TypeErrorInScopedContext VarIdent)
         ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])))
-> Either
     (TypeErrorInScopedContext VarIdent)
     ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])
-> IO
     (Either
        (TypeErrorInScopedContext VarIdent)
        ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent]))
forall a b. (a -> b) -> a -> b
$
            TypeCheck
  VarIdent
  ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])
-> Either
     (TypeErrorInScopedContext VarIdent)
     ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])
forall var a.
TypeCheck var a -> Either (TypeErrorInScopedContext var) a
defaultTypeCheck ([(FilePath, [Decl'])]
-> [(FilePath, Module)]
-> TypeCheck
     VarIdent
     ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])
typecheckModulesWithLocationIncremental [(FilePath, [Decl'])]
cachedModules [(FilePath, Module)]
parsedModules)

          ([TypeErrorInScopedContext VarIdent]
typeErrors, [(FilePath, [Decl'])]
_checkedModules) <- case Either
  SomeException
  (Either
     (TypeErrorInScopedContext VarIdent)
     ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent]))
tcResults of
            Left (SomeException
ex :: SomeException) -> do
              -- Just a warning to be logged in the "Output" panel and not shown to the user as an error message
              --  because exceptions are expected when the file has invalid syntax
              FilePath -> LSP ()
forall c (m :: * -> *). MonadLsp c m => FilePath -> m ()
logWarning (FilePath
"Encountered an exception while typechecking:\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ SomeException -> FilePath
forall a. Show a => a -> FilePath
show SomeException
ex)
              ([TypeErrorInScopedContext VarIdent], [(FilePath, [Decl'])])
-> LspT
     ServerConfig
     (ReaderT RzkEnv IO)
     ([TypeErrorInScopedContext VarIdent], [(FilePath, [Decl'])])
forall a. a -> LspT ServerConfig (ReaderT RzkEnv IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [])
            Right (Left TypeErrorInScopedContext VarIdent
err) -> do
              FilePath -> LSP ()
forall c (m :: * -> *). MonadLsp c m => FilePath -> m ()
logError (FilePath
"An impossible error happened! Please report a bug:\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ OutputDirection -> TypeErrorInScopedContext VarIdent -> FilePath
ppTypeErrorInScopedContext' OutputDirection
BottomUp TypeErrorInScopedContext VarIdent
err)
              ([TypeErrorInScopedContext VarIdent], [(FilePath, [Decl'])])
-> LspT
     ServerConfig
     (ReaderT RzkEnv IO)
     ([TypeErrorInScopedContext VarIdent], [(FilePath, [Decl'])])
forall a. a -> LspT ServerConfig (ReaderT RzkEnv IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([TypeErrorInScopedContext VarIdent
err], [])    -- sort of impossible
            Right (Right ([(FilePath, [Decl'])]
checkedModules, [TypeErrorInScopedContext VarIdent]
errors)) -> do
                -- cache well-typed modules
                FilePath -> LSP ()
forall c (m :: * -> *). MonadLsp c m => FilePath -> m ()
logInfo (Int -> FilePath
forall a. Show a => a -> FilePath
show ([(FilePath, [Decl'])] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(FilePath, [Decl'])]
checkedModules) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" modules successfully typechecked")
                FilePath -> LSP ()
forall c (m :: * -> *). MonadLsp c m => FilePath -> m ()
logInfo (Int -> FilePath
forall a. Show a => a -> FilePath
show ([TypeErrorInScopedContext VarIdent] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TypeErrorInScopedContext VarIdent]
errors) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" errors found")
                let checkedModules' :: RzkTypecheckCache
checkedModules' = ((FilePath, [Decl']) -> (FilePath, RzkCachedModule))
-> [(FilePath, [Decl'])] -> RzkTypecheckCache
forall a b. (a -> b) -> [a] -> [b]
map (\(FilePath
path, [Decl']
decls) -> (FilePath
path, [Decl'] -> [TypeErrorInScopedContext VarIdent] -> RzkCachedModule
RzkCachedModule [Decl']
decls ((TypeErrorInScopedContext VarIdent -> Bool)
-> [TypeErrorInScopedContext VarIdent]
-> [TypeErrorInScopedContext VarIdent]
forall a. (a -> Bool) -> [a] -> [a]
filter ((FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
path) (FilePath -> Bool)
-> (TypeErrorInScopedContext VarIdent -> FilePath)
-> TypeErrorInScopedContext VarIdent
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeErrorInScopedContext VarIdent -> FilePath
forall var. TypeErrorInScopedContext var -> FilePath
filepathOfTypeError) [TypeErrorInScopedContext VarIdent]
errors))) [(FilePath, [Decl'])]
checkedModules
                RzkTypecheckCache -> LSP ()
cacheTypecheckedModules RzkTypecheckCache
checkedModules'
                ([TypeErrorInScopedContext VarIdent], [(FilePath, [Decl'])])
-> LspT
     ServerConfig
     (ReaderT RzkEnv IO)
     ([TypeErrorInScopedContext VarIdent], [(FilePath, [Decl'])])
forall a. a -> LspT ServerConfig (ReaderT RzkEnv IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([TypeErrorInScopedContext VarIdent]
errors, [(FilePath, [Decl'])]
checkedModules)

          -- Reset all published diags
          -- TODO: remove this after properly grouping by path below, after which there can be an empty list of errors
          -- TODO: handle clearing diagnostics for files that got removed from the project (rzk.yaml)
          [FilePath] -> (FilePath -> LSP ()) -> LSP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
modifiedFiles ((FilePath -> LSP ()) -> LSP ()) -> (FilePath -> LSP ()) -> LSP ()
forall a b. (a -> b) -> a -> b
$ \FilePath
path -> do
            Int
-> NormalizedUri -> Maybe Int32 -> DiagnosticsBySource -> LSP ()
forall config (m :: * -> *).
MonadLsp config m =>
Int -> NormalizedUri -> Maybe Int32 -> DiagnosticsBySource -> m ()
publishDiagnostics Int
0 (FilePath -> NormalizedUri
filePathToNormalizedUri FilePath
path) Maybe Int32
forall a. Maybe a
Nothing ([Diagnostic] -> DiagnosticsBySource
partitionBySource [])

          -- Report parse errors to the client
          [(FilePath, FilePath)]
-> ((FilePath, FilePath) -> LSP ()) -> LSP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(FilePath, FilePath)]
parseErrors (((FilePath, FilePath) -> LSP ()) -> LSP ())
-> ((FilePath, FilePath) -> LSP ()) -> LSP ()
forall a b. (a -> b) -> a -> b
$ \(FilePath
path, FilePath
err) -> do
            Int
-> NormalizedUri -> Maybe Int32 -> DiagnosticsBySource -> LSP ()
forall config (m :: * -> *).
MonadLsp config m =>
Int -> NormalizedUri -> Maybe Int32 -> DiagnosticsBySource -> m ()
publishDiagnostics Int
maxDiagnosticCount (FilePath -> NormalizedUri
filePathToNormalizedUri FilePath
path) Maybe Int32
forall a. Maybe a
Nothing ([Diagnostic] -> DiagnosticsBySource
partitionBySource [FilePath -> Diagnostic
diagnosticOfParseError FilePath
err])

          -- TODO: collect all errors for one file in one list

          -- Report typechecking errors to the client
          [TypeErrorInScopedContext VarIdent]
-> (TypeErrorInScopedContext VarIdent -> LSP ()) -> LSP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TypeErrorInScopedContext VarIdent]
typeErrors ((TypeErrorInScopedContext VarIdent -> LSP ()) -> LSP ())
-> (TypeErrorInScopedContext VarIdent -> LSP ()) -> LSP ()
forall a b. (a -> b) -> a -> b
$ \TypeErrorInScopedContext VarIdent
err -> do
            let errPath :: FilePath
errPath = TypeErrorInScopedContext VarIdent -> FilePath
forall var. TypeErrorInScopedContext var -> FilePath
filepathOfTypeError TypeErrorInScopedContext VarIdent
err
                errDiagnostic :: Diagnostic
errDiagnostic = TypeErrorInScopedContext VarIdent -> Diagnostic
diagnosticOfTypeError TypeErrorInScopedContext VarIdent
err
            Int
-> NormalizedUri -> Maybe Int32 -> DiagnosticsBySource -> LSP ()
forall config (m :: * -> *).
MonadLsp config m =>
Int -> NormalizedUri -> Maybe Int32 -> DiagnosticsBySource -> m ()
publishDiagnostics Int
maxDiagnosticCount (FilePath -> NormalizedUri
filePathToNormalizedUri FilePath
errPath) Maybe Int32
forall a. Maybe a
Nothing ([Diagnostic] -> DiagnosticsBySource
partitionBySource [Diagnostic
errDiagnostic])
  where
    filepathOfTypeError :: TypeErrorInScopedContext var -> FilePath
    filepathOfTypeError :: forall var. TypeErrorInScopedContext var -> FilePath
filepathOfTypeError (PlainTypeError TypeErrorInContext var
err) =
      case Context var -> Maybe LocationInfo
forall var. Context var -> Maybe LocationInfo
location (TypeErrorInContext var -> Context var
forall var. TypeErrorInContext var -> Context var
typeErrorContext TypeErrorInContext var
err) Maybe LocationInfo
-> (LocationInfo -> Maybe FilePath) -> Maybe FilePath
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LocationInfo -> Maybe FilePath
locationFilePath of
        Just FilePath
path -> FilePath
path
        Maybe FilePath
_         -> FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error FilePath
"the impossible happened! Please contact Abdelrahman immediately!!!"
    filepathOfTypeError (ScopedTypeError Maybe VarIdent
_orig TypeErrorInScopedContext (Inc var)
err) = TypeErrorInScopedContext (Inc var) -> FilePath
forall var. TypeErrorInScopedContext var -> FilePath
filepathOfTypeError TypeErrorInScopedContext (Inc var)
err

    diagnosticOfTypeError :: TypeErrorInScopedContext VarIdent -> Diagnostic
    diagnosticOfTypeError :: TypeErrorInScopedContext VarIdent -> Diagnostic
diagnosticOfTypeError TypeErrorInScopedContext VarIdent
err = Range
-> Maybe DiagnosticSeverity
-> Maybe (Int32 |? Text)
-> Maybe CodeDescription
-> Maybe Text
-> Text
-> Maybe [DiagnosticTag]
-> Maybe [DiagnosticRelatedInformation]
-> Maybe Value
-> Diagnostic
Diagnostic
                      (Position -> Position -> Range
Range (UInt -> UInt -> Position
Position UInt
line UInt
0) (UInt -> UInt -> Position
Position UInt
line UInt
99)) -- 99 to reach end of line and be visible until we actually have information about it
                      (DiagnosticSeverity -> Maybe DiagnosticSeverity
forall a. a -> Maybe a
Just DiagnosticSeverity
DiagnosticSeverity_Error)
                      ((Int32 |? Text) -> Maybe (Int32 |? Text)
forall a. a -> Maybe a
Just ((Int32 |? Text) -> Maybe (Int32 |? Text))
-> (Int32 |? Text) -> Maybe (Int32 |? Text)
forall a b. (a -> b) -> a -> b
$ Text -> Int32 |? Text
forall a b. b -> a |? b
InR Text
"type-error") -- diagnostic code
                      Maybe CodeDescription
forall a. Maybe a
Nothing                   -- diagonstic description
                      (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"rzk")              -- A human-readable string describing the source of this diagnostic
                      (FilePath -> Text
T.pack FilePath
msg)
                      Maybe [DiagnosticTag]
forall a. Maybe a
Nothing                   -- tags
                      ([DiagnosticRelatedInformation]
-> Maybe [DiagnosticRelatedInformation]
forall a. a -> Maybe a
Just [])                 -- related information
                      Maybe Value
forall a. Maybe a
Nothing                   -- data that is preserved between different calls
      where
        msg :: FilePath
msg = OutputDirection -> TypeErrorInScopedContext VarIdent -> FilePath
ppTypeErrorInScopedContext' OutputDirection
TopDown TypeErrorInScopedContext VarIdent
err

        extractLineNumber :: TypeErrorInScopedContext var -> Maybe Int
        extractLineNumber :: forall var. TypeErrorInScopedContext var -> Maybe Int
extractLineNumber (PlainTypeError TypeErrorInContext var
e)    = do
          LocationInfo
loc <- Context var -> Maybe LocationInfo
forall var. Context var -> Maybe LocationInfo
location (TypeErrorInContext var -> Context var
forall var. TypeErrorInContext var -> Context var
typeErrorContext TypeErrorInContext var
e)
          Int
lineNo <- LocationInfo -> Maybe Int
locationLine LocationInfo
loc
          Int -> Maybe Int
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
lineNo Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) -- VS Code indexes lines from 0, but locationLine starts with 1
        extractLineNumber (ScopedTypeError Maybe VarIdent
_ TypeErrorInScopedContext (Inc var)
e) = TypeErrorInScopedContext (Inc var) -> Maybe Int
forall var. TypeErrorInScopedContext var -> Maybe Int
extractLineNumber TypeErrorInScopedContext (Inc var)
e

        line :: UInt
line = Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ TypeErrorInScopedContext VarIdent -> Maybe Int
forall var. TypeErrorInScopedContext var -> Maybe Int
extractLineNumber TypeErrorInScopedContext VarIdent
err

    diagnosticOfParseError :: String -> Diagnostic
    diagnosticOfParseError :: FilePath -> Diagnostic
diagnosticOfParseError FilePath
err = Range
-> Maybe DiagnosticSeverity
-> Maybe (Int32 |? Text)
-> Maybe CodeDescription
-> Maybe Text
-> Text
-> Maybe [DiagnosticTag]
-> Maybe [DiagnosticRelatedInformation]
-> Maybe Value
-> Diagnostic
Diagnostic (Position -> Position -> Range
Range (UInt -> UInt -> Position
Position UInt
errLine UInt
errColumnStart) (UInt -> UInt -> Position
Position UInt
errLine UInt
errColumnEnd))
                      (DiagnosticSeverity -> Maybe DiagnosticSeverity
forall a. a -> Maybe a
Just DiagnosticSeverity
DiagnosticSeverity_Error)
                      ((Int32 |? Text) -> Maybe (Int32 |? Text)
forall a. a -> Maybe a
Just ((Int32 |? Text) -> Maybe (Int32 |? Text))
-> (Int32 |? Text) -> Maybe (Int32 |? Text)
forall a b. (a -> b) -> a -> b
$ Text -> Int32 |? Text
forall a b. b -> a |? b
InR Text
"parse-error")
                      Maybe CodeDescription
forall a. Maybe a
Nothing
                      (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"rzk")
                      (FilePath -> Text
T.pack FilePath
err)
                      Maybe [DiagnosticTag]
forall a. Maybe a
Nothing
                      ([DiagnosticRelatedInformation]
-> Maybe [DiagnosticRelatedInformation]
forall a. a -> Maybe a
Just [])
                      Maybe Value
forall a. Maybe a
Nothing
      where
        (UInt
errLine, UInt
errColumnStart, UInt
errColumnEnd) = (UInt, UInt, UInt)
-> Maybe (UInt, UInt, UInt) -> (UInt, UInt, UInt)
forall a. a -> Maybe a -> a
fromMaybe (UInt
0, UInt
0, UInt
0) (Maybe (UInt, UInt, UInt) -> (UInt, UInt, UInt))
-> Maybe (UInt, UInt, UInt) -> (UInt, UInt, UInt)
forall a b. (a -> b) -> a -> b
$
          case FilePath -> [FilePath]
words FilePath
err of
            -- Happy parse error
            (Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
take Int
9 -> [FilePath
"syntax", FilePath
"error", FilePath
"at", FilePath
"line", FilePath
lineStr, FilePath
"column", FilePath
columnStr, FilePath
"before", FilePath
token]) -> do
              UInt
line <- FilePath -> Maybe UInt
forall a. Read a => FilePath -> Maybe a
readMaybe ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isDigit FilePath
lineStr)
              UInt
columnStart <- FilePath -> Maybe UInt
forall a. Read a => FilePath -> Maybe a
readMaybe ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isDigit FilePath
columnStr)
              (UInt, UInt, UInt) -> Maybe (UInt, UInt, UInt)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (UInt
line UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
1, UInt
columnStart UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
1, UInt
columnStart UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
+ Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
token) UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
3)
            -- Happy parse error due to lexer error
            (Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
take Int
7 -> [FilePath
"syntax", FilePath
"error", FilePath
"at", FilePath
"line", FilePath
lineStr, FilePath
"column", FilePath
columnStr]) -> do
              UInt
line <- FilePath -> Maybe UInt
forall a. Read a => FilePath -> Maybe a
readMaybe ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isDigit FilePath
lineStr)
              UInt
columnStart <- FilePath -> Maybe UInt
forall a. Read a => FilePath -> Maybe a
readMaybe ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isDigit FilePath
columnStr)
              (UInt, UInt, UInt) -> Maybe (UInt, UInt, UInt)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (UInt
line UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
1, UInt
columnStart UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
1, UInt
columnStart UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
1)
            -- BNFC layout resolver error
            (Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
take Int
14 -> [FilePath
"Layout", FilePath
"error", FilePath
"at", FilePath
"line", FilePath
_lineStr, FilePath
"column", FilePath
_columnStr, FilePath
"found", FilePath
token, FilePath
"at", FilePath
"line", FilePath
lineStr', FilePath
"column", FilePath
columnStr']) -> do
              -- line <- readMaybe (takeWhile isDigit lineStr)
              -- columnStart <- readMaybe (takeWhile isDigit columnStr)
              UInt
line' <- FilePath -> Maybe UInt
forall a. Read a => FilePath -> Maybe a
readMaybe ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isDigit FilePath
lineStr')
              UInt
columnStart' <- FilePath -> Maybe UInt
forall a. Read a => FilePath -> Maybe a
readMaybe ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isDigit FilePath
columnStr')
              (UInt, UInt, UInt) -> Maybe (UInt, UInt, UInt)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (UInt
line' UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
1, UInt
columnStart', UInt
columnStart' UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
+ Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
token) UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
2)
            [FilePath]
_ -> Maybe (UInt, UInt, UInt)
forall a. Maybe a
Nothing

instance Default T.Text where def :: Text
def = Text
""
instance Default CompletionItem
instance Default CompletionItemLabelDetails

provideCompletions :: Handler LSP 'Method_TextDocumentCompletion
provideCompletions :: Handler
  (LspT ServerConfig (ReaderT RzkEnv IO))
  'Method_TextDocumentCompletion
provideCompletions TRequestMessage 'Method_TextDocumentCompletion
req Either
  (TResponseError 'Method_TextDocumentCompletion)
  ([CompletionItem] |? (CompletionList |? Null))
-> LSP ()
res = do
  FilePath -> LSP ()
forall c (m :: * -> *). MonadLsp c m => FilePath -> m ()
logInfo FilePath
"Providing text completions"
  Maybe FilePath
root <- LspT ServerConfig (ReaderT RzkEnv IO) (Maybe FilePath)
forall config (m :: * -> *).
MonadLsp config m =>
m (Maybe FilePath)
getRootPath
  Bool -> LSP () -> LSP ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isNothing Maybe FilePath
root) (LSP () -> LSP ()) -> LSP () -> LSP ()
forall a b. (a -> b) -> a -> b
$ FilePath -> LSP ()
forall c (m :: * -> *). MonadLsp c m => FilePath -> m ()
logDebug FilePath
"Not in a workspace. Cannot find root path for relative paths"
  let rootDir :: FilePath
rootDir = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"/" Maybe FilePath
root
  RzkTypecheckCache
cachedModules <- LSP RzkTypecheckCache
getCachedTypecheckedModules
  FilePath -> LSP ()
forall c (m :: * -> *). MonadLsp c m => FilePath -> m ()
logDebug (FilePath
"Found " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (RzkTypecheckCache -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length RzkTypecheckCache
cachedModules) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" modules in the cache")
  let currentFile :: FilePath
currentFile = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"" (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Uri -> Maybe FilePath
uriToFilePath (Uri -> Maybe FilePath) -> Uri -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ TRequestMessage 'Method_TextDocumentCompletion
req TRequestMessage 'Method_TextDocumentCompletion
-> Getting Uri (TRequestMessage 'Method_TextDocumentCompletion) Uri
-> Uri
forall s a. s -> Getting a s a -> a
^. (CompletionParams -> Const Uri CompletionParams)
-> TRequestMessage 'Method_TextDocumentCompletion
-> Const Uri (TRequestMessage 'Method_TextDocumentCompletion)
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_TextDocumentCompletion) CompletionParams
params ((CompletionParams -> Const Uri CompletionParams)
 -> TRequestMessage 'Method_TextDocumentCompletion
 -> Const Uri (TRequestMessage 'Method_TextDocumentCompletion))
-> ((Uri -> Const Uri Uri)
    -> CompletionParams -> Const Uri CompletionParams)
-> Getting Uri (TRequestMessage 'Method_TextDocumentCompletion) Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> CompletionParams -> Const Uri CompletionParams
forall s a. HasTextDocument s a => Lens' s a
Lens' CompletionParams TextDocumentIdentifier
textDocument ((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
 -> CompletionParams -> Const Uri CompletionParams)
-> ((Uri -> Const Uri Uri)
    -> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> (Uri -> Const Uri Uri)
-> CompletionParams
-> Const Uri CompletionParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const Uri Uri)
-> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
uri
  -- Take all the modules up to and including the currently open one
  let modules :: [(FilePath, [Decl'])]
modules = ((FilePath, RzkCachedModule) -> (FilePath, [Decl']))
-> RzkTypecheckCache -> [(FilePath, [Decl'])]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, RzkCachedModule) -> (FilePath, [Decl'])
forall {a}. (a, RzkCachedModule) -> (a, [Decl'])
ignoreErrors (RzkTypecheckCache -> [(FilePath, [Decl'])])
-> RzkTypecheckCache -> [(FilePath, [Decl'])]
forall a b. (a -> b) -> a -> b
$ ((FilePath, RzkCachedModule) -> Bool)
-> RzkTypecheckCache -> RzkTypecheckCache
forall a. (a -> Bool) -> [a] -> [a]
takeWhileInc ((FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
currentFile) (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) RzkTypecheckCache
cachedModules
        where
          ignoreErrors :: (a, RzkCachedModule) -> (a, [Decl'])
ignoreErrors (a
path, RzkCachedModule{[TypeErrorInScopedContext VarIdent]
[Decl']
cachedModuleErrors :: RzkCachedModule -> [TypeErrorInScopedContext VarIdent]
cachedModuleDecls :: RzkCachedModule -> [Decl']
cachedModuleDecls :: [Decl']
cachedModuleErrors :: [TypeErrorInScopedContext VarIdent]
..}) = (a
path, [Decl']
cachedModuleDecls)
          takeWhileInc :: (a -> Bool) -> [a] -> [a]
takeWhileInc a -> Bool
_ [] = []
          takeWhileInc a -> Bool
p (a
x:[a]
xs)
            | a -> Bool
p a
x       = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> Bool) -> [a] -> [a]
takeWhileInc a -> Bool
p [a]
xs
            | Bool
otherwise = [a
x]

  let items :: [CompletionItem]
items = ((FilePath, [Decl']) -> [CompletionItem])
-> [(FilePath, [Decl'])] -> [CompletionItem]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (FilePath -> (FilePath, [Decl']) -> [CompletionItem]
declsToItems FilePath
rootDir) [(FilePath, [Decl'])]
modules
  FilePath -> LSP ()
forall c (m :: * -> *). MonadLsp c m => FilePath -> m ()
logDebug (FilePath
"Sending " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show ([CompletionItem] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CompletionItem]
items) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" completion items")
  Either
  (TResponseError 'Method_TextDocumentCompletion)
  ([CompletionItem] |? (CompletionList |? Null))
-> LSP ()
res (Either
   (TResponseError 'Method_TextDocumentCompletion)
   ([CompletionItem] |? (CompletionList |? Null))
 -> LSP ())
-> Either
     (TResponseError 'Method_TextDocumentCompletion)
     ([CompletionItem] |? (CompletionList |? Null))
-> LSP ()
forall a b. (a -> b) -> a -> b
$ ([CompletionItem] |? (CompletionList |? Null))
-> Either
     (TResponseError 'Method_TextDocumentCompletion)
     ([CompletionItem] |? (CompletionList |? Null))
forall a b. b -> Either a b
Right (([CompletionItem] |? (CompletionList |? Null))
 -> Either
      (TResponseError 'Method_TextDocumentCompletion)
      ([CompletionItem] |? (CompletionList |? Null)))
-> ([CompletionItem] |? (CompletionList |? Null))
-> Either
     (TResponseError 'Method_TextDocumentCompletion)
     ([CompletionItem] |? (CompletionList |? Null))
forall a b. (a -> b) -> a -> b
$ [CompletionItem] -> [CompletionItem] |? (CompletionList |? Null)
forall a b. a -> a |? b
InL [CompletionItem]
items
  where
    declsToItems :: FilePath -> (FilePath, [Decl']) -> [CompletionItem]
    declsToItems :: FilePath -> (FilePath, [Decl']) -> [CompletionItem]
declsToItems FilePath
root (FilePath
path, [Decl']
decls) = (Decl' -> CompletionItem) -> [Decl'] -> [CompletionItem]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> Decl' -> CompletionItem
declToItem FilePath
root FilePath
path) [Decl']
decls
    declToItem :: FilePath -> FilePath -> Decl' -> CompletionItem
    declToItem :: FilePath -> FilePath -> Decl' -> CompletionItem
declToItem FilePath
rootDir FilePath
path (Decl VarIdent
name TermT VarIdent
type' Maybe (TermT VarIdent)
_ Bool
_ [VarIdent]
_ Maybe LocationInfo
_loc) = CompletionItem
forall a. Default a => a
def
      CompletionItem
-> (CompletionItem -> CompletionItem) -> CompletionItem
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text)
-> CompletionItem -> Identity CompletionItem
forall s a. HasLabel s a => Lens' s a
Lens' CompletionItem Text
label ((Text -> Identity Text)
 -> CompletionItem -> Identity CompletionItem)
-> Text -> CompletionItem -> CompletionItem
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath -> Text
T.pack (VarIdent' RzkPosition -> FilePath
forall a. Print a => a -> FilePath
printTree (VarIdent' RzkPosition -> FilePath)
-> VarIdent' RzkPosition -> FilePath
forall a b. (a -> b) -> a -> b
$ VarIdent -> VarIdent' RzkPosition
getVarIdent VarIdent
name)
      CompletionItem
-> (CompletionItem -> CompletionItem) -> CompletionItem
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text))
-> CompletionItem -> Identity CompletionItem
forall s a. HasDetail s a => Lens' s a
Lens' CompletionItem (Maybe Text)
detail ((Maybe Text -> Identity (Maybe Text))
 -> CompletionItem -> Identity CompletionItem)
-> Text -> CompletionItem -> CompletionItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ FilePath -> Text
T.pack (TermT VarIdent -> FilePath
forall a. Show a => a -> FilePath
show TermT VarIdent
type')
      CompletionItem
-> (CompletionItem -> CompletionItem) -> CompletionItem
forall a b. a -> (a -> b) -> b
& (Maybe (Text |? MarkupContent)
 -> Identity (Maybe (Text |? MarkupContent)))
-> CompletionItem -> Identity CompletionItem
forall s a. HasDocumentation s a => Lens' s a
Lens' CompletionItem (Maybe (Text |? MarkupContent))
documentation ((Maybe (Text |? MarkupContent)
  -> Identity (Maybe (Text |? MarkupContent)))
 -> CompletionItem -> Identity CompletionItem)
-> (Text |? MarkupContent) -> CompletionItem -> CompletionItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ MarkupContent -> Text |? MarkupContent
forall a b. b -> a |? b
InR (MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MarkupKind_Markdown (Text -> MarkupContent) -> Text -> MarkupContent
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$
          FilePath
"---\nDefined" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
          (if Int
line Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then FilePath
" at line " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
line else FilePath
"")
          FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" in *" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath -> FilePath
makeRelative FilePath
rootDir FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"*")
      where
        (VarIdent RzkPosition
pos VarIdentToken
_) = VarIdent -> VarIdent' RzkPosition
getVarIdent VarIdent
name
        (RzkPosition Maybe FilePath
_path BNFC'Position
pos') = RzkPosition
pos
        line :: Int
line = Int -> ((Int, Int) -> Int) -> BNFC'Position -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> a
fst BNFC'Position
pos'
        _col :: Int
_col = Int -> ((Int, Int) -> Int) -> BNFC'Position -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> b
snd BNFC'Position
pos'

formattingEditToTextEdit :: FormattingEdit -> TextEdit
formattingEditToTextEdit :: FormattingEdit -> TextEdit
formattingEditToTextEdit (FormattingEdit Int
startLine Int
startCol Int
endLine Int
endCol FilePath
newText) =
  Range -> Text -> TextEdit
TextEdit
    (Position -> Position -> Range
Range
      (UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
startLine UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
1) (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
startCol UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
1))
      (UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
endLine UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
1) (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
endCol UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
1))
    )
    (FilePath -> Text
T.pack FilePath
newText)

formatDocument :: Handler LSP 'Method_TextDocumentFormatting
formatDocument :: Handler
  (LspT ServerConfig (ReaderT RzkEnv IO))
  'Method_TextDocumentFormatting
formatDocument TRequestMessage 'Method_TextDocumentFormatting
req Either
  (TResponseError 'Method_TextDocumentFormatting)
  ([TextEdit] |? Null)
-> LSP ()
res = do
  let doc :: NormalizedUri
doc = TRequestMessage 'Method_TextDocumentFormatting
req TRequestMessage 'Method_TextDocumentFormatting
-> Getting
     NormalizedUri
     (TRequestMessage 'Method_TextDocumentFormatting)
     NormalizedUri
-> NormalizedUri
forall s a. s -> Getting a s a -> a
^. (DocumentFormattingParams
 -> Const NormalizedUri DocumentFormattingParams)
-> TRequestMessage 'Method_TextDocumentFormatting
-> Const
     NormalizedUri (TRequestMessage 'Method_TextDocumentFormatting)
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_TextDocumentFormatting)
  DocumentFormattingParams
params ((DocumentFormattingParams
  -> Const NormalizedUri DocumentFormattingParams)
 -> TRequestMessage 'Method_TextDocumentFormatting
 -> Const
      NormalizedUri (TRequestMessage 'Method_TextDocumentFormatting))
-> ((NormalizedUri -> Const NormalizedUri NormalizedUri)
    -> DocumentFormattingParams
    -> Const NormalizedUri DocumentFormattingParams)
-> Getting
     NormalizedUri
     (TRequestMessage 'Method_TextDocumentFormatting)
     NormalizedUri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentIdentifier
 -> Const NormalizedUri TextDocumentIdentifier)
-> DocumentFormattingParams
-> Const NormalizedUri DocumentFormattingParams
forall s a. HasTextDocument s a => Lens' s a
Lens' DocumentFormattingParams TextDocumentIdentifier
textDocument ((TextDocumentIdentifier
  -> Const NormalizedUri TextDocumentIdentifier)
 -> DocumentFormattingParams
 -> Const NormalizedUri DocumentFormattingParams)
-> ((NormalizedUri -> Const NormalizedUri NormalizedUri)
    -> TextDocumentIdentifier
    -> Const NormalizedUri TextDocumentIdentifier)
-> (NormalizedUri -> Const NormalizedUri NormalizedUri)
-> DocumentFormattingParams
-> Const NormalizedUri DocumentFormattingParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const NormalizedUri Uri)
-> TextDocumentIdentifier
-> Const NormalizedUri TextDocumentIdentifier
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
uri ((Uri -> Const NormalizedUri Uri)
 -> TextDocumentIdentifier
 -> Const NormalizedUri TextDocumentIdentifier)
-> ((NormalizedUri -> Const NormalizedUri NormalizedUri)
    -> Uri -> Const NormalizedUri Uri)
-> (NormalizedUri -> Const NormalizedUri NormalizedUri)
-> TextDocumentIdentifier
-> Const NormalizedUri TextDocumentIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> NormalizedUri)
-> (NormalizedUri -> Const NormalizedUri NormalizedUri)
-> Uri
-> Const NormalizedUri Uri
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Uri -> NormalizedUri
toNormalizedUri
  FilePath -> LSP ()
forall c (m :: * -> *). MonadLsp c m => FilePath -> m ()
logInfo (FilePath -> LSP ()) -> FilePath -> LSP ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Formatting document: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> NormalizedUri -> FilePath
forall a. Show a => a -> FilePath
show NormalizedUri
doc
  ServerConfig {formatEnabled :: ServerConfig -> Bool
formatEnabled = Bool
fmtEnabled} <- LspT ServerConfig (ReaderT RzkEnv IO) ServerConfig
forall config (m :: * -> *). MonadLsp config m => m config
getConfig
  if Bool
fmtEnabled then do
    Maybe VirtualFile
mdoc <- NormalizedUri
-> LspT ServerConfig (ReaderT RzkEnv IO) (Maybe VirtualFile)
forall config (m :: * -> *).
MonadLsp config m =>
NormalizedUri -> m (Maybe VirtualFile)
getVirtualFile NormalizedUri
doc
    Either Text [TextEdit]
possibleEdits <- case VirtualFile -> Text
virtualFileText (VirtualFile -> Text) -> Maybe VirtualFile -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe VirtualFile
mdoc of
      Maybe Text
Nothing         -> Either Text [TextEdit]
-> LspT ServerConfig (ReaderT RzkEnv IO) (Either Text [TextEdit])
forall a. a -> LspT ServerConfig (ReaderT RzkEnv IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text [TextEdit]
forall a b. a -> Either a b
Left Text
"Failed to get file contents")
      Just Text
sourceCode -> do
        let edits :: [FormattingEdit]
edits = FilePath -> [FormattingEdit]
formatTextEdits ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r') (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
sourceCode)
        Either Text [TextEdit]
-> LspT ServerConfig (ReaderT RzkEnv IO) (Either Text [TextEdit])
forall a. a -> LspT ServerConfig (ReaderT RzkEnv IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([TextEdit] -> Either Text [TextEdit]
forall a b. b -> Either a b
Right ([TextEdit] -> Either Text [TextEdit])
-> [TextEdit] -> Either Text [TextEdit]
forall a b. (a -> b) -> a -> b
$ (FormattingEdit -> TextEdit) -> [FormattingEdit] -> [TextEdit]
forall a b. (a -> b) -> [a] -> [b]
map FormattingEdit -> TextEdit
formattingEditToTextEdit [FormattingEdit]
edits)
    case Either Text [TextEdit]
possibleEdits of
#if MIN_VERSION_lsp(2,7,0)
      Left Text
err    -> Either
  (TResponseError 'Method_TextDocumentFormatting)
  ([TextEdit] |? Null)
-> LSP ()
res (Either
   (TResponseError 'Method_TextDocumentFormatting)
   ([TextEdit] |? Null)
 -> LSP ())
-> Either
     (TResponseError 'Method_TextDocumentFormatting)
     ([TextEdit] |? Null)
-> LSP ()
forall a b. (a -> b) -> a -> b
$ TResponseError 'Method_TextDocumentFormatting
-> Either
     (TResponseError 'Method_TextDocumentFormatting)
     ([TextEdit] |? Null)
forall a b. a -> Either a b
Left (TResponseError 'Method_TextDocumentFormatting
 -> Either
      (TResponseError 'Method_TextDocumentFormatting)
      ([TextEdit] |? Null))
-> TResponseError 'Method_TextDocumentFormatting
-> Either
     (TResponseError 'Method_TextDocumentFormatting)
     ([TextEdit] |? Null)
forall a b. (a -> b) -> a -> b
$ (LSPErrorCodes |? ErrorCodes)
-> Text
-> Maybe (ErrorData 'Method_TextDocumentFormatting)
-> TResponseError 'Method_TextDocumentFormatting
forall (f :: MessageDirection) (m :: Method f 'Request).
(LSPErrorCodes |? ErrorCodes)
-> Text -> Maybe (ErrorData m) -> TResponseError m
TResponseError (ErrorCodes -> LSPErrorCodes |? ErrorCodes
forall a b. b -> a |? b
InR ErrorCodes
ErrorCodes_InternalError) Text
err Maybe (ErrorData 'Method_TextDocumentFormatting)
forall a. Maybe a
Nothing
#else
      Left err    -> res $ Left $ ResponseError (InR ErrorCodes_InternalError) err Nothing
#endif
      Right [TextEdit]
edits -> do
        Either
  (TResponseError 'Method_TextDocumentFormatting)
  ([TextEdit] |? Null)
-> LSP ()
res (Either
   (TResponseError 'Method_TextDocumentFormatting)
   ([TextEdit] |? Null)
 -> LSP ())
-> Either
     (TResponseError 'Method_TextDocumentFormatting)
     ([TextEdit] |? Null)
-> LSP ()
forall a b. (a -> b) -> a -> b
$ ([TextEdit] |? Null)
-> Either
     (TResponseError 'Method_TextDocumentFormatting)
     ([TextEdit] |? Null)
forall a b. b -> Either a b
Right (([TextEdit] |? Null)
 -> Either
      (TResponseError 'Method_TextDocumentFormatting)
      ([TextEdit] |? Null))
-> ([TextEdit] |? Null)
-> Either
     (TResponseError 'Method_TextDocumentFormatting)
     ([TextEdit] |? Null)
forall a b. (a -> b) -> a -> b
$ [TextEdit] -> [TextEdit] |? Null
forall a b. a -> a |? b
InL [TextEdit]
edits
  else do
    FilePath -> LSP ()
forall c (m :: * -> *). MonadLsp c m => FilePath -> m ()
logDebug FilePath
"Formatting is disabled in config"
    Either
  (TResponseError 'Method_TextDocumentFormatting)
  ([TextEdit] |? Null)
-> LSP ()
res (Either
   (TResponseError 'Method_TextDocumentFormatting)
   ([TextEdit] |? Null)
 -> LSP ())
-> Either
     (TResponseError 'Method_TextDocumentFormatting)
     ([TextEdit] |? Null)
-> LSP ()
forall a b. (a -> b) -> a -> b
$ ([TextEdit] |? Null)
-> Either
     (TResponseError 'Method_TextDocumentFormatting)
     ([TextEdit] |? Null)
forall a b. b -> Either a b
Right (([TextEdit] |? Null)
 -> Either
      (TResponseError 'Method_TextDocumentFormatting)
      ([TextEdit] |? Null))
-> ([TextEdit] |? Null)
-> Either
     (TResponseError 'Method_TextDocumentFormatting)
     ([TextEdit] |? Null)
forall a b. (a -> b) -> a -> b
$ Null -> [TextEdit] |? Null
forall a b. b -> a |? b
InR Null
Null

provideSemanticTokens :: Handler LSP 'Method_TextDocumentSemanticTokensFull
provideSemanticTokens :: Handler
  (LspT ServerConfig (ReaderT RzkEnv IO))
  'Method_TextDocumentSemanticTokensFull
provideSemanticTokens TRequestMessage 'Method_TextDocumentSemanticTokensFull
req Either
  (TResponseError 'Method_TextDocumentSemanticTokensFull)
  (SemanticTokens |? Null)
-> LSP ()
responder = do
  let doc :: NormalizedUri
doc = TRequestMessage 'Method_TextDocumentSemanticTokensFull
req TRequestMessage 'Method_TextDocumentSemanticTokensFull
-> Getting
     NormalizedUri
     (TRequestMessage 'Method_TextDocumentSemanticTokensFull)
     NormalizedUri
-> NormalizedUri
forall s a. s -> Getting a s a -> a
^. (SemanticTokensParams -> Const NormalizedUri SemanticTokensParams)
-> TRequestMessage 'Method_TextDocumentSemanticTokensFull
-> Const
     NormalizedUri
     (TRequestMessage 'Method_TextDocumentSemanticTokensFull)
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_TextDocumentSemanticTokensFull)
  SemanticTokensParams
params ((SemanticTokensParams -> Const NormalizedUri SemanticTokensParams)
 -> TRequestMessage 'Method_TextDocumentSemanticTokensFull
 -> Const
      NormalizedUri
      (TRequestMessage 'Method_TextDocumentSemanticTokensFull))
-> ((NormalizedUri -> Const NormalizedUri NormalizedUri)
    -> SemanticTokensParams
    -> Const NormalizedUri SemanticTokensParams)
-> Getting
     NormalizedUri
     (TRequestMessage 'Method_TextDocumentSemanticTokensFull)
     NormalizedUri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentIdentifier
 -> Const NormalizedUri TextDocumentIdentifier)
-> SemanticTokensParams -> Const NormalizedUri SemanticTokensParams
forall s a. HasTextDocument s a => Lens' s a
Lens' SemanticTokensParams TextDocumentIdentifier
textDocument ((TextDocumentIdentifier
  -> Const NormalizedUri TextDocumentIdentifier)
 -> SemanticTokensParams
 -> Const NormalizedUri SemanticTokensParams)
-> ((NormalizedUri -> Const NormalizedUri NormalizedUri)
    -> TextDocumentIdentifier
    -> Const NormalizedUri TextDocumentIdentifier)
-> (NormalizedUri -> Const NormalizedUri NormalizedUri)
-> SemanticTokensParams
-> Const NormalizedUri SemanticTokensParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const NormalizedUri Uri)
-> TextDocumentIdentifier
-> Const NormalizedUri TextDocumentIdentifier
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
uri ((Uri -> Const NormalizedUri Uri)
 -> TextDocumentIdentifier
 -> Const NormalizedUri TextDocumentIdentifier)
-> ((NormalizedUri -> Const NormalizedUri NormalizedUri)
    -> Uri -> Const NormalizedUri Uri)
-> (NormalizedUri -> Const NormalizedUri NormalizedUri)
-> TextDocumentIdentifier
-> Const NormalizedUri TextDocumentIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> NormalizedUri)
-> (NormalizedUri -> Const NormalizedUri NormalizedUri)
-> Uri
-> Const NormalizedUri Uri
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Uri -> NormalizedUri
toNormalizedUri
  Maybe VirtualFile
mdoc <- NormalizedUri
-> LspT ServerConfig (ReaderT RzkEnv IO) (Maybe VirtualFile)
forall config (m :: * -> *).
MonadLsp config m =>
NormalizedUri -> m (Maybe VirtualFile)
getVirtualFile NormalizedUri
doc
  Either FilePath [SemanticTokenAbsolute]
possibleTokens <- case VirtualFile -> Text
virtualFileText (VirtualFile -> Text) -> Maybe VirtualFile -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe VirtualFile
mdoc of
    Maybe Text
Nothing         -> Either FilePath [SemanticTokenAbsolute]
-> LspT
     ServerConfig
     (ReaderT RzkEnv IO)
     (Either FilePath [SemanticTokenAbsolute])
forall a. a -> LspT ServerConfig (ReaderT RzkEnv IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Either FilePath [SemanticTokenAbsolute]
forall a b. a -> Either a b
Left FilePath
"Failed to get file content")
    Just Text
sourceCode -> (Either FilePath Module -> Either FilePath [SemanticTokenAbsolute])
-> LspT ServerConfig (ReaderT RzkEnv IO) (Either FilePath Module)
-> LspT
     ServerConfig
     (ReaderT RzkEnv IO)
     (Either FilePath [SemanticTokenAbsolute])
forall a b.
(a -> b)
-> LspT ServerConfig (ReaderT RzkEnv IO) a
-> LspT ServerConfig (ReaderT RzkEnv IO) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Module -> [SemanticTokenAbsolute])
-> Either FilePath Module
-> Either FilePath [SemanticTokenAbsolute]
forall a b. (a -> b) -> Either FilePath a -> Either FilePath b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Module -> [SemanticTokenAbsolute]
tokenizeModule) (LspT ServerConfig (ReaderT RzkEnv IO) (Either FilePath Module)
 -> LspT
      ServerConfig
      (ReaderT RzkEnv IO)
      (Either FilePath [SemanticTokenAbsolute]))
-> LspT ServerConfig (ReaderT RzkEnv IO) (Either FilePath Module)
-> LspT
     ServerConfig
     (ReaderT RzkEnv IO)
     (Either FilePath [SemanticTokenAbsolute])
forall a b. (a -> b) -> a -> b
$ IO (Either FilePath Module)
-> LspT ServerConfig (ReaderT RzkEnv IO) (Either FilePath Module)
forall a. IO a -> LspT ServerConfig (ReaderT RzkEnv IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either FilePath Module)
 -> LspT ServerConfig (ReaderT RzkEnv IO) (Either FilePath Module))
-> IO (Either FilePath Module)
-> LspT ServerConfig (ReaderT RzkEnv IO) (Either FilePath Module)
forall a b. (a -> b) -> a -> b
$
      FilePath -> IO (Either FilePath Module)
parseModuleSafe ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r') (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
sourceCode)
  case Either FilePath [SemanticTokenAbsolute]
possibleTokens of
    Left FilePath
err -> do
      -- Exception occurred when parsing the module
      FilePath -> LSP ()
forall c (m :: * -> *). MonadLsp c m => FilePath -> m ()
logWarning (FilePath
"Failed to tokenize file: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
err)
    Right [SemanticTokenAbsolute]
tokens -> do
      let encoded :: Either Text [UInt]
encoded = SemanticTokensLegend
-> [SemanticTokenRelative] -> Either Text [UInt]
encodeTokens SemanticTokensLegend
defaultSemanticTokensLegend ([SemanticTokenRelative] -> Either Text [UInt])
-> [SemanticTokenRelative] -> Either Text [UInt]
forall a b. (a -> b) -> a -> b
$ [SemanticTokenAbsolute] -> [SemanticTokenRelative]
relativizeTokens [SemanticTokenAbsolute]
tokens
      case Either Text [UInt]
encoded of
        Left Text
_err -> do
          -- Failed to encode the tokens
          () -> LSP ()
forall a. a -> LspT ServerConfig (ReaderT RzkEnv IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Right [UInt]
list ->
          Either
  (TResponseError 'Method_TextDocumentSemanticTokensFull)
  (SemanticTokens |? Null)
-> LSP ()
responder ((SemanticTokens |? Null)
-> Either
     (TResponseError 'Method_TextDocumentSemanticTokensFull)
     (SemanticTokens |? Null)
forall a b. b -> Either a b
Right (SemanticTokens -> SemanticTokens |? Null
forall a b. a -> a |? b
InL (Maybe Text -> [UInt] -> SemanticTokens
SemanticTokens Maybe Text
forall a. Maybe a
Nothing [UInt]
list)))


data IsChanged
  = HasChanged
  | NotChanged

-- | Detects if the given path has changes in its declaration compared to what's in the cache
isChanged :: RzkTypecheckCache -> FilePath -> LSP IsChanged
isChanged :: RzkTypecheckCache -> FilePath -> LSP IsChanged
isChanged RzkTypecheckCache
cache FilePath
path = ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) IsChanged
-> LSP IsChanged
forall {m :: * -> *} {e}.
Monad m =>
ExceptT e m IsChanged -> m IsChanged
toIsChanged (ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) IsChanged
 -> LSP IsChanged)
-> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) IsChanged
-> LSP IsChanged
forall a b. (a -> b) -> a -> b
$ do
  let cacheWithoutErrors :: [(FilePath, [Decl'])]
cacheWithoutErrors = ((FilePath, RzkCachedModule) -> (FilePath, [Decl']))
-> RzkTypecheckCache -> [(FilePath, [Decl'])]
forall a b. (a -> b) -> [a] -> [b]
map ((RzkCachedModule -> [Decl'])
-> (FilePath, RzkCachedModule) -> (FilePath, [Decl'])
forall a b. (a -> b) -> (FilePath, a) -> (FilePath, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RzkCachedModule -> [Decl']
cachedModuleDecls) RzkTypecheckCache
cache
  [TypeErrorInScopedContext VarIdent]
errors <- Maybe [TypeErrorInScopedContext VarIdent]
-> ExceptT
     ()
     (LspT ServerConfig (ReaderT RzkEnv IO))
     [TypeErrorInScopedContext VarIdent]
forall {a}.
Maybe a -> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) a
maybeToEitherLSP (Maybe [TypeErrorInScopedContext VarIdent]
 -> ExceptT
      ()
      (LspT ServerConfig (ReaderT RzkEnv IO))
      [TypeErrorInScopedContext VarIdent])
-> Maybe [TypeErrorInScopedContext VarIdent]
-> ExceptT
     ()
     (LspT ServerConfig (ReaderT RzkEnv IO))
     [TypeErrorInScopedContext VarIdent]
forall a b. (a -> b) -> a -> b
$ RzkCachedModule -> [TypeErrorInScopedContext VarIdent]
cachedModuleErrors (RzkCachedModule -> [TypeErrorInScopedContext VarIdent])
-> Maybe RzkCachedModule
-> Maybe [TypeErrorInScopedContext VarIdent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> RzkTypecheckCache -> Maybe RzkCachedModule
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
path RzkTypecheckCache
cache
  [Decl']
cachedDecls <- Maybe [Decl']
-> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) [Decl']
forall {a}.
Maybe a -> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) a
maybeToEitherLSP (Maybe [Decl']
 -> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) [Decl'])
-> Maybe [Decl']
-> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) [Decl']
forall a b. (a -> b) -> a -> b
$ RzkCachedModule -> [Decl']
cachedModuleDecls (RzkCachedModule -> [Decl'])
-> Maybe RzkCachedModule -> Maybe [Decl']
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> RzkTypecheckCache -> Maybe RzkCachedModule
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
path RzkTypecheckCache
cache
  Module
module' <- IO (Either FilePath Module)
-> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) Module
forall {e} {a}.
IO (Either e a)
-> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) a
toExceptTLifted (IO (Either FilePath Module)
 -> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) Module)
-> IO (Either FilePath Module)
-> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) Module
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Either FilePath Module)
parseModuleFile FilePath
path
  Either
  (TypeErrorInScopedContext VarIdent)
  ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])
e <- IO
  (Either
     SomeException
     (Either
        (TypeErrorInScopedContext VarIdent)
        ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])))
-> ExceptT
     ()
     (LspT ServerConfig (ReaderT RzkEnv IO))
     (Either
        (TypeErrorInScopedContext VarIdent)
        ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent]))
forall {e} {a}.
IO (Either e a)
-> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) a
toExceptTLifted (IO
   (Either
      SomeException
      (Either
         (TypeErrorInScopedContext VarIdent)
         ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])))
 -> ExceptT
      ()
      (LspT ServerConfig (ReaderT RzkEnv IO))
      (Either
         (TypeErrorInScopedContext VarIdent)
         ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])))
-> IO
     (Either
        SomeException
        (Either
           (TypeErrorInScopedContext VarIdent)
           ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])))
-> ExceptT
     ()
     (LspT ServerConfig (ReaderT RzkEnv IO))
     (Either
        (TypeErrorInScopedContext VarIdent)
        ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent]))
forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
try @SomeException (IO
   (Either
      (TypeErrorInScopedContext VarIdent)
      ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent]))
 -> IO
      (Either
         SomeException
         (Either
            (TypeErrorInScopedContext VarIdent)
            ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent]))))
-> IO
     (Either
        (TypeErrorInScopedContext VarIdent)
        ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent]))
-> IO
     (Either
        SomeException
        (Either
           (TypeErrorInScopedContext VarIdent)
           ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])))
forall a b. (a -> b) -> a -> b
$ Either
  (TypeErrorInScopedContext VarIdent)
  ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])
-> IO
     (Either
        (TypeErrorInScopedContext VarIdent)
        ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent]))
forall a. a -> IO a
evaluate (Either
   (TypeErrorInScopedContext VarIdent)
   ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])
 -> IO
      (Either
         (TypeErrorInScopedContext VarIdent)
         ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])))
-> Either
     (TypeErrorInScopedContext VarIdent)
     ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])
-> IO
     (Either
        (TypeErrorInScopedContext VarIdent)
        ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent]))
forall a b. (a -> b) -> a -> b
$
    TypeCheck
  VarIdent
  ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])
-> Either
     (TypeErrorInScopedContext VarIdent)
     ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])
forall var a.
TypeCheck var a -> Either (TypeErrorInScopedContext var) a
defaultTypeCheck ([(FilePath, [Decl'])]
-> [(FilePath, Module)]
-> TypeCheck
     VarIdent
     ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])
typecheckModulesWithLocationIncremental (((FilePath, [Decl']) -> Bool)
-> [(FilePath, [Decl'])] -> [(FilePath, [Decl'])]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
path) (FilePath -> Bool)
-> ((FilePath, [Decl']) -> FilePath) -> (FilePath, [Decl']) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, [Decl']) -> FilePath
forall a b. (a, b) -> a
fst) [(FilePath, [Decl'])]
cacheWithoutErrors) [(FilePath
path, Module
module')])
  ([(FilePath, [Decl'])]
checkedModules, [TypeErrorInScopedContext VarIdent]
errors') <- ExceptT
  ()
  (LspT ServerConfig (ReaderT RzkEnv IO))
  (Either
     (TypeErrorInScopedContext VarIdent)
     ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent]))
-> ExceptT
     ()
     (LspT ServerConfig (ReaderT RzkEnv IO))
     ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])
forall {e} {a}.
ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) (Either e a)
-> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) a
toExceptT (ExceptT
   ()
   (LspT ServerConfig (ReaderT RzkEnv IO))
   (Either
      (TypeErrorInScopedContext VarIdent)
      ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent]))
 -> ExceptT
      ()
      (LspT ServerConfig (ReaderT RzkEnv IO))
      ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent]))
-> ExceptT
     ()
     (LspT ServerConfig (ReaderT RzkEnv IO))
     (Either
        (TypeErrorInScopedContext VarIdent)
        ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent]))
-> ExceptT
     ()
     (LspT ServerConfig (ReaderT RzkEnv IO))
     ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])
forall a b. (a -> b) -> a -> b
$ Either
  (TypeErrorInScopedContext VarIdent)
  ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])
-> ExceptT
     ()
     (LspT ServerConfig (ReaderT RzkEnv IO))
     (Either
        (TypeErrorInScopedContext VarIdent)
        ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent]))
forall a. a -> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Either
  (TypeErrorInScopedContext VarIdent)
  ([(FilePath, [Decl'])], [TypeErrorInScopedContext VarIdent])
e
  [Decl']
decls' <- Maybe [Decl']
-> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) [Decl']
forall {a}.
Maybe a -> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) a
maybeToEitherLSP (Maybe [Decl']
 -> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) [Decl'])
-> Maybe [Decl']
-> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) [Decl']
forall a b. (a -> b) -> a -> b
$ FilePath -> [(FilePath, [Decl'])] -> Maybe [Decl']
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
path [(FilePath, [Decl'])]
checkedModules
  IsChanged
-> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) IsChanged
forall a. a -> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IsChanged
 -> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) IsChanged)
-> IsChanged
-> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) IsChanged
forall a b. (a -> b) -> a -> b
$ if [TypeErrorInScopedContext VarIdent] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeErrorInScopedContext VarIdent]
errors' Bool -> Bool -> Bool
&& [TypeErrorInScopedContext VarIdent] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeErrorInScopedContext VarIdent]
errors Bool -> Bool -> Bool
&& [Decl']
decls' [Decl'] -> [Decl'] -> Bool
forall a. Eq a => a -> a -> Bool
== [Decl']
cachedDecls
    then IsChanged
NotChanged
    else IsChanged
HasChanged
  where
    toExceptT :: ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) (Either e a)
-> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) a
toExceptT = (e -> ())
-> ExceptT e (ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO))) a
-> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) a
forall e' (m :: * -> *) e a.
MonadError e' m =>
(e -> e') -> ExceptT e m a -> m a
modifyError (() -> e -> ()
forall a b. a -> b -> a
const ()) (ExceptT e (ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO))) a
 -> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) a)
-> (ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) (Either e a)
    -> ExceptT
         e (ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO))) a)
-> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) (Either e a)
-> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) (Either e a)
-> ExceptT e (ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO))) a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT
    toExceptTLifted :: IO (Either e a)
-> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) a
toExceptTLifted = ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) (Either e a)
-> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) a
forall {e} {a}.
ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) (Either e a)
-> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) a
toExceptT (ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) (Either e a)
 -> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) a)
-> (IO (Either e a)
    -> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) (Either e a))
-> IO (Either e a)
-> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either e a)
-> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) (Either e a)
forall a.
IO a -> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    maybeToEitherLSP :: Maybe a -> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) a
maybeToEitherLSP = \case
      Maybe a
Nothing -> () -> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) a
forall a.
() -> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ()
      Just a
x -> a -> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) a
forall a. a -> ExceptT () (LspT ServerConfig (ReaderT RzkEnv IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
    toIsChanged :: ExceptT e m IsChanged -> m IsChanged
toIsChanged ExceptT e m IsChanged
m = ExceptT e m IsChanged -> m (Either e IsChanged)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e m IsChanged
m m (Either e IsChanged)
-> (Either e IsChanged -> m IsChanged) -> m IsChanged
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left e
_ -> IsChanged -> m IsChanged
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return IsChanged
HasChanged -- in case of error consider the file has changed
      Right IsChanged
x -> IsChanged -> m IsChanged
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return IsChanged
x

hasNotChanged :: RzkTypecheckCache -> FilePath -> LSP Bool
hasNotChanged :: RzkTypecheckCache -> FilePath -> LSP Bool
hasNotChanged RzkTypecheckCache
cache FilePath
path = RzkTypecheckCache -> FilePath -> LSP IsChanged
isChanged RzkTypecheckCache
cache FilePath
path LSP IsChanged -> (IsChanged -> LSP Bool) -> LSP Bool
forall a b.
LspT ServerConfig (ReaderT RzkEnv IO) a
-> (a -> LspT ServerConfig (ReaderT RzkEnv IO) b)
-> LspT ServerConfig (ReaderT RzkEnv IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  IsChanged
HasChanged -> Bool -> LSP Bool
forall a. a -> LspT ServerConfig (ReaderT RzkEnv IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  IsChanged
NotChanged -> Bool -> LSP Bool
forall a. a -> LspT ServerConfig (ReaderT RzkEnv IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

-- | Monadic 'dropWhile'
dropWhileM :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
dropWhileM :: forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m [a]
dropWhileM a -> m Bool
_ []     = [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
dropWhileM a -> m Bool
p (a
x:[a]
xs) = do
  Bool
q <- a -> m Bool
p a
x
  if Bool
q
    then (a -> m Bool) -> [a] -> m [a]
forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m [a]
dropWhileM a -> m Bool
p [a]
xs
    else [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)

handleFilesChanged :: Handler LSP 'Method_WorkspaceDidChangeWatchedFiles
handleFilesChanged :: Handler
  (LspT ServerConfig (ReaderT RzkEnv IO))
  'Method_WorkspaceDidChangeWatchedFiles
handleFilesChanged TNotificationMessage 'Method_WorkspaceDidChangeWatchedFiles
msg = do
  let modifiedPaths :: [FilePath]
modifiedPaths = TNotificationMessage 'Method_WorkspaceDidChangeWatchedFiles
msg TNotificationMessage 'Method_WorkspaceDidChangeWatchedFiles
-> Getting
     (Endo [FilePath])
     (TNotificationMessage 'Method_WorkspaceDidChangeWatchedFiles)
     FilePath
-> [FilePath]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (DidChangeWatchedFilesParams
 -> Const (Endo [FilePath]) DidChangeWatchedFilesParams)
-> TNotificationMessage 'Method_WorkspaceDidChangeWatchedFiles
-> Const
     (Endo [FilePath])
     (TNotificationMessage 'Method_WorkspaceDidChangeWatchedFiles)
forall s a. HasParams s a => Lens' s a
Lens'
  (TNotificationMessage 'Method_WorkspaceDidChangeWatchedFiles)
  DidChangeWatchedFilesParams
params ((DidChangeWatchedFilesParams
  -> Const (Endo [FilePath]) DidChangeWatchedFilesParams)
 -> TNotificationMessage 'Method_WorkspaceDidChangeWatchedFiles
 -> Const
      (Endo [FilePath])
      (TNotificationMessage 'Method_WorkspaceDidChangeWatchedFiles))
-> ((FilePath -> Const (Endo [FilePath]) FilePath)
    -> DidChangeWatchedFilesParams
    -> Const (Endo [FilePath]) DidChangeWatchedFilesParams)
-> Getting
     (Endo [FilePath])
     (TNotificationMessage 'Method_WorkspaceDidChangeWatchedFiles)
     FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FileEvent] -> Const (Endo [FilePath]) [FileEvent])
-> DidChangeWatchedFilesParams
-> Const (Endo [FilePath]) DidChangeWatchedFilesParams
forall s a. HasChanges s a => Lens' s a
Lens' DidChangeWatchedFilesParams [FileEvent]
changes (([FileEvent] -> Const (Endo [FilePath]) [FileEvent])
 -> DidChangeWatchedFilesParams
 -> Const (Endo [FilePath]) DidChangeWatchedFilesParams)
-> ((FilePath -> Const (Endo [FilePath]) FilePath)
    -> [FileEvent] -> Const (Endo [FilePath]) [FileEvent])
-> (FilePath -> Const (Endo [FilePath]) FilePath)
-> DidChangeWatchedFilesParams
-> Const (Endo [FilePath]) DidChangeWatchedFilesParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileEvent -> Const (Endo [FilePath]) FileEvent)
-> [FileEvent] -> Const (Endo [FilePath]) [FileEvent]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((FileEvent -> Const (Endo [FilePath]) FileEvent)
 -> [FileEvent] -> Const (Endo [FilePath]) [FileEvent])
-> ((FilePath -> Const (Endo [FilePath]) FilePath)
    -> FileEvent -> Const (Endo [FilePath]) FileEvent)
-> (FilePath -> Const (Endo [FilePath]) FilePath)
-> [FileEvent]
-> Const (Endo [FilePath]) [FileEvent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const (Endo [FilePath]) Uri)
-> FileEvent -> Const (Endo [FilePath]) FileEvent
forall s a. HasUri s a => Lens' s a
Lens' FileEvent Uri
uri ((Uri -> Const (Endo [FilePath]) Uri)
 -> FileEvent -> Const (Endo [FilePath]) FileEvent)
-> ((FilePath -> Const (Endo [FilePath]) FilePath)
    -> Uri -> Const (Endo [FilePath]) Uri)
-> (FilePath -> Const (Endo [FilePath]) FilePath)
-> FileEvent
-> Const (Endo [FilePath]) FileEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Maybe FilePath)
-> (Maybe FilePath -> Const (Endo [FilePath]) (Maybe FilePath))
-> Uri
-> Const (Endo [FilePath]) Uri
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Uri -> Maybe FilePath
uriToFilePath ((Maybe FilePath -> Const (Endo [FilePath]) (Maybe FilePath))
 -> Uri -> Const (Endo [FilePath]) Uri)
-> ((FilePath -> Const (Endo [FilePath]) FilePath)
    -> Maybe FilePath -> Const (Endo [FilePath]) (Maybe FilePath))
-> (FilePath -> Const (Endo [FilePath]) FilePath)
-> Uri
-> Const (Endo [FilePath]) Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Const (Endo [FilePath]) FilePath)
-> Maybe FilePath -> Const (Endo [FilePath]) (Maybe FilePath)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just
  if (FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FilePath
"rzk.yaml" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`) [FilePath]
modifiedPaths
    then do
      FilePath -> LSP ()
forall c (m :: * -> *). MonadLsp c m => FilePath -> m ()
logDebug FilePath
"rzk.yaml modified. Clearing module cache"
      LSP ()
resetCacheForAllFiles
    else do
      RzkTypecheckCache
cache <- LSP RzkTypecheckCache
getCachedTypecheckedModules
      [FilePath]
actualModified <- (FilePath -> LSP Bool)
-> [FilePath] -> LspT ServerConfig (ReaderT RzkEnv IO) [FilePath]
forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m [a]
dropWhileM (RzkTypecheckCache -> FilePath -> LSP Bool
hasNotChanged RzkTypecheckCache
cache) [FilePath]
modifiedPaths
      [FilePath] -> LSP ()
resetCacheForFiles [FilePath]
actualModified
  LSP ()
typecheckFromConfigFile