{-# LANGUAGE RecordWildCards #-}

module Unison.LSP.FileAnalysis where

import Control.Lens
import Control.Monad.Reader
import Crypto.Random qualified as Random
import Data.Align (alignWith)
import Data.Foldable
import Data.IntervalMap.Lazy (IntervalMap)
import Data.IntervalMap.Lazy qualified as IM
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as Text
import Data.These
import Data.Zip qualified as Zip
import Language.LSP.Protocol.Lens (HasCodeAction (codeAction), HasIsPreferred (isPreferred), HasRange (range), HasUri (uri))
import Language.LSP.Protocol.Lens qualified as LSPTypes
import Language.LSP.Protocol.Types
  ( Diagnostic,
    Position,
    Range,
    TextDocumentIdentifier (TextDocumentIdentifier),
    Uri (getUri),
  )
import Unison.ABT qualified as ABT
import Unison.Cli.TypeCheck (computeTypecheckingEnvironment)
import Unison.Cli.UniqueTypeGuidLookup qualified as Cli
import Unison.Codebase qualified as Codebase
import Unison.DataDeclaration qualified as DD
import Unison.Debug qualified as Debug
import Unison.FileParsers (ShouldUseTndr (..))
import Unison.FileParsers qualified as FileParsers
import Unison.KindInference.Error qualified as KindInference
import Unison.LSP.Conversions
import Unison.LSP.Conversions qualified as Cv
import Unison.LSP.Diagnostics (DiagnosticSeverity (..), mkDiagnostic, reportDiagnostics)
import Unison.LSP.FileAnalysis.UnusedBindings qualified as UnusedBindings
import Unison.LSP.Orphans ()
import Unison.LSP.Types
import Unison.LSP.VFS qualified as VFS
import Unison.Name (Name)
import Unison.Names (Names)
import Unison.Names qualified as Names
import Unison.Parser.Ann (Ann)
import Unison.Parsers qualified as Parsers
import Unison.Pattern qualified as Pattern
import Unison.Prelude
import Unison.PrettyPrintEnv (PrettyPrintEnv)
import Unison.PrettyPrintEnv qualified as PPE
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.PrettyPrintEnvDecl qualified as PPED
import Unison.PrettyPrintEnvDecl.Names qualified as PPED
import Unison.PrintError qualified as PrintError
import Unison.Referent qualified as Referent
import Unison.Result (Note)
import Unison.Result qualified as Result
import Unison.Symbol (Symbol)
import Unison.Syntax.HashQualifiedPrime qualified as HQ' (toText)
import Unison.Syntax.Lexer.Unison qualified as L
import Unison.Syntax.Name qualified as Name
import Unison.Syntax.Parser qualified as Parser
import Unison.Syntax.TypePrinter qualified as TypePrinter
import Unison.Term qualified as Term
import Unison.Typechecker.Context qualified as Context
import Unison.Typechecker.TypeError qualified as TypeError
import Unison.UnisonFile qualified as UF
import Unison.UnisonFile.Names qualified as UF
import Unison.UnisonFile.Summary (FileSummary (..), fileDefLocations)
import Unison.UnisonFile.Summary qualified as FileSummary
import Unison.Util.Monoid (foldMapM)
import Unison.Util.Pretty qualified as Pretty
import Unison.Util.Relation qualified as R1
import Unison.Var qualified as Var
import UnliftIO.STM
import Witherable

-- | Lex, parse, and typecheck a file.
checkFile :: (HasUri d Uri) => d -> Lsp (Maybe FileAnalysis)
checkFile :: forall d. HasUri d Uri => d -> Lsp (Maybe FileAnalysis)
checkFile d
doc = MaybeT Lsp FileAnalysis -> Lsp (Maybe FileAnalysis)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
  ProjectPath
pp <- Lsp ProjectPath -> MaybeT Lsp ProjectPath
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Lsp ProjectPath
getCurrentProjectPath
  let fileUri :: Uri
fileUri = d
doc d -> Getting Uri d Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri d Uri
forall s a. HasUri s a => Lens' s a
Lens' d Uri
uri
  (FileVersion
fileVersion, Text
contents) <- Uri -> MaybeT Lsp (FileVersion, Text)
VFS.getFileContents Uri
fileUri
  Names
parseNames <- Lsp Names -> MaybeT Lsp Names
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Lsp Names
getCurrentNames
  let sourceName :: Text
sourceName = Uri -> Text
getUri (Uri -> Text) -> Uri -> Text
forall a b. (a -> b) -> a -> b
$ d
doc d -> Getting Uri d Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri d Uri
forall s a. HasUri s a => Lens' s a
Lens' d Uri
uri
  let lexedSource :: (Text, [Token Lexeme])
lexedSource@(Text
srcText, [Token Lexeme]
tokens) = (Text
contents, String -> String -> [Token Lexeme]
L.lexer (Text -> String
Text.unpack Text
sourceName) (Text -> String
Text.unpack Text
contents))
  let ambientAbilities :: [a]
ambientAbilities = []
  Codebase IO Symbol Ann
cb <- (Env -> Codebase IO Symbol Ann)
-> MaybeT Lsp (Codebase IO Symbol Ann)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Codebase IO Symbol Ann
codebase
  let generateUniqueName :: IO UniqueName
generateUniqueName = SystemDRG -> UniqueName
forall gen. DRG gen => gen -> UniqueName
Parser.uniqueBase32Namegen (SystemDRG -> UniqueName) -> IO SystemDRG -> IO UniqueName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO SystemDRG
Random.getSystemDRG
  UniqueName
uniqueName <- IO UniqueName -> MaybeT Lsp UniqueName
forall a. IO a -> MaybeT Lsp a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UniqueName
generateUniqueName
  let parsingEnv :: ParsingEnv Transaction
parsingEnv =
        Parser.ParsingEnv
          { $sel:uniqueNames:ParsingEnv :: UniqueName
uniqueNames = UniqueName
uniqueName,
            $sel:uniqueTypeGuid:ParsingEnv :: Name -> Transaction (Maybe Text)
uniqueTypeGuid = ProjectPath -> Name -> Transaction (Maybe Text)
Cli.loadUniqueTypeGuid ProjectPath
pp,
            $sel:names:ParsingEnv :: Names
names = Names
parseNames,
            $sel:maybeNamespace:ParsingEnv :: Maybe Name
maybeNamespace = Maybe Name
forall a. Maybe a
Nothing,
            $sel:localNamespacePrefixedTypesAndConstructors:ParsingEnv :: Names
localNamespacePrefixedTypesAndConstructors = Names
forall a. Monoid a => a
mempty
          }
  (Seq (Note Symbol Ann)
notes, Maybe (UnisonFile Symbol Ann)
parsedFile, Maybe (TypecheckedUnisonFile Symbol Ann)
typecheckedFile) <- do
    IO
  (Seq (Note Symbol Ann), Maybe (UnisonFile Symbol Ann),
   Maybe (TypecheckedUnisonFile Symbol Ann))
-> MaybeT
     Lsp
     (Seq (Note Symbol Ann), Maybe (UnisonFile Symbol Ann),
      Maybe (TypecheckedUnisonFile Symbol Ann))
forall a. IO a -> MaybeT Lsp a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
      Codebase IO Symbol Ann
-> Transaction
     (Seq (Note Symbol Ann), Maybe (UnisonFile Symbol Ann),
      Maybe (TypecheckedUnisonFile Symbol Ann))
-> IO
     (Seq (Note Symbol Ann), Maybe (UnisonFile Symbol Ann),
      Maybe (TypecheckedUnisonFile Symbol Ann))
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
cb do
        Either (Err Symbol) (UnisonFile Symbol Ann)
parseResult <- String
-> String
-> ParsingEnv Transaction
-> Transaction (Either (Err Symbol) (UnisonFile Symbol Ann))
forall (m :: * -> *) v.
(Monad m, Var v) =>
String
-> String -> ParsingEnv m -> m (Either (Err v) (UnisonFile v Ann))
Parsers.parseFile (Text -> String
Text.unpack Text
sourceName) (Text -> String
Text.unpack Text
srcText) ParsingEnv Transaction
parsingEnv
        case Either (Err Symbol) (UnisonFile Symbol Ann)
-> ResultT (Seq (Note Symbol Ann)) Identity (UnisonFile Symbol Ann)
forall (f :: * -> *) v a loc.
Monad f =>
Either (Err v) a -> ResultT (Seq (Note v loc)) f a
Result.fromParsing Either (Err Symbol) (UnisonFile Symbol Ann)
parseResult of
          Result.Result Seq (Note Symbol Ann)
parsingNotes Maybe (UnisonFile Symbol Ann)
Nothing -> (Seq (Note Symbol Ann), Maybe (UnisonFile Symbol Ann),
 Maybe (TypecheckedUnisonFile Symbol Ann))
-> Transaction
     (Seq (Note Symbol Ann), Maybe (UnisonFile Symbol Ann),
      Maybe (TypecheckedUnisonFile Symbol Ann))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq (Note Symbol Ann)
parsingNotes, Maybe (UnisonFile Symbol Ann)
forall a. Maybe a
Nothing, Maybe (TypecheckedUnisonFile Symbol Ann)
forall a. Maybe a
Nothing)
          Result.Result Seq (Note Symbol Ann)
_ (Just UnisonFile Symbol Ann
parsedFile) -> do
            Env Symbol Ann
typecheckingEnv <- ShouldUseTndr Transaction
-> Codebase IO Symbol Ann
-> [Type Symbol Ann]
-> UnisonFile Symbol Ann
-> Transaction (Env Symbol Ann)
computeTypecheckingEnvironment (ParsingEnv Transaction -> ShouldUseTndr Transaction
forall (m :: * -> *). ParsingEnv m -> ShouldUseTndr m
ShouldUseTndr'Yes ParsingEnv Transaction
parsingEnv) Codebase IO Symbol Ann
cb [Type Symbol Ann]
forall a. [a]
ambientAbilities UnisonFile Symbol Ann
parsedFile
            let Result.Result Seq (Note Symbol Ann)
typecheckingNotes Maybe (TypecheckedUnisonFile Symbol Ann)
maybeTypecheckedFile = Env Symbol Ann
-> UnisonFile Symbol Ann
-> MaybeT
     (WriterT (Seq (Note Symbol Ann)) Identity)
     (TypecheckedUnisonFile Symbol Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Env v Ann
-> UnisonFile v
-> ResultT (Seq (Note v Ann)) m (TypecheckedUnisonFile v Ann)
FileParsers.synthesizeFile Env Symbol Ann
typecheckingEnv UnisonFile Symbol Ann
parsedFile
            (Seq (Note Symbol Ann), Maybe (UnisonFile Symbol Ann),
 Maybe (TypecheckedUnisonFile Symbol Ann))
-> Transaction
     (Seq (Note Symbol Ann), Maybe (UnisonFile Symbol Ann),
      Maybe (TypecheckedUnisonFile Symbol Ann))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq (Note Symbol Ann)
typecheckingNotes, UnisonFile Symbol Ann -> Maybe (UnisonFile Symbol Ann)
forall a. a -> Maybe a
Just UnisonFile Symbol Ann
parsedFile, Maybe (TypecheckedUnisonFile Symbol Ann)
maybeTypecheckedFile)
  PrettyPrintEnvDecl
filePPED <- Lsp PrettyPrintEnvDecl -> MaybeT Lsp PrettyPrintEnvDecl
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Lsp PrettyPrintEnvDecl -> MaybeT Lsp PrettyPrintEnvDecl)
-> Lsp PrettyPrintEnvDecl -> MaybeT Lsp PrettyPrintEnvDecl
forall a b. (a -> b) -> a -> b
$ Maybe (UnisonFile Symbol Ann)
-> Maybe (TypecheckedUnisonFile Symbol Ann)
-> Lsp PrettyPrintEnvDecl
forall a.
Maybe (UnisonFile Symbol a)
-> Maybe (TypecheckedUnisonFile Symbol a) -> Lsp PrettyPrintEnvDecl
ppedForFileHelper Maybe (UnisonFile Symbol Ann)
parsedFile Maybe (TypecheckedUnisonFile Symbol Ann)
typecheckedFile
  ([Diagnostic]
errDiagnostics, [RangedCodeAction]
codeActions) <- Lsp ([Diagnostic], [RangedCodeAction])
-> MaybeT Lsp ([Diagnostic], [RangedCodeAction])
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Lsp ([Diagnostic], [RangedCodeAction])
 -> MaybeT Lsp ([Diagnostic], [RangedCodeAction]))
-> Lsp ([Diagnostic], [RangedCodeAction])
-> MaybeT Lsp ([Diagnostic], [RangedCodeAction])
forall a b. (a -> b) -> a -> b
$ Uri
-> Text
-> PrettyPrintEnvDecl
-> Seq (Note Symbol Ann)
-> Lsp ([Diagnostic], [RangedCodeAction])
forall (f :: * -> *).
Foldable f =>
Uri
-> Text
-> PrettyPrintEnvDecl
-> f (Note Symbol Ann)
-> Lsp ([Diagnostic], [RangedCodeAction])
analyseFile Uri
fileUri Text
srcText PrettyPrintEnvDecl
filePPED Seq (Note Symbol Ann)
notes
  let codeActionRanges :: IntervalMap Position [CodeAction]
codeActionRanges =
        [RangedCodeAction]
codeActions
          [RangedCodeAction]
-> ([RangedCodeAction] -> [(Range, CodeAction)])
-> [(Range, CodeAction)]
forall a b. a -> (a -> b) -> b
& (RangedCodeAction -> [(Range, CodeAction)])
-> [RangedCodeAction] -> [(Range, CodeAction)]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(RangedCodeAction {[Range]
_codeActionRanges :: [Range]
$sel:_codeActionRanges:RangedCodeAction :: RangedCodeAction -> [Range]
_codeActionRanges, CodeAction
_codeAction :: CodeAction
$sel:_codeAction:RangedCodeAction :: RangedCodeAction -> CodeAction
_codeAction}) -> (,CodeAction
_codeAction) (Range -> (Range, CodeAction)) -> [Range] -> [(Range, CodeAction)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Range]
_codeActionRanges)
          [(Range, CodeAction)]
-> ([(Range, CodeAction)] -> IntervalMap Position [CodeAction])
-> IntervalMap Position [CodeAction]
forall a b. a -> (a -> b) -> b
& [(Range, CodeAction)] -> IntervalMap Position [CodeAction]
forall (f :: * -> *) a.
Foldable f =>
f (Range, a) -> IntervalMap Position [a]
toRangeMap
  let typeSignatureHints :: Map Symbol TypeSignatureHint
typeSignatureHints = Map Symbol TypeSignatureHint
-> Maybe (Map Symbol TypeSignatureHint)
-> Map Symbol TypeSignatureHint
forall a. a -> Maybe a -> a
fromMaybe Map Symbol TypeSignatureHint
forall a. Monoid a => a
mempty (UnisonFile Symbol Ann
-> TypecheckedUnisonFile Symbol Ann -> Map Symbol TypeSignatureHint
mkTypeSignatureHints (UnisonFile Symbol Ann
 -> TypecheckedUnisonFile Symbol Ann
 -> Map Symbol TypeSignatureHint)
-> Maybe (UnisonFile Symbol Ann)
-> Maybe
     (TypecheckedUnisonFile Symbol Ann -> Map Symbol TypeSignatureHint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (UnisonFile Symbol Ann)
parsedFile Maybe
  (TypecheckedUnisonFile Symbol Ann -> Map Symbol TypeSignatureHint)
-> Maybe (TypecheckedUnisonFile Symbol Ann)
-> Maybe (Map Symbol TypeSignatureHint)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (TypecheckedUnisonFile Symbol Ann)
typecheckedFile)
  let fileSummary :: Maybe FileSummary
fileSummary = Maybe (UnisonFile Symbol Ann)
-> Maybe (TypecheckedUnisonFile Symbol Ann) -> Maybe FileSummary
FileSummary.mkFileSummary Maybe (UnisonFile Symbol Ann)
parsedFile Maybe (TypecheckedUnisonFile Symbol Ann)
typecheckedFile
  let unusedBindingDiagnostics :: [Diagnostic]
unusedBindingDiagnostics = Maybe FileSummary
fileSummary Maybe FileSummary
-> Getting (Endo [Diagnostic]) (Maybe FileSummary) Diagnostic
-> [Diagnostic]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (FileSummary -> Const (Endo [Diagnostic]) FileSummary)
-> Maybe FileSummary
-> Const (Endo [Diagnostic]) (Maybe FileSummary)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((FileSummary -> Const (Endo [Diagnostic]) FileSummary)
 -> Maybe FileSummary
 -> Const (Endo [Diagnostic]) (Maybe FileSummary))
-> ((Diagnostic -> Const (Endo [Diagnostic]) Diagnostic)
    -> FileSummary -> Const (Endo [Diagnostic]) FileSummary)
-> Getting (Endo [Diagnostic]) (Maybe FileSummary) Diagnostic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileSummary
 -> Map
      Symbol (Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann)))
-> Optic'
     (->)
     (Const (Endo [Diagnostic]))
     FileSummary
     (Map
        Symbol (Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann)))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to FileSummary
-> Map
     Symbol (Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann))
termsBySymbol Optic'
  (->)
  (Const (Endo [Diagnostic]))
  FileSummary
  (Map
     Symbol (Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann)))
-> ((Diagnostic -> Const (Endo [Diagnostic]) Diagnostic)
    -> Map
         Symbol (Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann))
    -> Const
         (Endo [Diagnostic])
         (Map
            Symbol (Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann))))
-> (Diagnostic -> Const (Endo [Diagnostic]) Diagnostic)
-> FileSummary
-> Const (Endo [Diagnostic]) FileSummary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann))
 -> Const
      (Endo [Diagnostic])
      (Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann)))
-> Map
     Symbol (Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann))
-> Const
     (Endo [Diagnostic])
     (Map
        Symbol (Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann)))
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold
  Int
  (Map
     Symbol (Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann)))
  (Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann))
folded (((Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann))
  -> Const
       (Endo [Diagnostic])
       (Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann)))
 -> Map
      Symbol (Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann))
 -> Const
      (Endo [Diagnostic])
      (Map
         Symbol (Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann))))
-> ((Diagnostic -> Const (Endo [Diagnostic]) Diagnostic)
    -> (Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann))
    -> Const
         (Endo [Diagnostic])
         (Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann)))
-> (Diagnostic -> Const (Endo [Diagnostic]) Diagnostic)
-> Map
     Symbol (Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann))
-> Const
     (Endo [Diagnostic])
     (Map
        Symbol (Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann))
 -> [Diagnostic])
-> Fold
     (Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann))
     Diagnostic
forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding (\(Ann
_topLevelAnn, Maybe Id
_refId, Term Symbol Ann
trm, Maybe (Type Symbol Ann)
_type) -> Uri -> Term Symbol Ann -> [Diagnostic]
UnusedBindings.analyseTerm Uri
fileUri Term Symbol Ann
trm)
  let tokenMap :: IntervalMap (Interval Position) Lexeme
tokenMap = [Token Lexeme] -> IntervalMap (Interval Position) Lexeme
getTokenMap [Token Lexeme]
tokens
  [Diagnostic]
conflictWarningDiagnostics <-
    Maybe [Diagnostic] -> [Diagnostic]
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Maybe [Diagnostic] -> [Diagnostic])
-> MaybeT Lsp (Maybe [Diagnostic]) -> MaybeT Lsp [Diagnostic]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FileSummary
-> (FileSummary -> MaybeT Lsp [Diagnostic])
-> MaybeT Lsp (Maybe [Diagnostic])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Maybe FileSummary
fileSummary \FileSummary
fs ->
      Lsp [Diagnostic] -> MaybeT Lsp [Diagnostic]
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Lsp [Diagnostic] -> MaybeT Lsp [Diagnostic])
-> Lsp [Diagnostic] -> MaybeT Lsp [Diagnostic]
forall a b. (a -> b) -> a -> b
$ Uri -> FileSummary -> Lsp [Diagnostic]
computeConflictWarningDiagnostics Uri
fileUri FileSummary
fs
  let diagnosticRanges :: IntervalMap Position [Diagnostic]
diagnosticRanges =
        ([Diagnostic]
errDiagnostics [Diagnostic] -> [Diagnostic] -> [Diagnostic]
forall a. Semigroup a => a -> a -> a
<> [Diagnostic]
conflictWarningDiagnostics [Diagnostic] -> [Diagnostic] -> [Diagnostic]
forall a. Semigroup a => a -> a -> a
<> [Diagnostic]
unusedBindingDiagnostics)
          [Diagnostic]
-> ([Diagnostic] -> [(Range, Diagnostic)]) -> [(Range, Diagnostic)]
forall a b. a -> (a -> b) -> b
& (Diagnostic -> (Range, Diagnostic))
-> [Diagnostic] -> [(Range, Diagnostic)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Diagnostic
d -> (Diagnostic
d Diagnostic -> Getting Range Diagnostic Range -> Range
forall s a. s -> Getting a s a -> a
^. Getting Range Diagnostic Range
forall s a. HasRange s a => Lens' s a
Lens' Diagnostic Range
range, Diagnostic
d))
          [(Range, Diagnostic)]
-> ([(Range, Diagnostic)] -> IntervalMap Position [Diagnostic])
-> IntervalMap Position [Diagnostic]
forall a b. a -> (a -> b) -> b
& [(Range, Diagnostic)] -> IntervalMap Position [Diagnostic]
forall (f :: * -> *) a.
Foldable f =>
f (Range, a) -> IntervalMap Position [a]
toRangeMap
  let fileAnalysis :: FileAnalysis
fileAnalysis = FileAnalysis {$sel:diagnostics:FileAnalysis :: IntervalMap Position [Diagnostic]
diagnostics = IntervalMap Position [Diagnostic]
diagnosticRanges, $sel:codeActions:FileAnalysis :: IntervalMap Position [CodeAction]
codeActions = IntervalMap Position [CodeAction]
codeActionRanges, Maybe FileSummary
fileSummary :: Maybe FileSummary
$sel:fileSummary:FileAnalysis :: Maybe FileSummary
fileSummary, Map Symbol TypeSignatureHint
typeSignatureHints :: Map Symbol TypeSignatureHint
$sel:typeSignatureHints:FileAnalysis :: Map Symbol TypeSignatureHint
typeSignatureHints, FileVersion
Maybe (TypecheckedUnisonFile Symbol Ann)
Maybe (UnisonFile Symbol Ann)
(Text, [Token Lexeme])
IntervalMap (Interval Position) Lexeme
Seq (Note Symbol Ann)
Uri
fileUri :: Uri
fileVersion :: FileVersion
lexedSource :: (Text, [Token Lexeme])
notes :: Seq (Note Symbol Ann)
parsedFile :: Maybe (UnisonFile Symbol Ann)
typecheckedFile :: Maybe (TypecheckedUnisonFile Symbol Ann)
tokenMap :: IntervalMap (Interval Position) Lexeme
$sel:fileUri:FileAnalysis :: Uri
$sel:fileVersion:FileAnalysis :: FileVersion
$sel:lexedSource:FileAnalysis :: (Text, [Token Lexeme])
$sel:tokenMap:FileAnalysis :: IntervalMap (Interval Position) Lexeme
$sel:parsedFile:FileAnalysis :: Maybe (UnisonFile Symbol Ann)
$sel:typecheckedFile:FileAnalysis :: Maybe (TypecheckedUnisonFile Symbol Ann)
$sel:notes:FileAnalysis :: Seq (Note Symbol Ann)
..}
  FileAnalysis -> MaybeT Lsp FileAnalysis
forall a. a -> MaybeT Lsp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileAnalysis
fileAnalysis

-- | Get the location of user defined definitions within the file
getFileDefLocations :: Uri -> MaybeT Lsp (Map Symbol (Set Ann))
getFileDefLocations :: Uri -> MaybeT Lsp (Map Symbol (Set Ann))
getFileDefLocations Uri
uri = do
  FileSummary -> Map Symbol (Set Ann)
fileDefLocations (FileSummary -> Map Symbol (Set Ann))
-> MaybeT Lsp FileSummary -> MaybeT Lsp (Map Symbol (Set Ann))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Uri -> MaybeT Lsp FileSummary
getFileSummary Uri
uri

fileAnalysisWorker :: Lsp ()
fileAnalysisWorker :: Lsp ()
fileAnalysisWorker = Lsp (Map Uri ()) -> Lsp ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever do
  TVar (Set Uri)
dirtyFilesV <- (Env -> TVar (Set Uri)) -> Lsp (TVar (Set Uri))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> TVar (Set Uri)
dirtyFilesVar
  TVar (Map Uri (TMVar FileAnalysis))
checkedFilesV <- (Env -> TVar (Map Uri (TMVar FileAnalysis)))
-> Lsp (TVar (Map Uri (TMVar FileAnalysis)))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> TVar (Map Uri (TMVar FileAnalysis))
checkedFilesVar
  -- We may want to debounce this if it typechecks too eagerly,
  -- but typechecking is pretty fast right now when scratch files are small
  Set Uri
dirtyFileIDs <- STM (Set Uri) -> Lsp (Set Uri)
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM (Set Uri) -> Lsp (Set Uri)) -> STM (Set Uri) -> Lsp (Set Uri)
forall a b. (a -> b) -> a -> b
$ do
    Set Uri
dirty <- TVar (Set Uri) -> STM (Set Uri)
forall a. TVar a -> STM a
readTVar TVar (Set Uri)
dirtyFilesV
    TVar (Set Uri) -> Set Uri -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Set Uri)
dirtyFilesV Set Uri
forall a. Monoid a => a
mempty
    Bool -> STM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> STM ()) -> Bool -> STM ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set Uri -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Uri
dirty
    pure Set Uri
dirty
  Map Uri FileAnalysis
freshlyCheckedFiles <-
    [(Uri, FileAnalysis)] -> Map Uri FileAnalysis
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Uri, FileAnalysis)] -> Map Uri FileAnalysis)
-> Lsp [(Uri, FileAnalysis)] -> Lsp (Map Uri FileAnalysis)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Uri]
-> (Uri -> Lsp (Maybe (Uri, FileAnalysis)))
-> Lsp [(Uri, FileAnalysis)]
forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
t a -> (a -> f (Maybe b)) -> f (t b)
forMaybe (Set Uri -> [Uri]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set Uri
dirtyFileIDs) \Uri
docUri -> MaybeT Lsp (Uri, FileAnalysis) -> Lsp (Maybe (Uri, FileAnalysis))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
      FileAnalysis
fileInfo <- Lsp (Maybe FileAnalysis) -> MaybeT Lsp FileAnalysis
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (TextDocumentIdentifier -> Lsp (Maybe FileAnalysis)
forall d. HasUri d Uri => d -> Lsp (Maybe FileAnalysis)
checkFile (TextDocumentIdentifier -> Lsp (Maybe FileAnalysis))
-> TextDocumentIdentifier -> Lsp (Maybe FileAnalysis)
forall a b. (a -> b) -> a -> b
$ Uri -> TextDocumentIdentifier
TextDocumentIdentifier Uri
docUri)
      pure (Uri
docUri, FileAnalysis
fileInfo)
  DebugFlag -> String -> [(Uri, FileAnalysis)] -> Lsp ()
forall a (m :: * -> *).
(Show a, Monad m) =>
DebugFlag -> String -> a -> m ()
Debug.debugM DebugFlag
Debug.LSP String
"Freshly Typechecked " (Map Uri FileAnalysis -> [(Uri, FileAnalysis)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Uri FileAnalysis
freshlyCheckedFiles)
  -- Overwrite any files we successfully checked
  STM () -> Lsp ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> Lsp ()) -> STM () -> Lsp ()
forall a b. (a -> b) -> a -> b
$ do
    Map Uri (TMVar FileAnalysis)
checkedFiles <- TVar (Map Uri (TMVar FileAnalysis))
-> STM (Map Uri (TMVar FileAnalysis))
forall a. TVar a -> STM a
readTVar TVar (Map Uri (TMVar FileAnalysis))
checkedFilesV
    let zipper :: These (TMVar a) a -> STM (TMVar a)
zipper = \case
          These TMVar a
mvar a
new -> TMVar a -> STM (Maybe a)
forall a. TMVar a -> STM (Maybe a)
tryTakeTMVar TMVar a
mvar STM (Maybe a) -> STM () -> STM ()
forall a b. STM a -> STM b -> STM b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TMVar a -> a -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar a
mvar a
new STM () -> STM (TMVar a) -> STM (TMVar a)
forall a b. STM a -> STM b -> STM b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TMVar a -> STM (TMVar a)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TMVar a
mvar
          This TMVar a
mvar -> TMVar a -> STM (TMVar a)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TMVar a
mvar
          That a
new -> a -> STM (TMVar a)
forall a. a -> STM (TMVar a)
newTMVar a
new
    Map Uri (TMVar FileAnalysis)
newCheckedFiles <- Map Uri (STM (TMVar FileAnalysis))
-> STM (Map Uri (TMVar FileAnalysis))
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
Map Uri (f a) -> f (Map Uri a)
sequenceA (Map Uri (STM (TMVar FileAnalysis))
 -> STM (Map Uri (TMVar FileAnalysis)))
-> Map Uri (STM (TMVar FileAnalysis))
-> STM (Map Uri (TMVar FileAnalysis))
forall a b. (a -> b) -> a -> b
$ (These (TMVar FileAnalysis) FileAnalysis
 -> STM (TMVar FileAnalysis))
-> Map Uri (TMVar FileAnalysis)
-> Map Uri FileAnalysis
-> Map Uri (STM (TMVar FileAnalysis))
forall a b c.
(These a b -> c) -> Map Uri a -> Map Uri b -> Map Uri c
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith These (TMVar FileAnalysis) FileAnalysis -> STM (TMVar FileAnalysis)
forall {a}. These (TMVar a) a -> STM (TMVar a)
zipper Map Uri (TMVar FileAnalysis)
checkedFiles Map Uri FileAnalysis
freshlyCheckedFiles
    TVar (Map Uri (TMVar FileAnalysis))
-> Map Uri (TMVar FileAnalysis) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Map Uri (TMVar FileAnalysis))
checkedFilesV Map Uri (TMVar FileAnalysis)
newCheckedFiles
  Map Uri FileAnalysis
-> (FileAnalysis -> Lsp ()) -> Lsp (Map Uri ())
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Map Uri FileAnalysis
freshlyCheckedFiles \(FileAnalysis {Uri
$sel:fileUri:FileAnalysis :: FileAnalysis -> Uri
fileUri :: Uri
fileUri, FileVersion
$sel:fileVersion:FileAnalysis :: FileAnalysis -> FileVersion
fileVersion :: FileVersion
fileVersion, IntervalMap Position [Diagnostic]
$sel:diagnostics:FileAnalysis :: FileAnalysis -> IntervalMap Position [Diagnostic]
diagnostics :: IntervalMap Position [Diagnostic]
diagnostics}) -> do
    Uri -> Maybe FileVersion -> [Diagnostic] -> Lsp ()
forall (f :: * -> *).
Foldable f =>
Uri -> Maybe FileVersion -> f Diagnostic -> Lsp ()
reportDiagnostics Uri
fileUri (FileVersion -> Maybe FileVersion
forall a. a -> Maybe a
Just FileVersion
fileVersion) ([Diagnostic] -> Lsp ()) -> [Diagnostic] -> Lsp ()
forall a b. (a -> b) -> a -> b
$ IntervalMap Position [Diagnostic] -> [Diagnostic]
forall m. Monoid m => IntervalMap (Interval Position) m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold IntervalMap Position [Diagnostic]
diagnostics

analyseFile :: (Foldable f) => Uri -> Text -> PPED.PrettyPrintEnvDecl -> f (Note Symbol Ann) -> Lsp ([Diagnostic], [RangedCodeAction])
analyseFile :: forall (f :: * -> *).
Foldable f =>
Uri
-> Text
-> PrettyPrintEnvDecl
-> f (Note Symbol Ann)
-> Lsp ([Diagnostic], [RangedCodeAction])
analyseFile Uri
fileUri Text
srcText PrettyPrintEnvDecl
pped f (Note Symbol Ann)
notes = do
  let ppe :: PrettyPrintEnv
ppe = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
pped
  ([Diagnostic]
noteDiags, [RangedCodeAction]
noteActions) <- Uri
-> PrettyPrintEnv
-> String
-> f (Note Symbol Ann)
-> Lsp ([Diagnostic], [RangedCodeAction])
forall (f :: * -> *).
Foldable f =>
Uri
-> PrettyPrintEnv
-> String
-> f (Note Symbol Ann)
-> Lsp ([Diagnostic], [RangedCodeAction])
analyseNotes Uri
fileUri PrettyPrintEnv
ppe (Text -> String
Text.unpack Text
srcText) f (Note Symbol Ann)
notes
  ([Diagnostic], [RangedCodeAction])
-> Lsp ([Diagnostic], [RangedCodeAction])
forall a. a -> Lsp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Diagnostic]
noteDiags, [RangedCodeAction]
noteActions)

-- | Returns diagnostics which show a warning diagnostic when editing a term that's conflicted in the
-- codebase.
computeConflictWarningDiagnostics :: Uri -> FileSummary -> Lsp [Diagnostic]
computeConflictWarningDiagnostics :: Uri -> FileSummary -> Lsp [Diagnostic]
computeConflictWarningDiagnostics Uri
fileUri fileSummary :: FileSummary
fileSummary@FileSummary {Names
fileNames :: Names
$sel:fileNames:FileSummary :: FileSummary -> Names
fileNames} = do
  let defLocations :: Map Symbol (Set Ann)
defLocations = FileSummary -> Map Symbol (Set Ann)
fileDefLocations FileSummary
fileSummary
  Names
conflictedNames <- Names -> Names
Names.conflicts (Names -> Names) -> Lsp Names -> Lsp Names
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lsp Names
getCurrentNames
  let locationForName :: Name -> Set Ann
      locationForName :: Name -> Set Ann
locationForName Name
name = Maybe (Set Ann) -> Set Ann
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Maybe (Set Ann) -> Set Ann) -> Maybe (Set Ann) -> Set Ann
forall a b. (a -> b) -> a -> b
$ Symbol -> Map Symbol (Set Ann) -> Maybe (Set Ann)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Name -> Symbol
forall v. Var v => Name -> v
Name.toVar Name
name) Map Symbol (Set Ann)
defLocations
  let conflictedTermLocations :: Map Name (Set Ann)
conflictedTermLocations =
        let fileTerms :: Map Name (Set Referent)
fileTerms = Relation Name Referent -> Map Name (Set Referent)
forall a b. Relation a b -> Map a (Set b)
R1.toMultimap (Names -> Relation Name Referent
Names.terms Names
fileNames)
            conflictedTerms :: Map Name (Set Referent)
conflictedTerms = Relation Name Referent -> Map Name (Set Referent)
forall a b. Relation a b -> Map a (Set b)
R1.toMultimap (Names -> Relation Name Referent
Names.terms Names
conflictedNames)
         in (Name -> Set Referent -> Set Referent -> Set Ann)
-> Map Name (Set Referent)
-> Map Name (Set Referent)
-> Map Name (Set Ann)
forall k a b c.
Ord k =>
(k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWithKey (\Name
name Set Referent
_ Set Referent
_ -> Name -> Set Ann
locationForName Name
name) Map Name (Set Referent)
fileTerms Map Name (Set Referent)
conflictedTerms
  let conflictedTypeLocations :: Map Name (Set Ann)
conflictedTypeLocations =
        let fileTypes :: Map Name (Set TypeReference)
fileTypes = Relation Name TypeReference -> Map Name (Set TypeReference)
forall a b. Relation a b -> Map a (Set b)
R1.toMultimap (Names -> Relation Name TypeReference
Names.types Names
fileNames)
            conflictedTypes :: Map Name (Set TypeReference)
conflictedTypes = Relation Name TypeReference -> Map Name (Set TypeReference)
forall a b. Relation a b -> Map a (Set b)
R1.toMultimap (Names -> Relation Name TypeReference
Names.types Names
conflictedNames)
         in (Name -> Set TypeReference -> Set TypeReference -> Set Ann)
-> Map Name (Set TypeReference)
-> Map Name (Set TypeReference)
-> Map Name (Set Ann)
forall k a b c.
Ord k =>
(k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWithKey (\Name
name Set TypeReference
_ Set TypeReference
_ -> Name -> Set Ann
locationForName Name
name) Map Name (Set TypeReference)
fileTypes Map Name (Set TypeReference)
conflictedTypes
  let toDiagnostics :: Map Name (Set Ann) -> [Diagnostic]
toDiagnostics Map Name (Set Ann)
annMap =
        Map Name (Set Ann)
annMap
          Map Name (Set Ann)
-> (Map Name (Set Ann) -> [(Name, Set Ann)]) -> [(Name, Set Ann)]
forall a b. a -> (a -> b) -> b
& Map Name (Set Ann) -> [(Name, Set Ann)]
forall k a. Map k a -> [(k, a)]
Map.toList
          [(Name, Set Ann)]
-> ([(Name, Set Ann)] -> [Diagnostic]) -> [Diagnostic]
forall a b. a -> (a -> b) -> b
& ((Name, Set Ann) -> [Diagnostic])
-> [(Name, Set Ann)] -> [Diagnostic]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \(Name
name, Set Ann
locs) ->
            ((Ann -> Maybe Range) -> [Ann] -> [Range]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe Ann -> Maybe Range
Cv.annToRange ([Ann] -> [Range]) -> (Set Ann -> [Ann]) -> Set Ann -> [Range]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Ann -> [Ann]
forall a. Set a -> [a]
Set.toList (Set Ann -> [Range]) -> Set Ann -> [Range]
forall a b. (a -> b) -> a -> b
$ Set Ann
locs)
              [Range] -> (Range -> Diagnostic) -> [Diagnostic]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Range
range ->
                let msg :: Text
msg = Text
"There are multiple definitions of `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
Name.toText Name
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"` in your namespace; updating this definition will replace them."
                    newRangeEnd :: Position
newRangeEnd =
                      Range
range Range -> Getting Position Range Position -> Position
forall s a. s -> Getting a s a -> a
^. Getting Position Range Position
forall s a. HasStart s a => Lens' s a
Lens' Range Position
LSPTypes.start
                        Position -> (Position -> Position) -> Position
forall a b. a -> (a -> b) -> b
& (UInt -> Identity UInt) -> Position -> Identity Position
forall s a. HasCharacter s a => Lens' s a
Lens' Position UInt
LSPTypes.character ((UInt -> Identity UInt) -> Position -> Identity Position)
-> UInt -> Position -> Position
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
Text.length (Name -> Text
Name.toText Name
name))
                    newRange :: Range
newRange = Range
range Range -> (Range -> Range) -> Range
forall a b. a -> (a -> b) -> b
& (Position -> Identity Position) -> Range -> Identity Range
forall s a. HasEnd s a => Lens' s a
Lens' Range Position
LSPTypes.end ((Position -> Identity Position) -> Range -> Identity Range)
-> Position -> Range -> Range
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Position
newRangeEnd
                 in Uri
-> Range
-> DiagnosticSeverity
-> [DiagnosticTag]
-> Text
-> [(Text, Range)]
-> Diagnostic
mkDiagnostic
                      Uri
fileUri
                      Range
newRange
                      DiagnosticSeverity
DiagnosticSeverity_Information
                      []
                      Text
msg
                      [(Text, Range)]
forall a. Monoid a => a
mempty
  pure $ Map Name (Set Ann) -> [Diagnostic]
toDiagnostics Map Name (Set Ann)
conflictedTermLocations [Diagnostic] -> [Diagnostic] -> [Diagnostic]
forall a. Semigroup a => a -> a -> a
<> Map Name (Set Ann) -> [Diagnostic]
toDiagnostics Map Name (Set Ann)
conflictedTypeLocations

getTokenMap :: [L.Token L.Lexeme] -> IM.IntervalMap Position L.Lexeme
getTokenMap :: [Token Lexeme] -> IntervalMap (Interval Position) Lexeme
getTokenMap [Token Lexeme]
tokens =
  [Token Lexeme]
tokens
    [Token Lexeme]
-> ([Token Lexeme] -> [IntervalMap (Interval Position) Lexeme])
-> [IntervalMap (Interval Position) Lexeme]
forall a b. a -> (a -> b) -> b
& (Token Lexeme -> Maybe (IntervalMap (Interval Position) Lexeme))
-> [Token Lexeme] -> [IntervalMap (Interval Position) Lexeme]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe
      ( \Token Lexeme
token ->
          Interval Position
-> Lexeme -> IntervalMap (Interval Position) Lexeme
forall k v. k -> v -> IntervalMap k v
IM.singleton (Interval Position
 -> Lexeme -> IntervalMap (Interval Position) Lexeme)
-> Maybe (Interval Position)
-> Maybe (Lexeme -> IntervalMap (Interval Position) Lexeme)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ann -> Maybe (Interval Position)
annToInterval (Ann -> Maybe (Interval Position))
-> Ann -> Maybe (Interval Position)
forall a b. (a -> b) -> a -> b
$ Token Lexeme -> Ann
forall a. Annotated a => a -> Ann
Parser.ann Token Lexeme
token) Maybe (Lexeme -> IntervalMap (Interval Position) Lexeme)
-> Maybe Lexeme -> Maybe (IntervalMap (Interval Position) Lexeme)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Lexeme -> Maybe Lexeme
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Token Lexeme -> Lexeme
forall a. Token a -> a
L.payload Token Lexeme
token)
      )
    [IntervalMap (Interval Position) Lexeme]
-> ([IntervalMap (Interval Position) Lexeme]
    -> IntervalMap (Interval Position) Lexeme)
-> IntervalMap (Interval Position) Lexeme
forall a b. a -> (a -> b) -> b
& [IntervalMap (Interval Position) Lexeme]
-> IntervalMap (Interval Position) Lexeme
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold

analyseNotes :: (Foldable f) => Uri -> PrettyPrintEnv -> String -> f (Note Symbol Ann) -> Lsp ([Diagnostic], [RangedCodeAction])
analyseNotes :: forall (f :: * -> *).
Foldable f =>
Uri
-> PrettyPrintEnv
-> String
-> f (Note Symbol Ann)
-> Lsp ([Diagnostic], [RangedCodeAction])
analyseNotes Uri
fileUri PrettyPrintEnv
ppe String
src f (Note Symbol Ann)
notes = do
  ((Note Symbol Ann -> Lsp ([Diagnostic], [RangedCodeAction]))
 -> f (Note Symbol Ann) -> Lsp ([Diagnostic], [RangedCodeAction]))
-> f (Note Symbol Ann)
-> (Note Symbol Ann -> Lsp ([Diagnostic], [RangedCodeAction]))
-> Lsp ([Diagnostic], [RangedCodeAction])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Note Symbol Ann -> Lsp ([Diagnostic], [RangedCodeAction]))
-> f (Note Symbol Ann) -> Lsp ([Diagnostic], [RangedCodeAction])
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
foldMapM f (Note Symbol Ann)
notes \Note Symbol Ann
note -> case Note Symbol Ann
note of
    Result.TypeError errNote :: ErrorNote Symbol Ann
errNote@(Context.ErrorNote {Cause Symbol Ann
cause :: Cause Symbol Ann
$sel:cause:ErrorNote :: forall v loc. ErrorNote v loc -> Cause v loc
cause}) -> do
      let typeErr :: TypeError Symbol Ann
typeErr = ErrorNote Symbol Ann -> TypeError Symbol Ann
forall loc v.
(Ord loc, Show loc, Var v) =>
ErrorNote v loc -> TypeError v loc
TypeError.typeErrorFromNote ErrorNote Symbol Ann
errNote
          ranges :: [(Range, [(Text, Range)])]
ranges = case TypeError Symbol Ann
typeErr of
            TypeError.Mismatch {Term Symbol Ann
mismatchSite :: Term Symbol Ann
$sel:mismatchSite:Mismatch :: forall v loc. TypeError v loc -> Term v loc
mismatchSite} -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange (Ann -> [(Range, [(Text, Range)])])
-> Ann -> [(Range, [(Text, Range)])]
forall a b. (a -> b) -> a -> b
$ Term Symbol Ann -> Ann
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term Symbol Ann
mismatchSite
            TypeError.BooleanMismatch {Term Symbol Ann
$sel:mismatchSite:Mismatch :: forall v loc. TypeError v loc -> Term v loc
mismatchSite :: Term Symbol Ann
mismatchSite} -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange (Ann -> [(Range, [(Text, Range)])])
-> Ann -> [(Range, [(Text, Range)])]
forall a b. (a -> b) -> a -> b
$ Term Symbol Ann -> Ann
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term Symbol Ann
mismatchSite
            TypeError.ExistentialMismatch {Term Symbol Ann
$sel:mismatchSite:Mismatch :: forall v loc. TypeError v loc -> Term v loc
mismatchSite :: Term Symbol Ann
mismatchSite} -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange (Ann -> [(Range, [(Text, Range)])])
-> Ann -> [(Range, [(Text, Range)])]
forall a b. (a -> b) -> a -> b
$ Term Symbol Ann -> Ann
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term Symbol Ann
mismatchSite
            TypeError.FunctionApplication {Term Symbol Ann
f :: Term Symbol Ann
$sel:f:Mismatch :: forall v loc. TypeError v loc -> Term v loc
f} -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange (Ann -> [(Range, [(Text, Range)])])
-> Ann -> [(Range, [(Text, Range)])]
forall a b. (a -> b) -> a -> b
$ Term Symbol Ann -> Ann
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term Symbol Ann
f
            TypeError.NotFunctionApplication {Term Symbol Ann
$sel:f:Mismatch :: forall v loc. TypeError v loc -> Term v loc
f :: Term Symbol Ann
f} -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange (Ann -> [(Range, [(Text, Range)])])
-> Ann -> [(Range, [(Text, Range)])]
forall a b. (a -> b) -> a -> b
$ Term Symbol Ann -> Ann
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term Symbol Ann
f
            TypeError.AbilityCheckFailure {Ann
abilityCheckFailureSite :: Ann
$sel:abilityCheckFailureSite:Mismatch :: forall v loc. TypeError v loc -> loc
abilityCheckFailureSite} -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange Ann
abilityCheckFailureSite
            TypeError.AbilityEqFailure {Ann
$sel:abilityCheckFailureSite:Mismatch :: forall v loc. TypeError v loc -> loc
abilityCheckFailureSite :: Ann
abilityCheckFailureSite} -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange Ann
abilityCheckFailureSite
            TypeError.AbilityEqFailureFromAp {Term Symbol Ann
expectedSite :: Term Symbol Ann
$sel:expectedSite:Mismatch :: forall v loc. TypeError v loc -> Term v loc
expectedSite, Term Symbol Ann
$sel:mismatchSite:Mismatch :: forall v loc. TypeError v loc -> Term v loc
mismatchSite :: Term Symbol Ann
mismatchSite} -> do
              let locs :: [Ann]
locs = [Term Symbol Ann -> Ann
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term Symbol Ann
expectedSite, Term Symbol Ann -> Ann
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term Symbol Ann
mismatchSite]
              (Range
r, [Range]
rs) <- [Range] -> [(Range, [Range])]
forall a. [a] -> [(a, [a])]
withNeighbours ([Ann]
locs [Ann] -> (Ann -> [Range]) -> [Range]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ann -> [Range]
aToR)
              (Range, [(Text, Range)]) -> [(Range, [(Text, Range)])]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Range
r, (Text
"mismatch",) (Range -> (Text, Range)) -> [Range] -> [(Text, Range)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Range]
rs)
            TypeError.UnguardedLetRecCycle {[Ann]
cycleLocs :: [Ann]
$sel:cycleLocs:Mismatch :: forall v loc. TypeError v loc -> [loc]
cycleLocs} -> do
              let ranges :: [Range]
                  ranges :: [Range]
ranges = [Ann]
cycleLocs [Ann] -> (Ann -> [Range]) -> [Range]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ann -> [Range]
aToR
              (Range
range, [Range]
cycleRanges) <- [Range] -> [(Range, [Range])]
forall a. [a] -> [(a, [a])]
withNeighbours [Range]
ranges
              (Range, [(Text, Range)]) -> [(Range, [(Text, Range)])]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Range
range, (Text
"cycle",) (Range -> (Text, Range)) -> [Range] -> [(Text, Range)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Range]
cycleRanges)
            TypeError.UnknownType {Ann
typeSite :: Ann
$sel:typeSite:Mismatch :: forall v loc. TypeError v loc -> loc
typeSite} -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange Ann
typeSite
            TypeError.UnknownTerm {Ann
termSite :: Ann
$sel:termSite:Mismatch :: forall v loc. TypeError v loc -> loc
termSite} -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange Ann
termSite
            TypeError.DuplicateDefinitions {NonEmpty (Symbol, [Ann])
defns :: NonEmpty (Symbol, [Ann])
$sel:defns:Mismatch :: forall v loc. TypeError v loc -> NonEmpty (v, [loc])
defns} -> do
              (Symbol
_v, [Ann]
locs) <- NonEmpty (Symbol, [Ann]) -> [(Symbol, [Ann])]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Symbol, [Ann])
defns
              (Range
r, [Range]
rs) <- [Range] -> [(Range, [Range])]
forall a. [a] -> [(a, [a])]
withNeighbours ([Ann]
locs [Ann] -> (Ann -> [Range]) -> [Range]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ann -> [Range]
aToR)
              (Range, [(Text, Range)]) -> [(Range, [(Text, Range)])]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Range
r, (Text
"duplicate definition",) (Range -> (Text, Range)) -> [Range] -> [(Text, Range)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Range]
rs)
            TypeError.RedundantPattern Ann
loc -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange Ann
loc
            TypeError.UncoveredPatterns Ann
loc NonEmpty (Pattern ())
_pats -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange Ann
loc
            TypeError.KindInferenceFailure KindError Symbol Ann
ke -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange (KindError Symbol Ann -> Ann
forall loc v. Semigroup loc => KindError v loc -> loc
KindInference.lspLoc KindError Symbol Ann
ke)
            -- These type errors don't have custom type error conversions, but some
            -- still have valid diagnostics.
            TypeError.Other e :: ErrorNote Symbol Ann
e@(Context.ErrorNote {Cause Symbol Ann
$sel:cause:ErrorNote :: forall v loc. ErrorNote v loc -> Cause v loc
cause :: Cause Symbol Ann
cause}) -> case Cause Symbol Ann
cause of
              Context.PatternArityMismatch Ann
loc Type Symbol Ann
_typ Int
_numArgs -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange Ann
loc
              Context.HandlerOfUnexpectedType Ann
loc Type Symbol Ann
_typ -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange Ann
loc
              Context.TypeMismatch {} -> ErrorNote Symbol Ann -> [(Range, [(Text, Range)])]
forall {a} {m :: * -> *} {b}.
(Show a, Monad m, Alternative m) =>
a -> m b
shouldHaveBeenHandled ErrorNote Symbol Ann
e
              Context.IllFormedType {} -> ErrorNote Symbol Ann -> [(Range, [(Text, Range)])]
forall {a} {m :: * -> *} {b}.
(Show a, Monad m, Alternative m) =>
a -> m b
shouldHaveBeenHandled ErrorNote Symbol Ann
e
              Context.UnknownSymbol Ann
loc Symbol
_ -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange Ann
loc
              Context.UnknownTerm Ann
loc Symbol
_ [Suggestion Symbol Ann]
_ Type Symbol Ann
_ -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange Ann
loc
              Context.AbilityCheckFailure {} -> ErrorNote Symbol Ann -> [(Range, [(Text, Range)])]
forall {a} {m :: * -> *} {b}.
(Show a, Monad m, Alternative m) =>
a -> m b
shouldHaveBeenHandled ErrorNote Symbol Ann
e
              Context.AbilityEqFailure {} -> ErrorNote Symbol Ann -> [(Range, [(Text, Range)])]
forall {a} {m :: * -> *} {b}.
(Show a, Monad m, Alternative m) =>
a -> m b
shouldHaveBeenHandled ErrorNote Symbol Ann
e
              Context.EffectConstructorWrongArgCount {} -> ErrorNote Symbol Ann -> [(Range, [(Text, Range)])]
forall {a} {m :: * -> *} {b}.
(Show a, Monad m, Alternative m) =>
a -> m b
shouldHaveBeenHandled ErrorNote Symbol Ann
e
              Context.MalformedEffectBind {} -> ErrorNote Symbol Ann -> [(Range, [(Text, Range)])]
forall {a} {m :: * -> *} {b}.
(Show a, Monad m, Alternative m) =>
a -> m b
shouldHaveBeenHandled ErrorNote Symbol Ann
e
              Context.DuplicateDefinitions {} -> ErrorNote Symbol Ann -> [(Range, [(Text, Range)])]
forall {a} {m :: * -> *} {b}.
(Show a, Monad m, Alternative m) =>
a -> m b
shouldHaveBeenHandled ErrorNote Symbol Ann
e
              Context.UnguardedLetRecCycle {} -> ErrorNote Symbol Ann -> [(Range, [(Text, Range)])]
forall {a} {m :: * -> *} {b}.
(Show a, Monad m, Alternative m) =>
a -> m b
shouldHaveBeenHandled ErrorNote Symbol Ann
e
              Context.ConcatPatternWithoutConstantLength Ann
loc Type Symbol Ann
_ -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange Ann
loc
              Context.DataEffectMismatch Unknown
_ TypeReference
_ DataDeclaration Symbol Ann
decl -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange (Ann -> [(Range, [(Text, Range)])])
-> Ann -> [(Range, [(Text, Range)])]
forall a b. (a -> b) -> a -> b
$ DataDeclaration Symbol Ann -> Ann
forall v a. DataDeclaration v a -> a
DD.annotation DataDeclaration Symbol Ann
decl
              Context.UncoveredPatterns Ann
loc NonEmpty (Pattern ())
_ -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange Ann
loc
              Context.RedundantPattern Ann
loc -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange Ann
loc
              Context.InaccessiblePattern Ann
loc -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange Ann
loc
              Context.KindInferenceFailure {} -> ErrorNote Symbol Ann -> [(Range, [(Text, Range)])]
forall {a} {m :: * -> *} {b}.
(Show a, Monad m, Alternative m) =>
a -> m b
shouldHaveBeenHandled ErrorNote Symbol Ann
e
          shouldHaveBeenHandled :: a -> m b
shouldHaveBeenHandled a
e = do
            DebugFlag -> String -> a -> m ()
forall a (m :: * -> *).
(Show a, Monad m) =>
DebugFlag -> String -> a -> m ()
Debug.debugM DebugFlag
Debug.LSP String
"This diagnostic should have been handled by a previous case but was not" a
e
            m b
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
          diags :: [Diagnostic]
diags = Note Symbol Ann -> [(Range, [(Text, Range)])] -> [Diagnostic]
noteDiagnostic Note Symbol Ann
note [(Range, [(Text, Range)])]
ranges
      -- Sort on match accuracy first, then name.
      [RangedCodeAction]
codeActions <- case Cause Symbol Ann
cause of
        Context.UnknownTerm Ann
_ Symbol
v [Suggestion Symbol Ann]
suggestions Type Symbol Ann
typ -> do
          [RangedCodeAction]
typeHoleActions <- [Diagnostic] -> Symbol -> Type Symbol Ann -> Lsp [RangedCodeAction]
typeHoleReplacementCodeActions [Diagnostic]
diags Symbol
v Type Symbol Ann
typ
          pure $
            [Diagnostic] -> [Suggestion Symbol Ann] -> [RangedCodeAction]
nameResolutionCodeActions [Diagnostic]
diags [Suggestion Symbol Ann]
suggestions
              [RangedCodeAction] -> [RangedCodeAction] -> [RangedCodeAction]
forall a. Semigroup a => a -> a -> a
<> [RangedCodeAction]
typeHoleActions
        Cause Symbol Ann
_ -> [RangedCodeAction] -> Lsp [RangedCodeAction]
forall a. a -> Lsp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      pure ([Diagnostic]
diags, [RangedCodeAction]
codeActions)
    Result.NameResolutionFailures {} -> do
      -- TODO: diagnostics/code actions for resolution failures
      ([Diagnostic], [RangedCodeAction])
-> Lsp ([Diagnostic], [RangedCodeAction])
forall a. a -> Lsp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Note Symbol Ann -> [(Range, [(Text, Range)])] -> [Diagnostic]
noteDiagnostic Note Symbol Ann
note [(Range, [(Text, Range)])]
forall a. [a]
todoAnnotation, [])
    Result.Parsing Err Symbol
err -> do
      let diags :: [Diagnostic]
diags = do
            (Pretty ColorText
errMsg, [Range]
ranges) <- String -> Err Symbol -> [(Pretty ColorText, [Range])]
forall v. Var v => String -> Err v -> [(Pretty ColorText, [Range])]
PrintError.renderParseErrors String
src Err Symbol
err
            let txtMsg :: Text
txtMsg = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Width -> Pretty ColorText -> String
Pretty.toPlain Width
80 Pretty ColorText
errMsg
            Range
range <- [Range]
ranges
            pure $ Uri
-> Range
-> DiagnosticSeverity
-> [DiagnosticTag]
-> Text
-> [(Text, Range)]
-> Diagnostic
mkDiagnostic Uri
fileUri (Range -> Range
uToLspRange Range
range) DiagnosticSeverity
DiagnosticSeverity_Error [] Text
txtMsg []
      -- TODO: Some parsing errors likely have reasonable code actions
      ([Diagnostic], [RangedCodeAction])
-> Lsp ([Diagnostic], [RangedCodeAction])
forall a. a -> Lsp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Diagnostic]
diags, [])
    Result.UnknownSymbol Symbol
_ Ann
loc ->
      ([Diagnostic], [RangedCodeAction])
-> Lsp ([Diagnostic], [RangedCodeAction])
forall a. a -> Lsp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Note Symbol Ann -> [(Range, [(Text, Range)])] -> [Diagnostic]
noteDiagnostic Note Symbol Ann
note (Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange Ann
loc), [])
    Result.TypeInfo {} ->
      -- No relevant diagnostics from type info.
      ([Diagnostic], [RangedCodeAction])
-> Lsp ([Diagnostic], [RangedCodeAction])
forall a. a -> Lsp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [])
    Result.CompilerBug CompilerBug Symbol Ann
cbug -> do
      let ranges :: [(Range, [(Text, Range)])]
ranges = case CompilerBug Symbol Ann
cbug of
            Result.TopLevelComponentNotFound Symbol
_ Term Symbol Ann
trm -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange (Ann -> [(Range, [(Text, Range)])])
-> Ann -> [(Range, [(Text, Range)])]
forall a b. (a -> b) -> a -> b
$ Term Symbol Ann -> Ann
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term Symbol Ann
trm
            Result.ResolvedNameNotFound Symbol
_ Ann
loc Name
_ -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange Ann
loc
            Result.TypecheckerBug CompilerBug Symbol Ann
tcbug -> case CompilerBug Symbol Ann
tcbug of
              Context.UnknownDecl Unknown
_un TypeReference
_ref Map TypeReference (DataDeclaration Symbol Ann)
decls -> Map TypeReference (DataDeclaration Symbol Ann)
decls Map TypeReference (DataDeclaration Symbol Ann)
-> (Map TypeReference (DataDeclaration Symbol Ann)
    -> [(Range, [(Text, Range)])])
-> [(Range, [(Text, Range)])]
forall a b. a -> (a -> b) -> b
& (DataDeclaration Symbol Ann -> [(Range, [(Text, Range)])])
-> Map TypeReference (DataDeclaration Symbol Ann)
-> [(Range, [(Text, Range)])]
forall m a. Monoid m => (a -> m) -> Map TypeReference a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \DataDeclaration Symbol Ann
decl -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange (Ann -> [(Range, [(Text, Range)])])
-> Ann -> [(Range, [(Text, Range)])]
forall a b. (a -> b) -> a -> b
$ DataDeclaration Symbol Ann -> Ann
forall v a. DataDeclaration v a -> a
DD.annotation DataDeclaration Symbol Ann
decl
              Context.UnknownConstructor Unknown
_un ConstructorReference
_gcr DataDeclaration Symbol Ann
decl -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange (Ann -> [(Range, [(Text, Range)])])
-> Ann -> [(Range, [(Text, Range)])]
forall a b. (a -> b) -> a -> b
$ DataDeclaration Symbol Ann -> Ann
forall v a. DataDeclaration v a -> a
DD.annotation DataDeclaration Symbol Ann
decl
              Context.UndeclaredTermVariable Symbol
_sym Context Symbol Ann
_con -> [(Range, [(Text, Range)])]
forall a. [a]
todoAnnotation
              Context.RetractFailure Element Symbol Ann
_el Context Symbol Ann
_con -> [(Range, [(Text, Range)])]
forall a. [a]
todoAnnotation
              Context.EmptyLetRec Term Symbol Ann
trm -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange (Ann -> [(Range, [(Text, Range)])])
-> Ann -> [(Range, [(Text, Range)])]
forall a b. (a -> b) -> a -> b
$ Term Symbol Ann -> Ann
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term Symbol Ann
trm
              CompilerBug Symbol Ann
Context.PatternMatchFailure -> [(Range, [(Text, Range)])]
forall a. [a]
todoAnnotation
              Context.EffectConstructorHadMultipleEffects Type Symbol Ann
typ -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange (Ann -> [(Range, [(Text, Range)])])
-> Ann -> [(Range, [(Text, Range)])]
forall a b. (a -> b) -> a -> b
$ Type Symbol Ann -> Ann
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Type Symbol Ann
typ
              Context.FreeVarsInTypeAnnotation Set (TypeVar Symbol Ann)
_set -> [(Range, [(Text, Range)])]
forall a. [a]
todoAnnotation
              Context.UnannotatedReference TypeReference
_ref -> [(Range, [(Text, Range)])]
forall a. [a]
todoAnnotation
              Context.MalformedPattern Pattern Ann
pat -> Ann -> [(Range, [(Text, Range)])]
forall a. Ann -> [(Range, [a])]
singleRange (Ann -> [(Range, [(Text, Range)])])
-> Ann -> [(Range, [(Text, Range)])]
forall a b. (a -> b) -> a -> b
$ Pattern Ann -> Ann
forall loc. Pattern loc -> loc
Pattern.loc Pattern Ann
pat
              Context.UnknownTermReference TypeReference
_ref -> [(Range, [(Text, Range)])]
forall a. [a]
todoAnnotation
              Context.UnknownExistentialVariable Symbol
_sym Context Symbol Ann
_con -> [(Range, [(Text, Range)])]
forall a. [a]
todoAnnotation
              Context.IllegalContextExtension Context Symbol Ann
_con Element Symbol Ann
_el String
_s -> [(Range, [(Text, Range)])]
forall a. [a]
todoAnnotation
              Context.OtherBug String
_s -> [(Range, [(Text, Range)])]
forall a. [a]
todoAnnotation
      ([Diagnostic], [RangedCodeAction])
-> Lsp ([Diagnostic], [RangedCodeAction])
forall a. a -> Lsp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Note Symbol Ann -> [(Range, [(Text, Range)])] -> [Diagnostic]
noteDiagnostic Note Symbol Ann
note [(Range, [(Text, Range)])]
ranges, [])
  where
    -- Diagnostics with this return value haven't been properly configured yet.
    todoAnnotation :: [a]
todoAnnotation = []
    singleRange :: Ann -> [(Range, [a])]
    singleRange :: forall a. Ann -> [(Range, [a])]
singleRange Ann
ann = do
      Range
r <- Ann -> [Range]
aToR Ann
ann
      pure (Range
r, [])

    aToR :: Ann -> [Range]
    aToR :: Ann -> [Range]
aToR = Maybe Range -> [Range]
forall a. Maybe a -> [a]
maybeToList (Maybe Range -> [Range]) -> (Ann -> Maybe Range) -> Ann -> [Range]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann -> Maybe Range
annToRange
    -- >>> withNeighbours [1, 2, 3, 4]
    -- [(1,[2,3,4]),(2,[1,3,4]),(3,[1,2,4]),(4,[1,2,3])]
    withNeighbours :: [a] -> [(a, [a])]
    withNeighbours :: forall a. [a] -> [(a, [a])]
withNeighbours [] = []
    withNeighbours (a
a : [a]
as) = (a
a, [a]
as) (a, [a]) -> [(a, [a])] -> [(a, [a])]
forall a. a -> [a] -> [a]
: (([a] -> [a]) -> (a, [a]) -> (a, [a])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ((a, [a]) -> (a, [a])) -> [(a, [a])] -> [(a, [a])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> [(a, [a])]
forall a. [a] -> [(a, [a])]
withNeighbours [a]
as)
    -- Builds diagnostics for a note, one diagnostic per range.
    noteDiagnostic ::
      Note Symbol Ann ->
      -- All ranges affected by this note, each range may have references to 'related'
      -- ranges.
      -- E.g. a name conflict note might mark each conflicted name, and contain references to the
      -- other conflicted name locations.
      [(Range, [(Text, Range)])] ->
      [Diagnostic]
    noteDiagnostic :: Note Symbol Ann -> [(Range, [(Text, Range)])] -> [Diagnostic]
noteDiagnostic Note Symbol Ann
note [(Range, [(Text, Range)])]
ranges =
      let msg :: Text
msg = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Width -> Pretty ColorText -> String
Pretty.toPlain Width
80 (Pretty ColorText -> String) -> Pretty ColorText -> String
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv -> String -> Note Symbol Ann -> Pretty ColorText
forall v a.
(Var v, Annotated a, Show a, Ord a) =>
PrettyPrintEnv -> String -> Note v a -> Pretty ColorText
PrintError.printNoteWithSource PrettyPrintEnv
ppe String
src Note Symbol Ann
note
       in do
            (Range
range, [(Text, Range)]
references) <- [(Range, [(Text, Range)])]
ranges
            Diagnostic -> [Diagnostic]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Diagnostic -> [Diagnostic]) -> Diagnostic -> [Diagnostic]
forall a b. (a -> b) -> a -> b
$ Uri
-> Range
-> DiagnosticSeverity
-> [DiagnosticTag]
-> Text
-> [(Text, Range)]
-> Diagnostic
mkDiagnostic Uri
fileUri Range
range DiagnosticSeverity
DiagnosticSeverity_Error [] Text
msg [(Text, Range)]
references
    -- Suggest name replacements or qualifications when there's ambiguity
    nameResolutionCodeActions :: [Diagnostic] -> [Context.Suggestion Symbol Ann] -> [RangedCodeAction]
    nameResolutionCodeActions :: [Diagnostic] -> [Suggestion Symbol Ann] -> [RangedCodeAction]
nameResolutionCodeActions [Diagnostic]
diags [Suggestion Symbol Ann]
suggestions = do
      Context.Suggestion {Name
suggestionName :: Name
$sel:suggestionName:Suggestion :: forall v loc. Suggestion v loc -> Name
suggestionName, Type Symbol Ann
suggestionType :: Type Symbol Ann
$sel:suggestionType:Suggestion :: forall v loc. Suggestion v loc -> Type v loc
suggestionType, SuggestionMatch
suggestionMatch :: SuggestionMatch
$sel:suggestionMatch:Suggestion :: forall v loc. Suggestion v loc -> SuggestionMatch
suggestionMatch} <- (Suggestion Symbol Ann -> (Int, Name))
-> [Suggestion Symbol Ann] -> [Suggestion Symbol Ann]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Suggestion Symbol Ann -> (Int, Name)
forall {v} {loc}. Suggestion v loc -> (Int, Name)
nameResolutionSuggestionPriority [Suggestion Symbol Ann]
suggestions
      let prettyType :: String
prettyType = Maybe Width -> PrettyPrintEnv -> Type Symbol Ann -> String
forall v a.
Var v =>
Maybe Width -> PrettyPrintEnv -> Type v a -> String
TypePrinter.prettyStr Maybe Width
forall a. Maybe a
Nothing PrettyPrintEnv
ppe Type Symbol Ann
suggestionType
      let ranges :: [Range]
ranges = ([Diagnostic]
diags [Diagnostic]
-> Getting (Endo [Range]) [Diagnostic] Range -> [Range]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Diagnostic -> Const (Endo [Range]) Diagnostic)
-> [Diagnostic] -> Const (Endo [Range]) [Diagnostic]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int [Diagnostic] Diagnostic
folded ((Diagnostic -> Const (Endo [Range]) Diagnostic)
 -> [Diagnostic] -> Const (Endo [Range]) [Diagnostic])
-> ((Range -> Const (Endo [Range]) Range)
    -> Diagnostic -> Const (Endo [Range]) Diagnostic)
-> Getting (Endo [Range]) [Diagnostic] Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Range -> Const (Endo [Range]) Range)
-> Diagnostic -> Const (Endo [Range]) Diagnostic
forall s a. HasRange s a => Lens' s a
Lens' Diagnostic Range
range)
      let rca :: RangedCodeAction
rca = Text -> [Diagnostic] -> [Range] -> RangedCodeAction
rangedCodeAction (Text
"Use " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
Name.toText Name
suggestionName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" : " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
prettyType) [Diagnostic]
diags [Range]
ranges
      RangedCodeAction -> [RangedCodeAction]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RangedCodeAction -> [RangedCodeAction])
-> RangedCodeAction -> [RangedCodeAction]
forall a b. (a -> b) -> a -> b
$
        RangedCodeAction
rca
          RangedCodeAction
-> (RangedCodeAction -> RangedCodeAction) -> RangedCodeAction
forall a b. a -> (a -> b) -> b
& Uri -> Text -> [Range] -> RangedCodeAction -> RangedCodeAction
includeEdits Uri
fileUri (Name -> Text
Name.toText Name
suggestionName) [Range]
ranges
          RangedCodeAction
-> (RangedCodeAction -> RangedCodeAction) -> RangedCodeAction
forall a b. a -> (a -> b) -> b
& (CodeAction -> Identity CodeAction)
-> RangedCodeAction -> Identity RangedCodeAction
forall s a. HasCodeAction s a => Lens' s a
Lens' RangedCodeAction CodeAction
codeAction ((CodeAction -> Identity CodeAction)
 -> RangedCodeAction -> Identity RangedCodeAction)
-> ((Maybe Bool -> Identity (Maybe Bool))
    -> CodeAction -> Identity CodeAction)
-> (Maybe Bool -> Identity (Maybe Bool))
-> RangedCodeAction
-> Identity RangedCodeAction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Bool -> Identity (Maybe Bool))
-> CodeAction -> Identity CodeAction
forall s a. HasIsPreferred s a => Lens' s a
Lens' CodeAction (Maybe Bool)
isPreferred ((Maybe Bool -> Identity (Maybe Bool))
 -> RangedCodeAction -> Identity RangedCodeAction)
-> Bool -> RangedCodeAction -> RangedCodeAction
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (SuggestionMatch
suggestionMatch SuggestionMatch -> SuggestionMatch -> Bool
forall a. Eq a => a -> a -> Bool
== SuggestionMatch
Context.Exact)

    nameResolutionSuggestionPriority :: Suggestion v loc -> (Int, Name)
nameResolutionSuggestionPriority (Context.Suggestion {SuggestionMatch
$sel:suggestionMatch:Suggestion :: forall v loc. Suggestion v loc -> SuggestionMatch
suggestionMatch :: SuggestionMatch
suggestionMatch, Name
$sel:suggestionName:Suggestion :: forall v loc. Suggestion v loc -> Name
suggestionName :: Name
suggestionName}) = case SuggestionMatch
suggestionMatch of
      SuggestionMatch
Context.Exact -> (Int
0 :: Int, Name
suggestionName)
      SuggestionMatch
Context.WrongType -> (Int
1, Name
suggestionName)
      SuggestionMatch
Context.WrongName -> (Int
2, Name
suggestionName)

    -- typeHoleReplacementCodeActions :: Symbol -> _ -> Lsp [a]
    typeHoleReplacementCodeActions :: [Diagnostic] -> Symbol -> Type Symbol Ann -> Lsp [RangedCodeAction]
typeHoleReplacementCodeActions [Diagnostic]
diags Symbol
v Type Symbol Ann
typ
      | Bool -> Bool
not (Symbol -> Bool
isUserBlank Symbol
v) = [RangedCodeAction] -> Lsp [RangedCodeAction]
forall a. a -> Lsp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      | Bool
otherwise = do
          Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase} <- Lsp Env
forall r (m :: * -> *). MonadReader r m => m r
ask
          let cleanedTyp :: Type Symbol Ann
cleanedTyp = Type Symbol Ann -> Type Symbol Ann
forall v a. Var v => Type v a -> Type v a
Context.generalizeAndUnTypeVar Type Symbol Ann
typ -- TODO: is this right?
          Set Referent
refs <- IO (Set Referent) -> Lsp (Set Referent)
forall a. IO a -> Lsp a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Set Referent) -> Lsp (Set Referent))
-> (Transaction (Set Referent) -> IO (Set Referent))
-> Transaction (Set Referent)
-> Lsp (Set Referent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Codebase IO Symbol Ann
-> Transaction (Set Referent) -> IO (Set Referent)
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase (Transaction (Set Referent) -> Lsp (Set Referent))
-> Transaction (Set Referent) -> Lsp (Set Referent)
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann
-> Type Symbol Ann -> Transaction (Set Referent)
forall v (m :: * -> *) a.
Var v =>
Codebase m v a -> Type v a -> Transaction (Set Referent)
Codebase.termsOfType Codebase IO Symbol Ann
codebase Type Symbol Ann
cleanedTyp
          [Referent]
-> (Referent -> Lsp (Maybe RangedCodeAction))
-> Lsp [RangedCodeAction]
forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
t a -> (a -> f (Maybe b)) -> f (t b)
forMaybe (Set Referent -> [Referent]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set Referent
refs) ((Referent -> Lsp (Maybe RangedCodeAction))
 -> Lsp [RangedCodeAction])
-> (Referent -> Lsp (Maybe RangedCodeAction))
-> Lsp [RangedCodeAction]
forall a b. (a -> b) -> a -> b
$ \Referent
ref -> MaybeT Lsp RangedCodeAction -> Lsp (Maybe RangedCodeAction)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT Lsp RangedCodeAction -> Lsp (Maybe RangedCodeAction))
-> MaybeT Lsp RangedCodeAction -> Lsp (Maybe RangedCodeAction)
forall a b. (a -> b) -> a -> b
$ do
            HashQualified Name
hqNameSuggestion <- Lsp (Maybe (HashQualified Name)) -> MaybeT Lsp (HashQualified Name)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Lsp (Maybe (HashQualified Name))
 -> MaybeT Lsp (HashQualified Name))
-> (Maybe (HashQualified Name) -> Lsp (Maybe (HashQualified Name)))
-> Maybe (HashQualified Name)
-> MaybeT Lsp (HashQualified Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (HashQualified Name) -> Lsp (Maybe (HashQualified Name))
forall a. a -> Lsp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (HashQualified Name) -> MaybeT Lsp (HashQualified Name))
-> Maybe (HashQualified Name) -> MaybeT Lsp (HashQualified Name)
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv -> Referent -> Maybe (HashQualified Name)
PPE.terms PrettyPrintEnv
ppe Referent
ref
            Type Symbol Ann
typ <- Lsp (Maybe (Type Symbol Ann)) -> MaybeT Lsp (Type Symbol Ann)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Lsp (Maybe (Type Symbol Ann)) -> MaybeT Lsp (Type Symbol Ann))
-> (Transaction (Maybe (Type Symbol Ann))
    -> Lsp (Maybe (Type Symbol Ann)))
-> Transaction (Maybe (Type Symbol Ann))
-> MaybeT Lsp (Type Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe (Type Symbol Ann)) -> Lsp (Maybe (Type Symbol Ann))
forall a. IO a -> Lsp a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Type Symbol Ann)) -> Lsp (Maybe (Type Symbol Ann)))
-> (Transaction (Maybe (Type Symbol Ann))
    -> IO (Maybe (Type Symbol Ann)))
-> Transaction (Maybe (Type Symbol Ann))
-> Lsp (Maybe (Type Symbol Ann))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Codebase IO Symbol Ann
-> Transaction (Maybe (Type Symbol Ann))
-> IO (Maybe (Type Symbol Ann))
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase (Transaction (Maybe (Type Symbol Ann))
 -> MaybeT Lsp (Type Symbol Ann))
-> Transaction (Maybe (Type Symbol Ann))
-> MaybeT Lsp (Type Symbol Ann)
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann
-> Referent -> Transaction (Maybe (Type Symbol Ann))
forall a (m :: * -> *).
BuiltinAnnotation a =>
Codebase m Symbol a
-> Referent -> Transaction (Maybe (Type Symbol a))
Codebase.getTypeOfReferent Codebase IO Symbol Ann
codebase Referent
ref
            let prettyType :: String
prettyType = Maybe Width -> PrettyPrintEnv -> Type Symbol Ann -> String
forall v a.
Var v =>
Maybe Width -> PrettyPrintEnv -> Type v a -> String
TypePrinter.prettyStr Maybe Width
forall a. Maybe a
Nothing PrettyPrintEnv
ppe Type Symbol Ann
typ
            let txtName :: Text
txtName = HashQualified Name -> Text
HQ'.toText HashQualified Name
hqNameSuggestion
            let ranges :: [Range]
ranges = ([Diagnostic]
diags [Diagnostic]
-> Getting (Endo [Range]) [Diagnostic] Range -> [Range]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Diagnostic -> Const (Endo [Range]) Diagnostic)
-> [Diagnostic] -> Const (Endo [Range]) [Diagnostic]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int [Diagnostic] Diagnostic
folded ((Diagnostic -> Const (Endo [Range]) Diagnostic)
 -> [Diagnostic] -> Const (Endo [Range]) [Diagnostic])
-> ((Range -> Const (Endo [Range]) Range)
    -> Diagnostic -> Const (Endo [Range]) Diagnostic)
-> Getting (Endo [Range]) [Diagnostic] Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Range -> Const (Endo [Range]) Range)
-> Diagnostic -> Const (Endo [Range]) Diagnostic
forall s a. HasRange s a => Lens' s a
Lens' Diagnostic Range
range)
            let rca :: RangedCodeAction
rca = Text -> [Diagnostic] -> [Range] -> RangedCodeAction
rangedCodeAction (Text
"Use " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txtName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" : " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
prettyType) [Diagnostic]
diags [Range]
ranges
            RangedCodeAction -> MaybeT Lsp RangedCodeAction
forall a. a -> MaybeT Lsp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RangedCodeAction -> MaybeT Lsp RangedCodeAction)
-> RangedCodeAction -> MaybeT Lsp RangedCodeAction
forall a b. (a -> b) -> a -> b
$ Uri -> Text -> [Range] -> RangedCodeAction -> RangedCodeAction
includeEdits Uri
fileUri Text
txtName [Range]
ranges RangedCodeAction
rca
    isUserBlank :: Symbol -> Bool
    isUserBlank :: Symbol -> Bool
isUserBlank Symbol
v = case Symbol -> Type
forall v. Var v => v -> Type
Var.typeOf Symbol
v of
      Var.User Text
name -> Text -> Text -> Bool
Text.isPrefixOf Text
"_" Text
name
      Type
_ -> Bool
False

toRangeMap :: (Foldable f) => f (Range, a) -> IntervalMap Position [a]
toRangeMap :: forall (f :: * -> *) a.
Foldable f =>
f (Range, a) -> IntervalMap Position [a]
toRangeMap f (Range, a)
vs =
  ([a] -> [a] -> [a])
-> [(Interval Position, [a])]
-> IntervalMap (Interval Position) [a]
forall k e a.
(Interval k e, Ord k) =>
(a -> a -> a) -> [(k, a)] -> IntervalMap k a
IM.fromListWith [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
(<>) (f (Range, a) -> [(Range, a)]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (Range, a)
vs [(Range, a)]
-> ((Range, a) -> (Interval Position, [a]))
-> [(Interval Position, [a])]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Range
r, a
a) -> (Range -> Interval Position
rangeToInterval Range
r, [a
a]))

getFileAnalysis :: Uri -> MaybeT Lsp FileAnalysis
getFileAnalysis :: Uri -> MaybeT Lsp FileAnalysis
getFileAnalysis Uri
uri = do
  TVar (Map Uri (TMVar FileAnalysis))
checkedFilesV <- (Env -> TVar (Map Uri (TMVar FileAnalysis)))
-> MaybeT Lsp (TVar (Map Uri (TMVar FileAnalysis)))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> TVar (Map Uri (TMVar FileAnalysis))
checkedFilesVar
  -- Try to get the file analysis, if there's a var, then read it, waiting if necessary
  -- If there's no var, add one and wait for it to be filled (all Uris should be analyzed
  -- eventually unless theres some bug in the VFS).
  TMVar FileAnalysis
tmvar <- STM (TMVar FileAnalysis) -> MaybeT Lsp (TMVar FileAnalysis)
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically do
    Map Uri (TMVar FileAnalysis)
checkedFiles <- TVar (Map Uri (TMVar FileAnalysis))
-> STM (Map Uri (TMVar FileAnalysis))
forall a. TVar a -> STM a
readTVar TVar (Map Uri (TMVar FileAnalysis))
checkedFilesV
    case Uri -> Map Uri (TMVar FileAnalysis) -> Maybe (TMVar FileAnalysis)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Uri
uri Map Uri (TMVar FileAnalysis)
checkedFiles of
      Maybe (TMVar FileAnalysis)
Nothing -> do
        TMVar FileAnalysis
mvar <- STM (TMVar FileAnalysis)
forall a. STM (TMVar a)
newEmptyTMVar
        DebugFlag -> String -> Uri -> STM ()
forall a (m :: * -> *).
(Show a, Monad m) =>
DebugFlag -> String -> a -> m ()
Debug.debugM DebugFlag
Debug.LSP String
"File analysis requested but none available, waiting for analysis for" Uri
uri
        TVar (Map Uri (TMVar FileAnalysis))
-> Map Uri (TMVar FileAnalysis) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Map Uri (TMVar FileAnalysis))
checkedFilesV (Map Uri (TMVar FileAnalysis) -> STM ())
-> Map Uri (TMVar FileAnalysis) -> STM ()
forall a b. (a -> b) -> a -> b
$ Uri
-> TMVar FileAnalysis
-> Map Uri (TMVar FileAnalysis)
-> Map Uri (TMVar FileAnalysis)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Uri
uri TMVar FileAnalysis
mvar Map Uri (TMVar FileAnalysis)
checkedFiles
        pure TMVar FileAnalysis
mvar
      Just TMVar FileAnalysis
mvar -> TMVar FileAnalysis -> STM (TMVar FileAnalysis)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TMVar FileAnalysis
mvar
  DebugFlag -> String -> Uri -> MaybeT Lsp ()
forall a (m :: * -> *).
(Show a, Monad m) =>
DebugFlag -> String -> a -> m ()
Debug.debugM DebugFlag
Debug.LSP String
"Waiting on file analysis" Uri
uri
  FileAnalysis
r <- STM FileAnalysis -> MaybeT Lsp FileAnalysis
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (TMVar FileAnalysis -> STM FileAnalysis
forall a. TMVar a -> STM a
readTMVar TMVar FileAnalysis
tmvar)
  DebugFlag -> String -> Uri -> MaybeT Lsp ()
forall a (m :: * -> *).
(Show a, Monad m) =>
DebugFlag -> String -> a -> m ()
Debug.debugM DebugFlag
Debug.LSP String
"Got file analysis" Uri
uri
  pure FileAnalysis
r

-- | Build a Names from a file if it's parseable.
--
-- If the file typechecks, generate names from that,
-- otherwise, generate names from the 'parsed' file. Note that the
-- names for a parsed file contains only names for parts of decls, since
-- we don't know references within terms before typechecking due to TDNR.
-- This should be fine though, since those references will all be kept in the
-- ABT as symbols anyways.
--
-- See UF.toNames and UF.typecheckedToNames for more info.
getFileNames :: Uri -> MaybeT Lsp Names
getFileNames :: Uri -> MaybeT Lsp Names
getFileNames Uri
fileUri = do
  FileAnalysis {$sel:typecheckedFile:FileAnalysis :: FileAnalysis -> Maybe (TypecheckedUnisonFile Symbol Ann)
typecheckedFile = Maybe (TypecheckedUnisonFile Symbol Ann)
tf, $sel:parsedFile:FileAnalysis :: FileAnalysis -> Maybe (UnisonFile Symbol Ann)
parsedFile = Maybe (UnisonFile Symbol Ann)
pf} <- Uri -> MaybeT Lsp FileAnalysis
getFileAnalysis Uri
fileUri
  Maybe Names -> MaybeT Lsp Names
forall (m :: * -> *) a. Applicative m => Maybe a -> MaybeT m a
hoistMaybe ((TypecheckedUnisonFile Symbol Ann -> Names)
-> Maybe (TypecheckedUnisonFile Symbol Ann) -> Maybe Names
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypecheckedUnisonFile Symbol Ann -> Names
forall v a. Var v => TypecheckedUnisonFile v a -> Names
UF.typecheckedToNames Maybe (TypecheckedUnisonFile Symbol Ann)
tf Maybe Names -> Maybe Names -> Maybe Names
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (UnisonFile Symbol Ann -> Names)
-> Maybe (UnisonFile Symbol Ann) -> Maybe Names
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnisonFile Symbol Ann -> Names
forall v a. Var v => UnisonFile v a -> Names
UF.toNames Maybe (UnisonFile Symbol Ann)
pf)

getFileSummary :: Uri -> MaybeT Lsp FileSummary
getFileSummary :: Uri -> MaybeT Lsp FileSummary
getFileSummary Uri
uri = do
  FileAnalysis {Maybe FileSummary
$sel:fileSummary:FileAnalysis :: FileAnalysis -> Maybe FileSummary
fileSummary :: Maybe FileSummary
fileSummary} <- Uri -> MaybeT Lsp FileAnalysis
getFileAnalysis Uri
uri
  Lsp (Maybe FileSummary) -> MaybeT Lsp FileSummary
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Lsp (Maybe FileSummary) -> MaybeT Lsp FileSummary)
-> (Maybe FileSummary -> Lsp (Maybe FileSummary))
-> Maybe FileSummary
-> MaybeT Lsp FileSummary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FileSummary -> Lsp (Maybe FileSummary)
forall a. a -> Lsp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FileSummary -> MaybeT Lsp FileSummary)
-> Maybe FileSummary -> MaybeT Lsp FileSummary
forall a b. (a -> b) -> a -> b
$ Maybe FileSummary
fileSummary

-- TODO memoize per file
ppedForFile :: Uri -> Lsp PPED.PrettyPrintEnvDecl
ppedForFile :: Uri -> Lsp PrettyPrintEnvDecl
ppedForFile Uri
fileUri = do
  MaybeT Lsp FileAnalysis -> Lsp (Maybe FileAnalysis)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (Uri -> MaybeT Lsp FileAnalysis
getFileAnalysis Uri
fileUri) Lsp (Maybe FileAnalysis)
-> (Maybe FileAnalysis -> Lsp PrettyPrintEnvDecl)
-> Lsp PrettyPrintEnvDecl
forall a b. Lsp a -> (a -> Lsp b) -> Lsp b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (FileAnalysis {$sel:typecheckedFile:FileAnalysis :: FileAnalysis -> Maybe (TypecheckedUnisonFile Symbol Ann)
typecheckedFile = Maybe (TypecheckedUnisonFile Symbol Ann)
tf, $sel:parsedFile:FileAnalysis :: FileAnalysis -> Maybe (UnisonFile Symbol Ann)
parsedFile = Maybe (UnisonFile Symbol Ann)
uf}) ->
      Maybe (UnisonFile Symbol Ann)
-> Maybe (TypecheckedUnisonFile Symbol Ann)
-> Lsp PrettyPrintEnvDecl
forall a.
Maybe (UnisonFile Symbol a)
-> Maybe (TypecheckedUnisonFile Symbol a) -> Lsp PrettyPrintEnvDecl
ppedForFileHelper Maybe (UnisonFile Symbol Ann)
uf Maybe (TypecheckedUnisonFile Symbol Ann)
tf
    Maybe FileAnalysis
_ -> Maybe (UnisonFile Symbol Any)
-> Maybe (TypecheckedUnisonFile Symbol Any)
-> Lsp PrettyPrintEnvDecl
forall a.
Maybe (UnisonFile Symbol a)
-> Maybe (TypecheckedUnisonFile Symbol a) -> Lsp PrettyPrintEnvDecl
ppedForFileHelper Maybe (UnisonFile Symbol Any)
forall a. Maybe a
Nothing Maybe (TypecheckedUnisonFile Symbol Any)
forall a. Maybe a
Nothing

ppedForFileHelper :: Maybe (UF.UnisonFile Symbol a) -> Maybe (UF.TypecheckedUnisonFile Symbol a) -> Lsp PPED.PrettyPrintEnvDecl
ppedForFileHelper :: forall a.
Maybe (UnisonFile Symbol a)
-> Maybe (TypecheckedUnisonFile Symbol a) -> Lsp PrettyPrintEnvDecl
ppedForFileHelper Maybe (UnisonFile Symbol a)
uf Maybe (TypecheckedUnisonFile Symbol a)
tf = do
  PrettyPrintEnvDecl
codebasePPED <- Lsp PrettyPrintEnvDecl
currentPPED
  Int
hashLen <- (Env -> Codebase IO Symbol Ann) -> Lsp (Codebase IO Symbol Ann)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Codebase IO Symbol Ann
codebase Lsp (Codebase IO Symbol Ann)
-> (Codebase IO Symbol Ann -> Lsp Int) -> Lsp Int
forall a b. Lsp a -> (a -> Lsp b) -> Lsp b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Codebase IO Symbol Ann
codebase -> IO Int -> Lsp Int
forall a. IO a -> Lsp a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Codebase IO Symbol Ann -> Transaction Int -> IO Int
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase Transaction Int
Codebase.hashLength)
  pure $ case (Maybe (UnisonFile Symbol a)
uf, Maybe (TypecheckedUnisonFile Symbol a)
tf) of
    (Maybe (UnisonFile Symbol a)
Nothing, Maybe (TypecheckedUnisonFile Symbol a)
Nothing) -> PrettyPrintEnvDecl
codebasePPED
    (Maybe (UnisonFile Symbol a)
_, Just TypecheckedUnisonFile Symbol a
tf) ->
      let fileNames :: Names
fileNames = TypecheckedUnisonFile Symbol a -> Names
forall v a. Var v => TypecheckedUnisonFile v a -> Names
UF.typecheckedToNames TypecheckedUnisonFile Symbol a
tf
          filePPED :: PrettyPrintEnvDecl
filePPED = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
hashLen Names
fileNames) (Names -> Suffixifier
PPE.suffixifyByHash Names
fileNames)
       in PrettyPrintEnvDecl
filePPED PrettyPrintEnvDecl -> PrettyPrintEnvDecl -> PrettyPrintEnvDecl
`PPED.addFallback` PrettyPrintEnvDecl
codebasePPED
    (Just UnisonFile Symbol a
uf, Maybe (TypecheckedUnisonFile Symbol a)
_) ->
      let fileNames :: Names
fileNames = UnisonFile Symbol a -> Names
forall v a. Var v => UnisonFile v a -> Names
UF.toNames UnisonFile Symbol a
uf
          filePPED :: PrettyPrintEnvDecl
filePPED = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
hashLen Names
fileNames) (Names -> Suffixifier
PPE.suffixifyByHash Names
fileNames)
       in PrettyPrintEnvDecl
filePPED PrettyPrintEnvDecl -> PrettyPrintEnvDecl -> PrettyPrintEnvDecl
`PPED.addFallback` PrettyPrintEnvDecl
codebasePPED

mkTypeSignatureHints :: UF.UnisonFile Symbol Ann -> UF.TypecheckedUnisonFile Symbol Ann -> Map Symbol TypeSignatureHint
mkTypeSignatureHints :: UnisonFile Symbol Ann
-> TypecheckedUnisonFile Symbol Ann -> Map Symbol TypeSignatureHint
mkTypeSignatureHints UnisonFile Symbol Ann
parsedFile TypecheckedUnisonFile Symbol Ann
typecheckedFile = do
  let symbolsWithoutTypeSigs :: Map Symbol Ann
      symbolsWithoutTypeSigs :: Map Symbol Ann
symbolsWithoutTypeSigs =
        Map Symbol (Ann, Term Symbol Ann)
-> [(Symbol, (Ann, Term Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList (UnisonFile Symbol Ann -> Map Symbol (Ann, Term Symbol Ann)
forall v a. UnisonFile v a -> Map v (a, Term v a)
UF.terms UnisonFile Symbol Ann
parsedFile)
          [(Symbol, (Ann, Term Symbol Ann))]
-> ([(Symbol, (Ann, Term Symbol Ann))] -> [(Symbol, Ann)])
-> [(Symbol, Ann)]
forall a b. a -> (a -> b) -> b
& ((Symbol, (Ann, Term Symbol Ann)) -> Maybe (Symbol, Ann))
-> [(Symbol, (Ann, Term Symbol Ann))] -> [(Symbol, Ann)]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe
            ( \(Symbol
v, (Ann
ann, Term Symbol Ann
trm)) -> do
                -- We only want hints for terms without a user signature
                Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Maybe (Type Symbol Ann) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (Type Symbol Ann) -> Bool)
-> Maybe (Type Symbol Ann) -> Bool
forall a b. (a -> b) -> a -> b
$ Term Symbol Ann -> Maybe (Type Symbol Ann)
forall v a. Term v a -> Maybe (Type v a)
Term.getTypeAnnotation Term Symbol Ann
trm)
                pure (Symbol
v, Ann
ann)
            )
          [(Symbol, Ann)]
-> ([(Symbol, Ann)] -> Map Symbol Ann) -> Map Symbol Ann
forall a b. a -> (a -> b) -> b
& [(Symbol, Ann)] -> Map Symbol Ann
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      typeHints :: Map Symbol TypeSignatureHint
typeHints =
        TypecheckedUnisonFile Symbol Ann
typecheckedFile
          TypecheckedUnisonFile Symbol Ann
-> (TypecheckedUnisonFile Symbol Ann
    -> Map
         Symbol (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann))
-> Map
     Symbol (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann)
forall a b. a -> (a -> b) -> b
& TypecheckedUnisonFile Symbol Ann
-> Map
     Symbol (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (a, Id, Maybe String, Term v a, Type v a)
UF.hashTermsId
          Map
  Symbol (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann)
-> (Map
      Symbol (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann)
    -> Map
         Symbol
         (Ann, (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann)))
-> Map
     Symbol
     (Ann, (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann))
forall a b. a -> (a -> b) -> b
& Map Symbol Ann
-> Map
     Symbol (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann)
-> Map
     Symbol
     (Ann, (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann))
forall a b. Map Symbol a -> Map Symbol b -> Map Symbol (a, b)
forall (f :: * -> *) a b. Zip f => f a -> f b -> f (a, b)
Zip.zip Map Symbol Ann
symbolsWithoutTypeSigs
          Map
  Symbol
  (Ann, (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann))
-> (Map
      Symbol
      (Ann, (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann))
    -> Map Symbol TypeSignatureHint)
-> Map Symbol TypeSignatureHint
forall a b. a -> (a -> b) -> b
& (Symbol
 -> (Ann, (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann))
 -> Maybe TypeSignatureHint)
-> Map
     Symbol
     (Ann, (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann))
-> Map Symbol TypeSignatureHint
forall a b.
(Symbol -> a -> Maybe b) -> Map Symbol a -> Map Symbol b
forall i (t :: * -> *) a b.
FilterableWithIndex i t =>
(i -> a -> Maybe b) -> t a -> t b
imapMaybe
            ( \Symbol
v (Ann
ann, (Ann
_ann, Id
ref, Maybe String
_wk, Term Symbol Ann
_trm, Type Symbol Ann
typ)) -> do
                Name
name <- Text -> Maybe Name
Name.parseText (Symbol -> Text
forall v. Var v => v -> Text
Var.name Symbol
v)
                Range
range <- Ann -> Maybe Range
annToRange Ann
ann
                let newRangeEnd :: Position
newRangeEnd =
                      Range
range Range -> Getting Position Range Position -> Position
forall s a. s -> Getting a s a -> a
^. Getting Position Range Position
forall s a. HasStart s a => Lens' s a
Lens' Range Position
LSPTypes.start
                        Position -> (Position -> Position) -> Position
forall a b. a -> (a -> b) -> b
& (UInt -> Identity UInt) -> Position -> Identity Position
forall s a. HasCharacter s a => Lens' s a
Lens' Position UInt
LSPTypes.character ((UInt -> Identity UInt) -> Position -> Identity Position)
-> UInt -> Position -> Position
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
Text.length (Name -> Text
Name.toText Name
name))
                let newRange :: Range
newRange = Range
range Range -> (Range -> Range) -> Range
forall a b. a -> (a -> b) -> b
& (Position -> Identity Position) -> Range -> Identity Range
forall s a. HasEnd s a => Lens' s a
Lens' Range Position
LSPTypes.end ((Position -> Identity Position) -> Range -> Identity Range)
-> Position -> Range -> Range
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Position
newRangeEnd
                TypeSignatureHint -> Maybe TypeSignatureHint
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeSignatureHint -> Maybe TypeSignatureHint)
-> TypeSignatureHint -> Maybe TypeSignatureHint
forall a b. (a -> b) -> a -> b
$ Name -> Referent -> Range -> Type Symbol Ann -> TypeSignatureHint
TypeSignatureHint Name
name (Id -> Referent
Referent.fromTermReferenceId Id
ref) Range
newRange Type Symbol Ann
typ
            )
   in Map Symbol TypeSignatureHint
typeHints