{-# LANGUAGE DataKinds #-}

-- | Rewrites of some codebase queries, but which check the scratch file for info first.
module Unison.LSP.Queries
  ( markdownDocsForFQN,
    getTypeOfReferent,
    getTypeDeclaration,
    refAtPosition,
    nodeAtPosition,
    refInTerm,
    refInType,
    findSmallestEnclosingNode,
    findSmallestEnclosingType,
    refInDecl,
    SourceNode (..),
  )
where

import Control.Lens
import Control.Lens qualified as Lens
import Control.Monad.Reader
import Data.Generics.Product (field)
import Language.LSP.Protocol.Types
import Unison.ABT qualified as ABT
import Unison.Builtin.Decls qualified as Builtins
import Unison.Codebase qualified as Codebase
import Unison.ConstructorReference (GConstructorReference (..))
import Unison.ConstructorType qualified as CT
import Unison.DataDeclaration (Decl)
import Unison.DataDeclaration qualified as DD
import Unison.HashQualified qualified as HQ
import Unison.LSP.Conversions (lspToUPos)
import Unison.LSP.FileAnalysis (getFileSummary, ppedForFile)
import Unison.LSP.Orphans ()
import Unison.LSP.Types
import Unison.LabeledDependency
import Unison.LabeledDependency qualified as LD
import Unison.Lexer.Pos (Pos (..))
import Unison.Name (Name)
import Unison.NamesWithHistory (SearchType (..))
import Unison.Parser.Ann (Ann)
import Unison.Parser.Ann qualified as Ann
import Unison.Pattern qualified as Pattern
import Unison.Prelude
import Unison.Reference (TypeReference)
import Unison.Reference qualified as Reference
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Server.Backend qualified as Backend
import Unison.Server.Doc.Markdown.Render qualified as Md
import Unison.Server.Doc.Markdown.Types qualified as Md
import Unison.Symbol (Symbol)
import Unison.Syntax.Parser (ann)
import Unison.Term (MatchCase (MatchCase), Term)
import Unison.Term qualified as Term
import Unison.Type (Type)
import Unison.Type qualified as Type
import Unison.UnisonFile.Summary (FileSummary (..))
import Unison.Util.Pretty qualified as Pretty

-- | Returns a reference to whatever the symbol at the given position refers to.
refAtPosition :: Uri -> Position -> MaybeT Lsp LabeledDependency
refAtPosition :: Uri -> Position -> MaybeT Lsp LabeledDependency
refAtPosition Uri
uri Position
pos = do
  MaybeT Lsp LabeledDependency
findInNode MaybeT Lsp LabeledDependency
-> MaybeT Lsp LabeledDependency -> MaybeT Lsp LabeledDependency
forall a. MaybeT Lsp a -> MaybeT Lsp a -> MaybeT Lsp a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MaybeT Lsp LabeledDependency
findInDecl
  where
    findInNode :: MaybeT Lsp LabeledDependency
    findInNode :: MaybeT Lsp LabeledDependency
findInNode =
      Uri -> Position -> MaybeT Lsp (SourceNode Ann)
nodeAtPosition Uri
uri Position
pos MaybeT Lsp (SourceNode Ann)
-> (SourceNode Ann -> MaybeT Lsp LabeledDependency)
-> MaybeT Lsp LabeledDependency
forall a b. MaybeT Lsp a -> (a -> MaybeT Lsp b) -> MaybeT Lsp b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        TermNode Term Symbol Ann
term -> Maybe LabeledDependency -> MaybeT Lsp LabeledDependency
forall a. Maybe a -> MaybeT Lsp a
hoistMaybe (Maybe LabeledDependency -> MaybeT Lsp LabeledDependency)
-> Maybe LabeledDependency -> MaybeT Lsp LabeledDependency
forall a b. (a -> b) -> a -> b
$ Term Symbol Ann -> Maybe LabeledDependency
forall v a. Term v a -> Maybe LabeledDependency
refInTerm Term Symbol Ann
term
        TypeNode Type Symbol Ann
typ -> Maybe LabeledDependency -> MaybeT Lsp LabeledDependency
forall a. Maybe a -> MaybeT Lsp a
hoistMaybe (Maybe LabeledDependency -> MaybeT Lsp LabeledDependency)
-> Maybe LabeledDependency -> MaybeT Lsp LabeledDependency
forall a b. (a -> b) -> a -> b
$ (TypeReference -> LabeledDependency)
-> Maybe TypeReference -> Maybe LabeledDependency
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeReference -> LabeledDependency
TypeReference (Type Symbol Ann -> Maybe TypeReference
forall v a. Type v a -> Maybe TypeReference
refInType Type Symbol Ann
typ)
        PatternNode Pattern Ann
pat -> Maybe LabeledDependency -> MaybeT Lsp LabeledDependency
forall a. Maybe a -> MaybeT Lsp a
hoistMaybe (Maybe LabeledDependency -> MaybeT Lsp LabeledDependency)
-> Maybe LabeledDependency -> MaybeT Lsp LabeledDependency
forall a b. (a -> b) -> a -> b
$ Pattern Ann -> Maybe LabeledDependency
forall a. Pattern a -> Maybe LabeledDependency
refInPattern Pattern Ann
pat
    findInDecl :: MaybeT Lsp LabeledDependency
    findInDecl :: MaybeT Lsp LabeledDependency
findInDecl =
      TypeReference -> LabeledDependency
LD.TypeReference (TypeReference -> LabeledDependency)
-> MaybeT Lsp TypeReference -> MaybeT Lsp LabeledDependency
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        let uPos :: Pos
uPos = Position -> Pos
lspToUPos Position
pos
        (FileSummary {Map Symbol (Id, DataDeclaration Symbol Ann)
dataDeclsBySymbol :: Map Symbol (Id, DataDeclaration Symbol Ann)
$sel:dataDeclsBySymbol:FileSummary :: FileSummary -> Map Symbol (Id, DataDeclaration Symbol Ann)
dataDeclsBySymbol, Map Symbol (Id, EffectDeclaration Symbol Ann)
effectDeclsBySymbol :: Map Symbol (Id, EffectDeclaration Symbol Ann)
$sel:effectDeclsBySymbol:FileSummary :: FileSummary -> Map Symbol (Id, EffectDeclaration Symbol Ann)
effectDeclsBySymbol}) <- Uri -> MaybeT Lsp FileSummary
getFileSummary Uri
uri
        ( ((Id, DataDeclaration Symbol Ann) -> MaybeT Lsp TypeReference)
-> Map Symbol (Id, DataDeclaration Symbol Ann)
-> MaybeT Lsp TypeReference
forall (f :: * -> *) (t :: * -> *) a b.
(Alternative f, Foldable t) =>
(a -> f b) -> t a -> f b
altMap (Maybe TypeReference -> MaybeT Lsp TypeReference
forall a. Maybe a -> MaybeT Lsp a
hoistMaybe (Maybe TypeReference -> MaybeT Lsp TypeReference)
-> ((Id, DataDeclaration Symbol Ann) -> Maybe TypeReference)
-> (Id, DataDeclaration Symbol Ann)
-> MaybeT Lsp TypeReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Decl Symbol Ann -> Maybe TypeReference
refInDecl Pos
uPos (Decl Symbol Ann -> Maybe TypeReference)
-> ((Id, DataDeclaration Symbol Ann) -> Decl Symbol Ann)
-> (Id, DataDeclaration Symbol Ann)
-> Maybe TypeReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDeclaration Symbol Ann -> Decl Symbol Ann
forall a b. b -> Either a b
Right (DataDeclaration Symbol Ann -> Decl Symbol Ann)
-> ((Id, DataDeclaration Symbol Ann) -> DataDeclaration Symbol Ann)
-> (Id, DataDeclaration Symbol Ann)
-> Decl Symbol Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Id, DataDeclaration Symbol Ann) -> DataDeclaration Symbol Ann
forall a b. (a, b) -> b
snd) Map Symbol (Id, DataDeclaration Symbol Ann)
dataDeclsBySymbol
            MaybeT Lsp TypeReference
-> MaybeT Lsp TypeReference -> MaybeT Lsp TypeReference
forall a. MaybeT Lsp a -> MaybeT Lsp a -> MaybeT Lsp a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Id, EffectDeclaration Symbol Ann) -> MaybeT Lsp TypeReference)
-> Map Symbol (Id, EffectDeclaration Symbol Ann)
-> MaybeT Lsp TypeReference
forall (f :: * -> *) (t :: * -> *) a b.
(Alternative f, Foldable t) =>
(a -> f b) -> t a -> f b
altMap (Maybe TypeReference -> MaybeT Lsp TypeReference
forall a. Maybe a -> MaybeT Lsp a
hoistMaybe (Maybe TypeReference -> MaybeT Lsp TypeReference)
-> ((Id, EffectDeclaration Symbol Ann) -> Maybe TypeReference)
-> (Id, EffectDeclaration Symbol Ann)
-> MaybeT Lsp TypeReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Decl Symbol Ann -> Maybe TypeReference
refInDecl Pos
uPos (Decl Symbol Ann -> Maybe TypeReference)
-> ((Id, EffectDeclaration Symbol Ann) -> Decl Symbol Ann)
-> (Id, EffectDeclaration Symbol Ann)
-> Maybe TypeReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EffectDeclaration Symbol Ann -> Decl Symbol Ann
forall a b. a -> Either a b
Left (EffectDeclaration Symbol Ann -> Decl Symbol Ann)
-> ((Id, EffectDeclaration Symbol Ann)
    -> EffectDeclaration Symbol Ann)
-> (Id, EffectDeclaration Symbol Ann)
-> Decl Symbol Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Id, EffectDeclaration Symbol Ann) -> EffectDeclaration Symbol Ann
forall a b. (a, b) -> b
snd) Map Symbol (Id, EffectDeclaration Symbol Ann)
effectDeclsBySymbol
          )
    hoistMaybe :: Maybe a -> MaybeT Lsp a
    hoistMaybe :: forall a. Maybe a -> MaybeT Lsp a
hoistMaybe = Lsp (Maybe a) -> MaybeT Lsp a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Lsp (Maybe a) -> MaybeT Lsp a)
-> (Maybe a -> Lsp (Maybe a)) -> Maybe a -> MaybeT Lsp a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> Lsp (Maybe a)
forall a. a -> Lsp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Gets the type of a reference from either the parsed file or the codebase.
getTypeOfReferent :: Uri -> Referent -> MaybeT Lsp (Type Symbol Ann)
getTypeOfReferent :: Uri -> Referent -> MaybeT Lsp (Type Symbol Ann)
getTypeOfReferent Uri
fileUri Referent
ref = do
  MaybeT Lsp (Type Symbol Ann)
getFromFile MaybeT Lsp (Type Symbol Ann)
-> MaybeT Lsp (Type Symbol Ann) -> MaybeT Lsp (Type Symbol Ann)
forall a. MaybeT Lsp a -> MaybeT Lsp a -> MaybeT Lsp a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MaybeT Lsp (Type Symbol Ann)
getFromCodebase
  where
    getFromFile :: MaybeT Lsp (Type Symbol Ann)
getFromFile = do
      FileSummary {Map
  (Maybe Id)
  (Map Symbol (Ann, Term Symbol Ann, Maybe (Type Symbol Ann)))
termsByReference :: Map
  (Maybe Id)
  (Map Symbol (Ann, Term Symbol Ann, Maybe (Type Symbol Ann)))
$sel:termsByReference:FileSummary :: FileSummary
-> Map
     (Maybe Id)
     (Map Symbol (Ann, Term Symbol Ann, Maybe (Type Symbol Ann)))
termsByReference} <- Uri -> MaybeT Lsp FileSummary
getFileSummary Uri
fileUri
      case Referent
ref of
        Referent.Ref (Reference.Builtin {}) -> MaybeT Lsp (Type Symbol Ann)
forall a. MaybeT Lsp a
forall (f :: * -> *) a. Alternative f => f a
empty
        Referent.Ref (Reference.DerivedId Id
termRefId) -> do
          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))
-> (Maybe (Type Symbol Ann) -> Lsp (Maybe (Type Symbol Ann)))
-> Maybe (Type Symbol Ann)
-> MaybeT Lsp (Type Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Type Symbol Ann) -> Lsp (Maybe (Type Symbol Ann))
forall a. a -> Lsp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Type Symbol Ann) -> MaybeT Lsp (Type Symbol Ann))
-> Maybe (Type Symbol Ann) -> MaybeT Lsp (Type Symbol Ann)
forall a b. (a -> b) -> a -> b
$ (Map
  (Maybe Id)
  (Map Symbol (Ann, Term Symbol Ann, Maybe (Type Symbol Ann)))
termsByReference Map
  (Maybe Id)
  (Map Symbol (Ann, Term Symbol Ann, Maybe (Type Symbol Ann)))
-> Getting
     (First (Type Symbol Ann))
     (Map
        (Maybe Id)
        (Map Symbol (Ann, Term Symbol Ann, Maybe (Type Symbol Ann))))
     (Type Symbol Ann)
-> Maybe (Type Symbol Ann)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Index
  (Map
     (Maybe Id)
     (Map Symbol (Ann, Term Symbol Ann, Maybe (Type Symbol Ann))))
-> Traversal'
     (Map
        (Maybe Id)
        (Map Symbol (Ann, Term Symbol Ann, Maybe (Type Symbol Ann))))
     (IxValue
        (Map
           (Maybe Id)
           (Map Symbol (Ann, Term Symbol Ann, Maybe (Type Symbol Ann)))))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Id -> Maybe Id
forall a. a -> Maybe a
Just Id
termRefId) ((Map Symbol (Ann, Term Symbol Ann, Maybe (Type Symbol Ann))
  -> Const
       (First (Type Symbol Ann))
       (Map Symbol (Ann, Term Symbol Ann, Maybe (Type Symbol Ann))))
 -> Map
      (Maybe Id)
      (Map Symbol (Ann, Term Symbol Ann, Maybe (Type Symbol Ann)))
 -> Const
      (First (Type Symbol Ann))
      (Map
         (Maybe Id)
         (Map Symbol (Ann, Term Symbol Ann, Maybe (Type Symbol Ann)))))
-> ((Type Symbol Ann
     -> Const (First (Type Symbol Ann)) (Type Symbol Ann))
    -> Map Symbol (Ann, Term Symbol Ann, Maybe (Type Symbol Ann))
    -> Const
         (First (Type Symbol Ann))
         (Map Symbol (Ann, Term Symbol Ann, Maybe (Type Symbol Ann))))
-> Getting
     (First (Type Symbol Ann))
     (Map
        (Maybe Id)
        (Map Symbol (Ann, Term Symbol Ann, Maybe (Type Symbol Ann))))
     (Type Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ann, Term Symbol Ann, Maybe (Type Symbol Ann))
 -> Const
      (First (Type Symbol Ann))
      (Ann, Term Symbol Ann, Maybe (Type Symbol Ann)))
-> Map Symbol (Ann, Term Symbol Ann, Maybe (Type Symbol Ann))
-> Const
     (First (Type Symbol Ann))
     (Map Symbol (Ann, Term Symbol Ann, Maybe (Type Symbol Ann)))
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold
  Int
  (Map Symbol (Ann, Term Symbol Ann, Maybe (Type Symbol Ann)))
  (Ann, Term Symbol Ann, Maybe (Type Symbol Ann))
folded (((Ann, Term Symbol Ann, Maybe (Type Symbol Ann))
  -> Const
       (First (Type Symbol Ann))
       (Ann, Term Symbol Ann, Maybe (Type Symbol Ann)))
 -> Map Symbol (Ann, Term Symbol Ann, Maybe (Type Symbol Ann))
 -> Const
      (First (Type Symbol Ann))
      (Map Symbol (Ann, Term Symbol Ann, Maybe (Type Symbol Ann))))
-> ((Type Symbol Ann
     -> Const (First (Type Symbol Ann)) (Type Symbol Ann))
    -> (Ann, Term Symbol Ann, Maybe (Type Symbol Ann))
    -> Const
         (First (Type Symbol Ann))
         (Ann, Term Symbol Ann, Maybe (Type Symbol Ann)))
-> (Type Symbol Ann
    -> Const (First (Type Symbol Ann)) (Type Symbol Ann))
-> Map Symbol (Ann, Term Symbol Ann, Maybe (Type Symbol Ann))
-> Const
     (First (Type Symbol Ann))
     (Map Symbol (Ann, Term Symbol Ann, Maybe (Type Symbol Ann)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Type Symbol Ann)
 -> Const (First (Type Symbol Ann)) (Maybe (Type Symbol Ann)))
-> (Ann, Term Symbol Ann, Maybe (Type Symbol Ann))
-> Const
     (First (Type Symbol Ann))
     (Ann, Term Symbol Ann, Maybe (Type Symbol Ann))
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (Ann, Term Symbol Ann, Maybe (Type Symbol Ann))
  (Ann, Term Symbol Ann, Maybe (Type Symbol Ann))
  (Maybe (Type Symbol Ann))
  (Maybe (Type Symbol Ann))
_3 ((Maybe (Type Symbol Ann)
  -> Const (First (Type Symbol Ann)) (Maybe (Type Symbol Ann)))
 -> (Ann, Term Symbol Ann, Maybe (Type Symbol Ann))
 -> Const
      (First (Type Symbol Ann))
      (Ann, Term Symbol Ann, Maybe (Type Symbol Ann)))
-> ((Type Symbol Ann
     -> Const (First (Type Symbol Ann)) (Type Symbol Ann))
    -> Maybe (Type Symbol Ann)
    -> Const (First (Type Symbol Ann)) (Maybe (Type Symbol Ann)))
-> (Type Symbol Ann
    -> Const (First (Type Symbol Ann)) (Type Symbol Ann))
-> (Ann, Term Symbol Ann, Maybe (Type Symbol Ann))
-> Const
     (First (Type Symbol Ann))
     (Ann, Term Symbol Ann, Maybe (Type Symbol Ann))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type Symbol Ann
 -> Const (First (Type Symbol Ann)) (Type Symbol Ann))
-> Maybe (Type Symbol Ann)
-> Const (First (Type Symbol Ann)) (Maybe (Type Symbol Ann))
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just)
        Referent.Con (ConstructorReference TypeReference
r0 ConstructorId
cid) ConstructorType
_type -> do
          case TypeReference
r0 of
            Reference.DerivedId Id
r -> do
              Decl Symbol Ann
decl <- Uri -> Id -> MaybeT Lsp (Decl Symbol Ann)
getTypeDeclaration Uri
fileUri Id
r
              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))
-> (Maybe (Type Symbol Ann) -> Lsp (Maybe (Type Symbol Ann)))
-> Maybe (Type Symbol Ann)
-> MaybeT Lsp (Type Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Type Symbol Ann) -> Lsp (Maybe (Type Symbol Ann))
forall a. a -> Lsp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Type Symbol Ann) -> MaybeT Lsp (Type Symbol Ann))
-> Maybe (Type Symbol Ann) -> MaybeT Lsp (Type Symbol Ann)
forall a b. (a -> b) -> a -> b
$ DataDeclaration Symbol Ann
-> ConstructorId -> Maybe (Type Symbol Ann)
forall v a.
DataDeclaration v a -> ConstructorId -> Maybe (Type v a)
DD.typeOfConstructor ((EffectDeclaration Symbol Ann -> DataDeclaration Symbol Ann)
-> (DataDeclaration Symbol Ann -> DataDeclaration Symbol Ann)
-> Decl Symbol Ann
-> DataDeclaration Symbol Ann
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either EffectDeclaration Symbol Ann -> DataDeclaration Symbol Ann
forall v a. EffectDeclaration v a -> DataDeclaration v a
DD.toDataDecl DataDeclaration Symbol Ann -> DataDeclaration Symbol Ann
forall a. a -> a
id Decl Symbol Ann
decl) ConstructorId
cid
            Reference.Builtin Text
_ -> MaybeT Lsp (Type Symbol Ann)
forall a. MaybeT Lsp a
forall (f :: * -> *) a. Alternative f => f a
empty
    getFromCodebase :: MaybeT Lsp (Type Symbol Ann)
getFromCodebase = do
      Env {Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase} <- MaybeT Lsp Env
forall r (m :: * -> *). MonadReader r m => m r
ask
      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))
-> (IO (Maybe (Type Symbol Ann)) -> Lsp (Maybe (Type Symbol Ann)))
-> IO (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)) -> MaybeT Lsp (Type Symbol Ann))
-> IO (Maybe (Type Symbol Ann)) -> MaybeT Lsp (Type Symbol Ann)
forall a b. (a -> b) -> a -> b
$ 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))
 -> IO (Maybe (Type Symbol Ann)))
-> Transaction (Maybe (Type Symbol Ann))
-> IO (Maybe (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

-- | Gets a decl from either the parsed file or the codebase.
getTypeDeclaration :: Uri -> Reference.Id -> MaybeT Lsp (Decl Symbol Ann)
getTypeDeclaration :: Uri -> Id -> MaybeT Lsp (Decl Symbol Ann)
getTypeDeclaration Uri
fileUri Id
refId = do
  MaybeT Lsp (Decl Symbol Ann)
getFromFile MaybeT Lsp (Decl Symbol Ann)
-> MaybeT Lsp (Decl Symbol Ann) -> MaybeT Lsp (Decl Symbol Ann)
forall a. MaybeT Lsp a -> MaybeT Lsp a -> MaybeT Lsp a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MaybeT Lsp (Decl Symbol Ann)
getFromCodebase
  where
    getFromFile :: MaybeT Lsp (Decl Symbol Ann)
    getFromFile :: MaybeT Lsp (Decl Symbol Ann)
getFromFile = do
      FileSummary {Map Id (Map Symbol (DataDeclaration Symbol Ann))
dataDeclsByReference :: Map Id (Map Symbol (DataDeclaration Symbol Ann))
$sel:dataDeclsByReference:FileSummary :: FileSummary -> Map Id (Map Symbol (DataDeclaration Symbol Ann))
dataDeclsByReference, Map Id (Map Symbol (EffectDeclaration Symbol Ann))
effectDeclsByReference :: Map Id (Map Symbol (EffectDeclaration Symbol Ann))
$sel:effectDeclsByReference:FileSummary :: FileSummary -> Map Id (Map Symbol (EffectDeclaration Symbol Ann))
effectDeclsByReference} <- Uri -> MaybeT Lsp FileSummary
getFileSummary Uri
fileUri
      let datas :: [DataDeclaration Symbol Ann]
datas = Map Id (Map Symbol (DataDeclaration Symbol Ann))
dataDeclsByReference Map Id (Map Symbol (DataDeclaration Symbol Ann))
-> Getting
     (Endo [DataDeclaration Symbol Ann])
     (Map Id (Map Symbol (DataDeclaration Symbol Ann)))
     (DataDeclaration Symbol Ann)
-> [DataDeclaration Symbol Ann]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Index (Map Id (Map Symbol (DataDeclaration Symbol Ann)))
-> Traversal'
     (Map Id (Map Symbol (DataDeclaration Symbol Ann)))
     (IxValue (Map Id (Map Symbol (DataDeclaration Symbol Ann))))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Id (Map Symbol (DataDeclaration Symbol Ann)))
Id
refId ((Map Symbol (DataDeclaration Symbol Ann)
  -> Const
       (Endo [DataDeclaration Symbol Ann])
       (Map Symbol (DataDeclaration Symbol Ann)))
 -> Map Id (Map Symbol (DataDeclaration Symbol Ann))
 -> Const
      (Endo [DataDeclaration Symbol Ann])
      (Map Id (Map Symbol (DataDeclaration Symbol Ann))))
-> ((DataDeclaration Symbol Ann
     -> Const
          (Endo [DataDeclaration Symbol Ann]) (DataDeclaration Symbol Ann))
    -> Map Symbol (DataDeclaration Symbol Ann)
    -> Const
         (Endo [DataDeclaration Symbol Ann])
         (Map Symbol (DataDeclaration Symbol Ann)))
-> Getting
     (Endo [DataDeclaration Symbol Ann])
     (Map Id (Map Symbol (DataDeclaration Symbol Ann)))
     (DataDeclaration Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DataDeclaration Symbol Ann
 -> Const
      (Endo [DataDeclaration Symbol Ann]) (DataDeclaration Symbol Ann))
-> Map Symbol (DataDeclaration Symbol Ann)
-> Const
     (Endo [DataDeclaration Symbol Ann])
     (Map Symbol (DataDeclaration Symbol Ann))
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold
  Int
  (Map Symbol (DataDeclaration Symbol Ann))
  (DataDeclaration Symbol Ann)
folded
      let effects :: [EffectDeclaration Symbol Ann]
effects = Map Id (Map Symbol (EffectDeclaration Symbol Ann))
effectDeclsByReference Map Id (Map Symbol (EffectDeclaration Symbol Ann))
-> Getting
     (Endo [EffectDeclaration Symbol Ann])
     (Map Id (Map Symbol (EffectDeclaration Symbol Ann)))
     (EffectDeclaration Symbol Ann)
-> [EffectDeclaration Symbol Ann]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Index (Map Id (Map Symbol (EffectDeclaration Symbol Ann)))
-> Traversal'
     (Map Id (Map Symbol (EffectDeclaration Symbol Ann)))
     (IxValue (Map Id (Map Symbol (EffectDeclaration Symbol Ann))))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Id (Map Symbol (EffectDeclaration Symbol Ann)))
Id
refId ((Map Symbol (EffectDeclaration Symbol Ann)
  -> Const
       (Endo [EffectDeclaration Symbol Ann])
       (Map Symbol (EffectDeclaration Symbol Ann)))
 -> Map Id (Map Symbol (EffectDeclaration Symbol Ann))
 -> Const
      (Endo [EffectDeclaration Symbol Ann])
      (Map Id (Map Symbol (EffectDeclaration Symbol Ann))))
-> ((EffectDeclaration Symbol Ann
     -> Const
          (Endo [EffectDeclaration Symbol Ann])
          (EffectDeclaration Symbol Ann))
    -> Map Symbol (EffectDeclaration Symbol Ann)
    -> Const
         (Endo [EffectDeclaration Symbol Ann])
         (Map Symbol (EffectDeclaration Symbol Ann)))
-> Getting
     (Endo [EffectDeclaration Symbol Ann])
     (Map Id (Map Symbol (EffectDeclaration Symbol Ann)))
     (EffectDeclaration Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EffectDeclaration Symbol Ann
 -> Const
      (Endo [EffectDeclaration Symbol Ann])
      (EffectDeclaration Symbol Ann))
-> Map Symbol (EffectDeclaration Symbol Ann)
-> Const
     (Endo [EffectDeclaration Symbol Ann])
     (Map Symbol (EffectDeclaration Symbol Ann))
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold
  Int
  (Map Symbol (EffectDeclaration Symbol Ann))
  (EffectDeclaration Symbol Ann)
folded
      Lsp (Maybe (Decl Symbol Ann)) -> MaybeT Lsp (Decl Symbol Ann)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Lsp (Maybe (Decl Symbol Ann)) -> MaybeT Lsp (Decl Symbol Ann))
-> ([Decl Symbol Ann] -> Lsp (Maybe (Decl Symbol Ann)))
-> [Decl Symbol Ann]
-> MaybeT Lsp (Decl Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Decl Symbol Ann) -> Lsp (Maybe (Decl Symbol Ann))
forall a. a -> Lsp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Decl Symbol Ann) -> Lsp (Maybe (Decl Symbol Ann)))
-> ([Decl Symbol Ann] -> Maybe (Decl Symbol Ann))
-> [Decl Symbol Ann]
-> Lsp (Maybe (Decl Symbol Ann))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Decl Symbol Ann] -> Maybe (Decl Symbol Ann)
forall a. [a] -> Maybe a
listToMaybe ([Decl Symbol Ann] -> MaybeT Lsp (Decl Symbol Ann))
-> [Decl Symbol Ann] -> MaybeT Lsp (Decl Symbol Ann)
forall a b. (a -> b) -> a -> b
$ (DataDeclaration Symbol Ann -> Decl Symbol Ann)
-> [DataDeclaration Symbol Ann] -> [Decl Symbol Ann]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DataDeclaration Symbol Ann -> Decl Symbol Ann
forall a b. b -> Either a b
Right [DataDeclaration Symbol Ann]
datas [Decl Symbol Ann] -> [Decl Symbol Ann] -> [Decl Symbol Ann]
forall a. Semigroup a => a -> a -> a
<> (EffectDeclaration Symbol Ann -> Decl Symbol Ann)
-> [EffectDeclaration Symbol Ann] -> [Decl Symbol Ann]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EffectDeclaration Symbol Ann -> Decl Symbol Ann
forall a b. a -> Either a b
Left [EffectDeclaration Symbol Ann]
effects

    getFromCodebase :: MaybeT Lsp (Decl Symbol Ann)
getFromCodebase = do
      Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase} <- MaybeT Lsp Env
forall r (m :: * -> *). MonadReader r m => m r
ask
      Lsp (Maybe (Decl Symbol Ann)) -> MaybeT Lsp (Decl Symbol Ann)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Lsp (Maybe (Decl Symbol Ann)) -> MaybeT Lsp (Decl Symbol Ann))
-> (IO (Maybe (Decl Symbol Ann)) -> Lsp (Maybe (Decl Symbol Ann)))
-> IO (Maybe (Decl Symbol Ann))
-> MaybeT Lsp (Decl Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe (Decl Symbol Ann)) -> Lsp (Maybe (Decl Symbol Ann))
forall a. IO a -> Lsp a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Decl Symbol Ann)) -> MaybeT Lsp (Decl Symbol Ann))
-> IO (Maybe (Decl Symbol Ann)) -> MaybeT Lsp (Decl Symbol Ann)
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann
-> Transaction (Maybe (Decl Symbol Ann))
-> IO (Maybe (Decl 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 (Decl Symbol Ann))
 -> IO (Maybe (Decl Symbol Ann)))
-> Transaction (Maybe (Decl Symbol Ann))
-> IO (Maybe (Decl Symbol Ann))
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann
-> Id -> Transaction (Maybe (Decl Symbol Ann))
forall (m :: * -> *) v a.
Codebase m v a -> Id -> Transaction (Maybe (Decl v a))
Codebase.getTypeDeclaration Codebase IO Symbol Ann
codebase Id
refId

-- | Returns the reference a given term node refers to, if any.
refInTerm :: (Term v a -> Maybe LabeledDependency)
refInTerm :: forall v a. Term v a -> Maybe LabeledDependency
refInTerm Term v a
term =
  case Term v a -> ABT (F v a a) v (Term v a)
forall (f :: * -> *) v a. Term f v a -> ABT f v (Term f v a)
ABT.out Term v a
term of
    ABT.Tm F v a a (Term v a)
f -> case F v a a (Term v a)
f of
      Term.Int {} -> Maybe LabeledDependency
forall a. Maybe a
Nothing
      Term.Nat {} -> Maybe LabeledDependency
forall a. Maybe a
Nothing
      Term.Float {} -> Maybe LabeledDependency
forall a. Maybe a
Nothing
      Term.Boolean {} -> Maybe LabeledDependency
forall a. Maybe a
Nothing
      Term.Text {} -> Maybe LabeledDependency
forall a. Maybe a
Nothing
      Term.Char {} -> Maybe LabeledDependency
forall a. Maybe a
Nothing
      Term.Blank {} -> Maybe LabeledDependency
forall a. Maybe a
Nothing
      Term.Ref TypeReference
ref -> LabeledDependency -> Maybe LabeledDependency
forall a. a -> Maybe a
Just (TypeReference -> LabeledDependency
LD.TermReference TypeReference
ref)
      Term.Constructor GConstructorReference TypeReference
conRef -> LabeledDependency -> Maybe LabeledDependency
forall a. a -> Maybe a
Just (GConstructorReference TypeReference
-> ConstructorType -> LabeledDependency
LD.ConReference GConstructorReference TypeReference
conRef ConstructorType
CT.Data)
      Term.Request GConstructorReference TypeReference
conRef -> LabeledDependency -> Maybe LabeledDependency
forall a. a -> Maybe a
Just (GConstructorReference TypeReference
-> ConstructorType -> LabeledDependency
LD.ConReference GConstructorReference TypeReference
conRef ConstructorType
CT.Effect)
      Term.Handle Term v a
_a Term v a
_b -> Maybe LabeledDependency
forall a. Maybe a
Nothing
      Term.App Term v a
_a Term v a
_b -> Maybe LabeledDependency
forall a. Maybe a
Nothing
      Term.Ann Term v a
_a Type v a
_typ -> Maybe LabeledDependency
forall a. Maybe a
Nothing
      Term.List Seq (Term v a)
_xs -> Maybe LabeledDependency
forall a. Maybe a
Nothing
      Term.If Term v a
_cond Term v a
_a Term v a
_b -> Maybe LabeledDependency
forall a. Maybe a
Nothing
      Term.And Term v a
_l Term v a
_r -> Maybe LabeledDependency
forall a. Maybe a
Nothing
      Term.Or Term v a
_l Term v a
_r -> Maybe LabeledDependency
forall a. Maybe a
Nothing
      Term.Lam Term v a
_a -> Maybe LabeledDependency
forall a. Maybe a
Nothing
      Term.LetRec IsTop
_isTop [Term v a]
_xs Term v a
_y -> Maybe LabeledDependency
forall a. Maybe a
Nothing
      Term.Let IsTop
_isTop Term v a
_a Term v a
_b -> Maybe LabeledDependency
forall a. Maybe a
Nothing
      Term.Match Term v a
_a [MatchCase a (Term v a)]
_cases -> Maybe LabeledDependency
forall a. Maybe a
Nothing
      Term.TermLink Referent
ref -> LabeledDependency -> Maybe LabeledDependency
forall a. a -> Maybe a
Just (Referent -> LabeledDependency
LD.TermReferent Referent
ref)
      Term.TypeLink TypeReference
ref -> LabeledDependency -> Maybe LabeledDependency
forall a. a -> Maybe a
Just (TypeReference -> LabeledDependency
LD.TypeReference TypeReference
ref)
    ABT.Var v
_v -> Maybe LabeledDependency
forall a. Maybe a
Nothing
    ABT.Cycle Term v a
_r -> Maybe LabeledDependency
forall a. Maybe a
Nothing
    ABT.Abs v
_v Term v a
_r -> Maybe LabeledDependency
forall a. Maybe a
Nothing

-- Returns the reference a given type node refers to, if any.
refInType :: Type v a -> Maybe TypeReference
refInType :: forall v a. Type v a -> Maybe TypeReference
refInType Type v a
typ = case Type v a -> ABT F v (Type v a)
forall (f :: * -> *) v a. Term f v a -> ABT f v (Term f v a)
ABT.out Type v a
typ of
  ABT.Tm F (Type v a)
f -> case F (Type v a)
f of
    Type.Ref TypeReference
ref -> TypeReference -> Maybe TypeReference
forall a. a -> Maybe a
Just TypeReference
ref
    Type.Arrow Type v a
_a Type v a
_b -> Maybe TypeReference
forall a. Maybe a
Nothing
    Type.Effect Type v a
_a Type v a
_b -> Maybe TypeReference
forall a. Maybe a
Nothing
    Type.App Type v a
_a Type v a
_b -> Maybe TypeReference
forall a. Maybe a
Nothing
    Type.Forall Type v a
_r -> Maybe TypeReference
forall a. Maybe a
Nothing
    Type.Ann Type v a
_a Kind
_kind -> Maybe TypeReference
forall a. Maybe a
Nothing
    Type.Effects [Type v a]
_es -> Maybe TypeReference
forall a. Maybe a
Nothing
    Type.IntroOuter Type v a
_a -> Maybe TypeReference
forall a. Maybe a
Nothing
  ABT.Var v
_v -> Maybe TypeReference
forall a. Maybe a
Nothing
  ABT.Cycle Type v a
_r -> Maybe TypeReference
forall a. Maybe a
Nothing
  ABT.Abs v
_v Type v a
_r -> Maybe TypeReference
forall a. Maybe a
Nothing

-- Returns the reference a given type node refers to, if any.
refInPattern :: Pattern.Pattern a -> Maybe LabeledDependency
refInPattern :: forall a. Pattern a -> Maybe LabeledDependency
refInPattern = \case
  Pattern.Unbound {} -> Maybe LabeledDependency
forall a. Maybe a
Nothing
  Pattern.Var {} -> Maybe LabeledDependency
forall a. Maybe a
Nothing
  Pattern.Boolean {} -> Maybe LabeledDependency
forall a. Maybe a
Nothing
  Pattern.Int {} -> Maybe LabeledDependency
forall a. Maybe a
Nothing
  Pattern.Nat {} -> Maybe LabeledDependency
forall a. Maybe a
Nothing
  Pattern.Float {} -> Maybe LabeledDependency
forall a. Maybe a
Nothing
  Pattern.Text {} -> Maybe LabeledDependency
forall a. Maybe a
Nothing
  Pattern.Char {} -> Maybe LabeledDependency
forall a. Maybe a
Nothing
  Pattern.Constructor a
_loc GConstructorReference TypeReference
conRef [Pattern a]
_ -> LabeledDependency -> Maybe LabeledDependency
forall a. a -> Maybe a
Just (GConstructorReference TypeReference
-> ConstructorType -> LabeledDependency
LD.ConReference GConstructorReference TypeReference
conRef ConstructorType
CT.Data)
  Pattern.As a
_loc Pattern a
_pat -> Maybe LabeledDependency
forall a. Maybe a
Nothing
  Pattern.EffectPure {} -> Maybe LabeledDependency
forall a. Maybe a
Nothing
  Pattern.EffectBind a
_loc GConstructorReference TypeReference
conRef [Pattern a]
_ Pattern a
_ -> LabeledDependency -> Maybe LabeledDependency
forall a. a -> Maybe a
Just (GConstructorReference TypeReference
-> ConstructorType -> LabeledDependency
LD.ConReference GConstructorReference TypeReference
conRef ConstructorType
CT.Effect)
  Pattern.SequenceLiteral {} -> Maybe LabeledDependency
forall a. Maybe a
Nothing
  Pattern.SequenceOp {} -> Maybe LabeledDependency
forall a. Maybe a
Nothing

data SourceNode a
  = TermNode (Term Symbol a)
  | TypeNode (Type Symbol a)
  | PatternNode (Pattern.Pattern a)
  deriving stock (SourceNode a -> SourceNode a -> IsTop
(SourceNode a -> SourceNode a -> IsTop)
-> (SourceNode a -> SourceNode a -> IsTop) -> Eq (SourceNode a)
forall a. Eq a => SourceNode a -> SourceNode a -> IsTop
forall a. (a -> a -> IsTop) -> (a -> a -> IsTop) -> Eq a
$c== :: forall a. Eq a => SourceNode a -> SourceNode a -> IsTop
== :: SourceNode a -> SourceNode a -> IsTop
$c/= :: forall a. Eq a => SourceNode a -> SourceNode a -> IsTop
/= :: SourceNode a -> SourceNode a -> IsTop
Eq, Int -> SourceNode a -> ShowS
[SourceNode a] -> ShowS
SourceNode a -> WatchKind
(Int -> SourceNode a -> ShowS)
-> (SourceNode a -> WatchKind)
-> ([SourceNode a] -> ShowS)
-> Show (SourceNode a)
forall a. Int -> SourceNode a -> ShowS
forall a. [SourceNode a] -> ShowS
forall a. SourceNode a -> WatchKind
forall a.
(Int -> a -> ShowS) -> (a -> WatchKind) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> SourceNode a -> ShowS
showsPrec :: Int -> SourceNode a -> ShowS
$cshow :: forall a. SourceNode a -> WatchKind
show :: SourceNode a -> WatchKind
$cshowList :: forall a. [SourceNode a] -> ShowS
showList :: [SourceNode a] -> ShowS
Show)

instance Functor SourceNode where
  fmap :: forall a b. (a -> b) -> SourceNode a -> SourceNode b
fmap a -> b
f (TermNode Term Symbol a
t) = Term Symbol b -> SourceNode b
forall a. Term Symbol a -> SourceNode a
TermNode ((a -> b) -> Term Symbol a -> Term Symbol b
forall v a a2. Ord v => (a -> a2) -> Term v a -> Term v a2
Term.amap a -> b
f Term Symbol a
t)
  fmap a -> b
f (TypeNode Type Symbol a
t) = Type Symbol b -> SourceNode b
forall a. Type Symbol a -> SourceNode a
TypeNode ((a -> b) -> Type Symbol a -> Type Symbol b
forall a b. (a -> b) -> Term F Symbol a -> Term F Symbol b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Type Symbol a
t)
  fmap a -> b
f (PatternNode Pattern a
t) = Pattern b -> SourceNode b
forall a. Pattern a -> SourceNode a
PatternNode ((a -> b) -> Pattern a -> Pattern b
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Pattern a
t)

-- | Find the node in a term which contains the specified position, but none of its
-- children contain that position.
findSmallestEnclosingNode :: Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode :: Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos Term Symbol Ann
term
  | Ann -> IsTop
annIsFilePosition Ann
ann IsTop -> IsTop -> IsTop
&& IsTop -> IsTop
not (Ann
ann Ann -> Pos -> IsTop
`Ann.contains` Pos
pos) = Maybe (SourceNode Ann)
forall a. Maybe a
Nothing
  | Just Term Symbol Ann
r <- Term Symbol Ann -> Maybe (Term Symbol Ann)
cleanImplicitUnit Term Symbol Ann
term = Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos Term Symbol Ann
r
  | IsTop
otherwise = do
      -- For leaf nodes we require that they be an in-file position, not Intrinsic or
      -- external.
      -- In some rare cases it's possible for an External/Intrinsic node to have children that
      -- ARE in the file, so we need to make sure we still crawl their children.
      let guardInFile :: Maybe ()
guardInFile = IsTop -> Maybe ()
forall (f :: * -> *). Alternative f => IsTop -> f ()
guard (Ann -> IsTop
annIsFilePosition Ann
ann)
      let bestChild :: Maybe (SourceNode Ann)
bestChild = case Term Symbol Ann -> ABT (F Symbol Ann Ann) Symbol (Term Symbol Ann)
forall (f :: * -> *) v a. Term f v a -> ABT f v (Term f v a)
ABT.out Term Symbol Ann
term of
            ABT.Tm F Symbol Ann Ann (Term Symbol Ann)
f -> case F Symbol Ann Ann (Term Symbol Ann)
f of
              Term.Int {} -> Maybe ()
guardInFile Maybe () -> Maybe (SourceNode Ann) -> Maybe (SourceNode Ann)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SourceNode Ann -> Maybe (SourceNode Ann)
forall a. a -> Maybe a
Just (Term Symbol Ann -> SourceNode Ann
forall a. Term Symbol a -> SourceNode a
TermNode Term Symbol Ann
term)
              Term.Nat {} -> Maybe ()
guardInFile Maybe () -> Maybe (SourceNode Ann) -> Maybe (SourceNode Ann)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SourceNode Ann -> Maybe (SourceNode Ann)
forall a. a -> Maybe a
Just (Term Symbol Ann -> SourceNode Ann
forall a. Term Symbol a -> SourceNode a
TermNode Term Symbol Ann
term)
              Term.Float {} -> Maybe ()
guardInFile Maybe () -> Maybe (SourceNode Ann) -> Maybe (SourceNode Ann)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SourceNode Ann -> Maybe (SourceNode Ann)
forall a. a -> Maybe a
Just (Term Symbol Ann -> SourceNode Ann
forall a. Term Symbol a -> SourceNode a
TermNode Term Symbol Ann
term)
              Term.Boolean {} -> Maybe ()
guardInFile Maybe () -> Maybe (SourceNode Ann) -> Maybe (SourceNode Ann)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SourceNode Ann -> Maybe (SourceNode Ann)
forall a. a -> Maybe a
Just (Term Symbol Ann -> SourceNode Ann
forall a. Term Symbol a -> SourceNode a
TermNode Term Symbol Ann
term)
              Term.Text {} -> Maybe ()
guardInFile Maybe () -> Maybe (SourceNode Ann) -> Maybe (SourceNode Ann)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SourceNode Ann -> Maybe (SourceNode Ann)
forall a. a -> Maybe a
Just (Term Symbol Ann -> SourceNode Ann
forall a. Term Symbol a -> SourceNode a
TermNode Term Symbol Ann
term)
              Term.Char {} -> Maybe ()
guardInFile Maybe () -> Maybe (SourceNode Ann) -> Maybe (SourceNode Ann)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SourceNode Ann -> Maybe (SourceNode Ann)
forall a. a -> Maybe a
Just (Term Symbol Ann -> SourceNode Ann
forall a. Term Symbol a -> SourceNode a
TermNode Term Symbol Ann
term)
              Term.Blank {} -> Maybe ()
guardInFile Maybe () -> Maybe (SourceNode Ann) -> Maybe (SourceNode Ann)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SourceNode Ann -> Maybe (SourceNode Ann)
forall a. a -> Maybe a
Just (Term Symbol Ann -> SourceNode Ann
forall a. Term Symbol a -> SourceNode a
TermNode Term Symbol Ann
term)
              Term.Ref {} -> Maybe ()
guardInFile Maybe () -> Maybe (SourceNode Ann) -> Maybe (SourceNode Ann)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SourceNode Ann -> Maybe (SourceNode Ann)
forall a. a -> Maybe a
Just (Term Symbol Ann -> SourceNode Ann
forall a. Term Symbol a -> SourceNode a
TermNode Term Symbol Ann
term)
              Term.Constructor {} -> Maybe ()
guardInFile Maybe () -> Maybe (SourceNode Ann) -> Maybe (SourceNode Ann)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SourceNode Ann -> Maybe (SourceNode Ann)
forall a. a -> Maybe a
Just (Term Symbol Ann -> SourceNode Ann
forall a. Term Symbol a -> SourceNode a
TermNode Term Symbol Ann
term)
              Term.Request {} -> Maybe ()
guardInFile Maybe () -> Maybe (SourceNode Ann) -> Maybe (SourceNode Ann)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SourceNode Ann -> Maybe (SourceNode Ann)
forall a. a -> Maybe a
Just (Term Symbol Ann -> SourceNode Ann
forall a. Term Symbol a -> SourceNode a
TermNode Term Symbol Ann
term)
              Term.Handle Term Symbol Ann
a Term Symbol Ann
b -> Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos Term Symbol Ann
a Maybe (SourceNode Ann)
-> Maybe (SourceNode Ann) -> Maybe (SourceNode Ann)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos Term Symbol Ann
b
              Term.App Term Symbol Ann
a Term Symbol Ann
b ->
                -- We crawl the body of the App first because the annotations for certain
                -- lambda syntaxes get a bit squirrelly.
                -- Specifically Tuple constructor apps will have an annotation which spans the
                -- whole tuple, e.g. the annotation of the tuple constructor for `(1, 2)` will
                -- cover ALL of `(1, 2)`, so we check the body of the tuple app first to see
                -- if the cursor is on 1 or 2 before falling back on the annotation of the
                -- 'function' of the app.
                Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos Term Symbol Ann
b Maybe (SourceNode Ann)
-> Maybe (SourceNode Ann) -> Maybe (SourceNode Ann)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos Term Symbol Ann
a
              Term.Ann Term Symbol Ann
a Type Symbol Ann
typ -> Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos Term Symbol Ann
a Maybe (SourceNode Ann)
-> Maybe (SourceNode Ann) -> Maybe (SourceNode Ann)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Type Symbol Ann -> SourceNode Ann
forall a. Type Symbol a -> SourceNode a
TypeNode (Type Symbol Ann -> SourceNode Ann)
-> Maybe (Type Symbol Ann) -> Maybe (SourceNode Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pos -> Type Symbol Ann -> Maybe (Type Symbol Ann)
findSmallestEnclosingType Pos
pos Type Symbol Ann
typ)
              Term.List Seq (Term Symbol Ann)
xs -> Seq (Maybe (SourceNode Ann)) -> Maybe (SourceNode Ann)
forall (f :: * -> *) (t :: * -> *) a.
(Alternative f, Foldable t) =>
t (f a) -> f a
altSum (Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos (Term Symbol Ann -> Maybe (SourceNode Ann))
-> Seq (Term Symbol Ann) -> Seq (Maybe (SourceNode Ann))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (Term Symbol Ann)
xs)
              Term.If Term Symbol Ann
cond Term Symbol Ann
a Term Symbol Ann
b -> Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos Term Symbol Ann
cond Maybe (SourceNode Ann)
-> Maybe (SourceNode Ann) -> Maybe (SourceNode Ann)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos Term Symbol Ann
a Maybe (SourceNode Ann)
-> Maybe (SourceNode Ann) -> Maybe (SourceNode Ann)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos Term Symbol Ann
b
              Term.And Term Symbol Ann
l Term Symbol Ann
r -> Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos Term Symbol Ann
l Maybe (SourceNode Ann)
-> Maybe (SourceNode Ann) -> Maybe (SourceNode Ann)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos Term Symbol Ann
r
              Term.Or Term Symbol Ann
l Term Symbol Ann
r -> Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos Term Symbol Ann
l Maybe (SourceNode Ann)
-> Maybe (SourceNode Ann) -> Maybe (SourceNode Ann)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos Term Symbol Ann
r
              Term.Lam Term Symbol Ann
a -> Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos Term Symbol Ann
a
              Term.LetRec IsTop
_isTop [Term Symbol Ann]
xs Term Symbol Ann
y -> [Maybe (SourceNode Ann)] -> Maybe (SourceNode Ann)
forall (f :: * -> *) (t :: * -> *) a.
(Alternative f, Foldable t) =>
t (f a) -> f a
altSum (Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos (Term Symbol Ann -> Maybe (SourceNode Ann))
-> [Term Symbol Ann] -> [Maybe (SourceNode Ann)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Term Symbol Ann]
xs) Maybe (SourceNode Ann)
-> Maybe (SourceNode Ann) -> Maybe (SourceNode Ann)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos Term Symbol Ann
y
              Term.Let IsTop
_isTop Term Symbol Ann
a Term Symbol Ann
b -> Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos Term Symbol Ann
a Maybe (SourceNode Ann)
-> Maybe (SourceNode Ann) -> Maybe (SourceNode Ann)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos Term Symbol Ann
b
              Term.Match Term Symbol Ann
a [MatchCase Ann (Term Symbol Ann)]
cases ->
                Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos Term Symbol Ann
a
                  Maybe (SourceNode Ann)
-> Maybe (SourceNode Ann) -> Maybe (SourceNode Ann)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Maybe (SourceNode Ann)] -> Maybe (SourceNode Ann)
forall (f :: * -> *) (t :: * -> *) a.
(Alternative f, Foldable t) =>
t (f a) -> f a
altSum ([MatchCase Ann (Term Symbol Ann)]
cases [MatchCase Ann (Term Symbol Ann)]
-> (MatchCase Ann (Term Symbol Ann) -> Maybe (SourceNode Ann))
-> [Maybe (SourceNode Ann)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(MatchCase Pattern Ann
pat Maybe (Term Symbol Ann)
grd Term Symbol Ann
body) -> ((Pattern Ann -> SourceNode Ann
forall a. Pattern a -> SourceNode a
PatternNode (Pattern Ann -> SourceNode Ann)
-> Maybe (Pattern Ann) -> Maybe (SourceNode Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pos -> Pattern Ann -> Maybe (Pattern Ann)
findSmallestEnclosingPattern Pos
pos Pattern Ann
pat) Maybe (SourceNode Ann)
-> Maybe (SourceNode Ann) -> Maybe (SourceNode Ann)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe (Term Symbol Ann)
grd Maybe (Term Symbol Ann)
-> (Term Symbol Ann -> Maybe (SourceNode Ann))
-> Maybe (SourceNode Ann)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos) Maybe (SourceNode Ann)
-> Maybe (SourceNode Ann) -> Maybe (SourceNode Ann)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos Term Symbol Ann
body))
              Term.TermLink {} -> Maybe ()
guardInFile Maybe () -> Maybe (SourceNode Ann) -> Maybe (SourceNode Ann)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SourceNode Ann -> Maybe (SourceNode Ann)
forall a. a -> Maybe a
Just (Term Symbol Ann -> SourceNode Ann
forall a. Term Symbol a -> SourceNode a
TermNode Term Symbol Ann
term)
              Term.TypeLink {} -> Maybe ()
guardInFile Maybe () -> Maybe (SourceNode Ann) -> Maybe (SourceNode Ann)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SourceNode Ann -> Maybe (SourceNode Ann)
forall a. a -> Maybe a
Just (Term Symbol Ann -> SourceNode Ann
forall a. Term Symbol a -> SourceNode a
TermNode Term Symbol Ann
term)
            ABT.Var Symbol
_v -> Maybe ()
guardInFile Maybe () -> Maybe (SourceNode Ann) -> Maybe (SourceNode Ann)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SourceNode Ann -> Maybe (SourceNode Ann)
forall a. a -> Maybe a
Just (Term Symbol Ann -> SourceNode Ann
forall a. Term Symbol a -> SourceNode a
TermNode Term Symbol Ann
term)
            ABT.Cycle Term Symbol Ann
r -> Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos Term Symbol Ann
r
            ABT.Abs Symbol
_v Term Symbol Ann
r -> Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos Term Symbol Ann
r
      let fallback :: Maybe (SourceNode Ann)
fallback = if Ann -> IsTop
annIsFilePosition Ann
ann then SourceNode Ann -> Maybe (SourceNode Ann)
forall a. a -> Maybe a
Just (Term Symbol Ann -> SourceNode Ann
forall a. Term Symbol a -> SourceNode a
TermNode Term Symbol Ann
term) else Maybe (SourceNode Ann)
forall a. Maybe a
Nothing
      Maybe (SourceNode Ann)
bestChild Maybe (SourceNode Ann)
-> Maybe (SourceNode Ann) -> Maybe (SourceNode Ann)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (SourceNode Ann)
fallback
  where
    -- tuples always end in an implicit unit, but it's annotated with the span of the whole
    -- tuple, which is problematic, so we need to detect and remove implicit tuples.
    -- We can detect them because we know that the last element of a tuple is always its
    -- implicit unit.
    cleanImplicitUnit :: Term Symbol Ann -> Maybe (Term Symbol Ann)
    cleanImplicitUnit :: Term Symbol Ann -> Maybe (Term Symbol Ann)
cleanImplicitUnit = \case
      ABT.Tm' (Term.App (ABT.Tm' (Term.App (ABT.Tm' (Term.Constructor (ConstructorReference TypeReference
ref ConstructorId
0))) Term Symbol Ann
x)) Term Symbol Ann
trm)
        | TypeReference
ref TypeReference -> TypeReference -> IsTop
forall a. Eq a => a -> a -> IsTop
== TypeReference
Builtins.pairRef IsTop -> IsTop -> IsTop
&& (Ann -> ()) -> Term Symbol Ann -> Term Symbol ()
forall v a a2. Ord v => (a -> a2) -> Term v a -> Term v a2
Term.amap (() -> Ann -> ()
forall a b. a -> b -> a
const ()) Term Symbol Ann
trm Term Symbol () -> Term Symbol () -> IsTop
forall a. Eq a => a -> a -> IsTop
== () -> Term Symbol ()
forall v a vt at ap. Var v => a -> Term2 vt at ap v a
Builtins.unitTerm () -> Term Symbol Ann -> Maybe (Term Symbol Ann)
forall a. a -> Maybe a
Just Term Symbol Ann
x
      Term Symbol Ann
_ -> Maybe (Term Symbol Ann)
forall a. Maybe a
Nothing
    ann :: Ann
ann = Term Symbol Ann -> Ann
getTermSpanAnn Term Symbol Ann
term

-- | Most nodes have the property that their annotation spans all their children, but there are some exceptions.
getTermSpanAnn :: Term Symbol Ann -> Ann
getTermSpanAnn :: Term Symbol Ann -> Ann
getTermSpanAnn Term Symbol Ann
tm = case Term Symbol Ann -> ABT (F Symbol Ann Ann) Symbol (Term Symbol Ann)
forall (f :: * -> *) v a. Term f v a -> ABT f v (Term f v a)
ABT.out Term Symbol Ann
tm of
  ABT.Abs Symbol
_v Term Symbol Ann
r -> Term Symbol Ann -> Ann
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term Symbol Ann
tm Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Term Symbol Ann -> Ann
getTermSpanAnn Term Symbol Ann
r
  ABT (F Symbol Ann Ann) Symbol (Term Symbol Ann)
_ -> Term Symbol Ann -> Ann
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term Symbol Ann
tm

findSmallestEnclosingPattern :: Pos -> Pattern.Pattern Ann -> Maybe (Pattern.Pattern Ann)
findSmallestEnclosingPattern :: Pos -> Pattern Ann -> Maybe (Pattern Ann)
findSmallestEnclosingPattern Pos
pos Pattern Ann
pat
  | Just Pattern Ann
validTargets <- Pattern Ann -> Maybe (Pattern Ann)
cleanImplicitUnit Pattern Ann
pat = Pos -> Pattern Ann -> Maybe (Pattern Ann)
findSmallestEnclosingPattern Pos
pos Pattern Ann
validTargets
  | Ann -> IsTop
annIsFilePosition (Pattern Ann -> Ann
forall a. Annotated a => a -> Ann
ann Pattern Ann
pat) IsTop -> IsTop -> IsTop
&& IsTop -> IsTop
not (Pattern Ann -> Ann
forall a. Annotated a => a -> Ann
ann Pattern Ann
pat Ann -> Pos -> IsTop
`Ann.contains` Pos
pos) = Maybe (Pattern Ann)
forall a. Maybe a
Nothing
  | IsTop
otherwise = do
      -- For leaf nodes we require that they be an in-file position, not Intrinsic or
      -- external.
      -- In some rare cases it's possible for an External/Intrinsic node to have children that
      -- ARE in the file, so we need to make sure we still crawl their children.
      let guardInFile :: Maybe ()
guardInFile = IsTop -> Maybe ()
forall (f :: * -> *). Alternative f => IsTop -> f ()
guard (Ann -> IsTop
annIsFilePosition (Pattern Ann -> Ann
forall a. Annotated a => a -> Ann
ann Pattern Ann
pat))
      let bestChild :: Maybe (Pattern Ann)
bestChild = case Pattern Ann
pat of
            Pattern.Unbound {} -> Maybe ()
guardInFile Maybe () -> Maybe (Pattern Ann) -> Maybe (Pattern Ann)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Pattern Ann -> Maybe (Pattern Ann)
forall a. a -> Maybe a
Just Pattern Ann
pat
            Pattern.Var {} -> Maybe ()
guardInFile Maybe () -> Maybe (Pattern Ann) -> Maybe (Pattern Ann)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Pattern Ann -> Maybe (Pattern Ann)
forall a. a -> Maybe a
Just Pattern Ann
pat
            Pattern.Boolean {} -> Maybe ()
guardInFile Maybe () -> Maybe (Pattern Ann) -> Maybe (Pattern Ann)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Pattern Ann -> Maybe (Pattern Ann)
forall a. a -> Maybe a
Just Pattern Ann
pat
            Pattern.Int {} -> Maybe ()
guardInFile Maybe () -> Maybe (Pattern Ann) -> Maybe (Pattern Ann)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Pattern Ann -> Maybe (Pattern Ann)
forall a. a -> Maybe a
Just Pattern Ann
pat
            Pattern.Nat {} -> Maybe ()
guardInFile Maybe () -> Maybe (Pattern Ann) -> Maybe (Pattern Ann)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Pattern Ann -> Maybe (Pattern Ann)
forall a. a -> Maybe a
Just Pattern Ann
pat
            Pattern.Float {} -> Maybe ()
guardInFile Maybe () -> Maybe (Pattern Ann) -> Maybe (Pattern Ann)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Pattern Ann -> Maybe (Pattern Ann)
forall a. a -> Maybe a
Just Pattern Ann
pat
            Pattern.Text {} -> Maybe ()
guardInFile Maybe () -> Maybe (Pattern Ann) -> Maybe (Pattern Ann)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Pattern Ann -> Maybe (Pattern Ann)
forall a. a -> Maybe a
Just Pattern Ann
pat
            Pattern.Char {} -> Maybe ()
guardInFile Maybe () -> Maybe (Pattern Ann) -> Maybe (Pattern Ann)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Pattern Ann -> Maybe (Pattern Ann)
forall a. a -> Maybe a
Just Pattern Ann
pat
            Pattern.Constructor Ann
_loc GConstructorReference TypeReference
_conRef [Pattern Ann]
pats -> [Maybe (Pattern Ann)] -> Maybe (Pattern Ann)
forall (f :: * -> *) (t :: * -> *) a.
(Alternative f, Foldable t) =>
t (f a) -> f a
altSum (Pos -> Pattern Ann -> Maybe (Pattern Ann)
findSmallestEnclosingPattern Pos
pos (Pattern Ann -> Maybe (Pattern Ann))
-> [Pattern Ann] -> [Maybe (Pattern Ann)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern Ann]
pats)
            Pattern.As Ann
_loc Pattern Ann
p -> Pos -> Pattern Ann -> Maybe (Pattern Ann)
findSmallestEnclosingPattern Pos
pos Pattern Ann
p
            Pattern.EffectPure Ann
_loc Pattern Ann
p -> Pos -> Pattern Ann -> Maybe (Pattern Ann)
findSmallestEnclosingPattern Pos
pos Pattern Ann
p
            Pattern.EffectBind Ann
_loc GConstructorReference TypeReference
_conRef [Pattern Ann]
pats Pattern Ann
p -> [Maybe (Pattern Ann)] -> Maybe (Pattern Ann)
forall (f :: * -> *) (t :: * -> *) a.
(Alternative f, Foldable t) =>
t (f a) -> f a
altSum (Pos -> Pattern Ann -> Maybe (Pattern Ann)
findSmallestEnclosingPattern Pos
pos (Pattern Ann -> Maybe (Pattern Ann))
-> [Pattern Ann] -> [Maybe (Pattern Ann)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern Ann]
pats) Maybe (Pattern Ann) -> Maybe (Pattern Ann) -> Maybe (Pattern Ann)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> Pattern Ann -> Maybe (Pattern Ann)
findSmallestEnclosingPattern Pos
pos Pattern Ann
p
            Pattern.SequenceLiteral Ann
_loc [Pattern Ann]
pats -> [Maybe (Pattern Ann)] -> Maybe (Pattern Ann)
forall (f :: * -> *) (t :: * -> *) a.
(Alternative f, Foldable t) =>
t (f a) -> f a
altSum (Pos -> Pattern Ann -> Maybe (Pattern Ann)
findSmallestEnclosingPattern Pos
pos (Pattern Ann -> Maybe (Pattern Ann))
-> [Pattern Ann] -> [Maybe (Pattern Ann)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern Ann]
pats)
            Pattern.SequenceOp Ann
_loc Pattern Ann
p1 SeqOp
_op Pattern Ann
p2 -> Pos -> Pattern Ann -> Maybe (Pattern Ann)
findSmallestEnclosingPattern Pos
pos Pattern Ann
p1 Maybe (Pattern Ann) -> Maybe (Pattern Ann) -> Maybe (Pattern Ann)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> Pattern Ann -> Maybe (Pattern Ann)
findSmallestEnclosingPattern Pos
pos Pattern Ann
p2
      let fallback :: Maybe (Pattern Ann)
fallback = if Ann -> IsTop
annIsFilePosition (Pattern Ann -> Ann
forall a. Annotated a => a -> Ann
ann Pattern Ann
pat) then Pattern Ann -> Maybe (Pattern Ann)
forall a. a -> Maybe a
Just Pattern Ann
pat else Maybe (Pattern Ann)
forall a. Maybe a
Nothing
      Maybe (Pattern Ann)
bestChild Maybe (Pattern Ann) -> Maybe (Pattern Ann) -> Maybe (Pattern Ann)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Pattern Ann)
fallback
  where
    -- tuple patterns always end in an implicit unit, but it's annotated with the span of the whole
    -- tuple, which is problematic, so we need to detect and remove implicit tuples.
    -- We can detect them because we know that the last element of a tuple is always its
    -- implicit unit.
    cleanImplicitUnit :: Pattern.Pattern Ann -> Maybe (Pattern.Pattern Ann)
    cleanImplicitUnit :: Pattern Ann -> Maybe (Pattern Ann)
cleanImplicitUnit = \case
      (Pattern.Constructor Ann
_loc (ConstructorReference TypeReference
conRef ConstructorId
0) [Pattern Ann
pat1, Pattern.Constructor Ann
_ (ConstructorReference TypeReference
mayUnitRef ConstructorId
0) [Pattern Ann]
_])
        | TypeReference
conRef TypeReference -> TypeReference -> IsTop
forall a. Eq a => a -> a -> IsTop
== TypeReference
Builtins.pairRef IsTop -> IsTop -> IsTop
&& TypeReference
mayUnitRef TypeReference -> TypeReference -> IsTop
forall a. Eq a => a -> a -> IsTop
== TypeReference
Builtins.unitRef -> Pattern Ann -> Maybe (Pattern Ann)
forall a. a -> Maybe a
Just Pattern Ann
pat1
      Pattern Ann
_ -> Maybe (Pattern Ann)
forall a. Maybe a
Nothing

-- | Find the node in a type which contains the specified position, but none of its
-- children contain that position.
-- This is helpful for finding the specific type reference of a given argument within a type arrow
-- that a position references.
findSmallestEnclosingType :: Pos -> Type Symbol Ann -> Maybe (Type Symbol Ann)
findSmallestEnclosingType :: Pos -> Type Symbol Ann -> Maybe (Type Symbol Ann)
findSmallestEnclosingType Pos
pos Type Symbol Ann
typ
  | Ann -> IsTop
annIsFilePosition (Type Symbol Ann -> Ann
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Type Symbol Ann
typ) IsTop -> IsTop -> IsTop
&& IsTop -> IsTop
not (Type Symbol Ann -> Ann
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Type Symbol Ann
typ Ann -> Pos -> IsTop
`Ann.contains` Pos
pos) = Maybe (Type Symbol Ann)
forall a. Maybe a
Nothing
  | IsTop
otherwise = do
      -- For leaf nodes we require that they be an in-file position, not Intrinsic or
      -- external.
      -- In some rare cases it's possible for an External/Intrinsic node to have children that
      -- ARE in the file, so we need to make sure we still crawl their children.
      let guardInFile :: Maybe ()
guardInFile = IsTop -> Maybe ()
forall (f :: * -> *). Alternative f => IsTop -> f ()
guard (Ann -> IsTop
annIsFilePosition (Type Symbol Ann -> Ann
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Type Symbol Ann
typ))
      let bestChild :: Maybe (Type Symbol Ann)
bestChild = case Type Symbol Ann -> ABT F Symbol (Type Symbol Ann)
forall (f :: * -> *) v a. Term f v a -> ABT f v (Term f v a)
ABT.out Type Symbol Ann
typ of
            ABT.Tm F (Type Symbol Ann)
f -> case F (Type Symbol Ann)
f of
              Type.Ref {} -> Maybe ()
guardInFile Maybe () -> Maybe (Type Symbol Ann) -> Maybe (Type Symbol Ann)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Type Symbol Ann -> Maybe (Type Symbol Ann)
forall a. a -> Maybe a
Just Type Symbol Ann
typ
              Type.Arrow Type Symbol Ann
a Type Symbol Ann
b -> Pos -> Type Symbol Ann -> Maybe (Type Symbol Ann)
findSmallestEnclosingType Pos
pos Type Symbol Ann
a Maybe (Type Symbol Ann)
-> Maybe (Type Symbol Ann) -> Maybe (Type Symbol Ann)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> Type Symbol Ann -> Maybe (Type Symbol Ann)
findSmallestEnclosingType Pos
pos Type Symbol Ann
b
              Type.Effect Type Symbol Ann
effs Type Symbol Ann
rhs ->
                -- There's currently a bug in the annotations for effects which cause them to
                -- span larger than they should. As  a workaround for now we just make sure to
                -- search the RHS before the effects.
                Pos -> Type Symbol Ann -> Maybe (Type Symbol Ann)
findSmallestEnclosingType Pos
pos Type Symbol Ann
rhs Maybe (Type Symbol Ann)
-> Maybe (Type Symbol Ann) -> Maybe (Type Symbol Ann)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> Type Symbol Ann -> Maybe (Type Symbol Ann)
findSmallestEnclosingType Pos
pos Type Symbol Ann
effs
              Type.App Type Symbol Ann
a Type Symbol Ann
b -> Pos -> Type Symbol Ann -> Maybe (Type Symbol Ann)
findSmallestEnclosingType Pos
pos Type Symbol Ann
a Maybe (Type Symbol Ann)
-> Maybe (Type Symbol Ann) -> Maybe (Type Symbol Ann)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> Type Symbol Ann -> Maybe (Type Symbol Ann)
findSmallestEnclosingType Pos
pos Type Symbol Ann
b
              Type.Forall Type Symbol Ann
r -> Pos -> Type Symbol Ann -> Maybe (Type Symbol Ann)
findSmallestEnclosingType Pos
pos Type Symbol Ann
r
              Type.Ann Type Symbol Ann
a Kind
_kind -> Pos -> Type Symbol Ann -> Maybe (Type Symbol Ann)
findSmallestEnclosingType Pos
pos Type Symbol Ann
a
              Type.Effects [Type Symbol Ann]
es -> [Maybe (Type Symbol Ann)] -> Maybe (Type Symbol Ann)
forall (f :: * -> *) (t :: * -> *) a.
(Alternative f, Foldable t) =>
t (f a) -> f a
altSum (Pos -> Type Symbol Ann -> Maybe (Type Symbol Ann)
findSmallestEnclosingType Pos
pos (Type Symbol Ann -> Maybe (Type Symbol Ann))
-> [Type Symbol Ann] -> [Maybe (Type Symbol Ann)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type Symbol Ann]
es)
              Type.IntroOuter Type Symbol Ann
a -> Pos -> Type Symbol Ann -> Maybe (Type Symbol Ann)
findSmallestEnclosingType Pos
pos Type Symbol Ann
a
            ABT.Var Symbol
_v -> Maybe ()
guardInFile Maybe () -> Maybe (Type Symbol Ann) -> Maybe (Type Symbol Ann)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Type Symbol Ann -> Maybe (Type Symbol Ann)
forall a. a -> Maybe a
Just Type Symbol Ann
typ
            ABT.Cycle Type Symbol Ann
r -> Pos -> Type Symbol Ann -> Maybe (Type Symbol Ann)
findSmallestEnclosingType Pos
pos Type Symbol Ann
r
            ABT.Abs Symbol
_v Type Symbol Ann
r -> Pos -> Type Symbol Ann -> Maybe (Type Symbol Ann)
findSmallestEnclosingType Pos
pos Type Symbol Ann
r
      let fallback :: Maybe (Type Symbol Ann)
fallback = if Ann -> IsTop
annIsFilePosition (Type Symbol Ann -> Ann
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Type Symbol Ann
typ) then Type Symbol Ann -> Maybe (Type Symbol Ann)
forall a. a -> Maybe a
Just Type Symbol Ann
typ else Maybe (Type Symbol Ann)
forall a. Maybe a
Nothing
      Maybe (Type Symbol Ann)
bestChild Maybe (Type Symbol Ann)
-> Maybe (Type Symbol Ann) -> Maybe (Type Symbol Ann)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Type Symbol Ann)
fallback

-- | Returns the type reference the given position applies to within a Decl, if any.
--
-- I.e. if the cursor is over a type reference within a constructor signature or ability
-- request signature, that type reference will be returned.
refInDecl :: Pos -> DD.Decl Symbol Ann -> Maybe TypeReference
refInDecl :: Pos -> Decl Symbol Ann -> Maybe TypeReference
refInDecl Pos
p (Decl Symbol Ann -> DataDeclaration Symbol Ann
forall v a. Decl v a -> DataDeclaration v a
DD.asDataDecl -> DataDeclaration Symbol Ann
dd) =
  DataDeclaration Symbol Ann -> [(Ann, Symbol, Type Symbol Ann)]
forall v a. DataDeclaration v a -> [(a, v, Type v a)]
DD.constructors' DataDeclaration Symbol Ann
dd
    [(Ann, Symbol, Type Symbol Ann)]
-> ([(Ann, Symbol, Type Symbol Ann)] -> Maybe TypeReference)
-> Maybe TypeReference
forall a b. a -> (a -> b) -> b
& ((Ann, Symbol, Type Symbol Ann) -> Maybe TypeReference)
-> [(Ann, Symbol, Type Symbol Ann)] -> Maybe TypeReference
forall (f :: * -> *) (t :: * -> *) a b.
(Alternative f, Foldable t) =>
(a -> f b) -> t a -> f b
altMap \(Ann
_conNameAnn, Symbol
_v, Type Symbol Ann
typ) -> do
      Type Symbol Ann
typeNode <- Pos -> Type Symbol Ann -> Maybe (Type Symbol Ann)
findSmallestEnclosingType Pos
p Type Symbol Ann
typ
      TypeReference
ref <- Type Symbol Ann -> Maybe TypeReference
forall v a. Type v a -> Maybe TypeReference
refInType Type Symbol Ann
typeNode
      TypeReference -> Maybe TypeReference
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeReference
ref

-- | Returns the ABT node at the provided position.
-- Does not return Decl nodes.
nodeAtPosition :: Uri -> Position -> MaybeT Lsp (SourceNode Ann)
nodeAtPosition :: Uri -> Position -> MaybeT Lsp (SourceNode Ann)
nodeAtPosition Uri
uri (Position -> Pos
lspToUPos -> Pos
pos) = do
  (FileSummary {Map
  Symbol (Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann))
termsBySymbol :: Map
  Symbol (Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann))
$sel:termsBySymbol:FileSummary :: FileSummary
-> Map
     Symbol (Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann))
termsBySymbol, [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
  Maybe (Type Symbol Ann))]
testWatchSummary :: [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
  Maybe (Type Symbol Ann))]
$sel:testWatchSummary:FileSummary :: FileSummary
-> [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
     Maybe (Type Symbol Ann))]
testWatchSummary, [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
  Maybe (Type Symbol Ann), Maybe WatchKind)]
exprWatchSummary :: [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
  Maybe (Type Symbol Ann), Maybe WatchKind)]
$sel:exprWatchSummary:FileSummary :: FileSummary
-> [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
     Maybe (Type Symbol Ann), Maybe WatchKind)]
exprWatchSummary}) <- Uri -> MaybeT Lsp FileSummary
getFileSummary Uri
uri

  let ([Term Symbol Ann]
trms, [Type Symbol Ann]
typs) = Map
  Symbol (Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann))
termsBySymbol Map
  Symbol (Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann))
-> (Map
      Symbol (Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann))
    -> ([Term Symbol Ann], [Type Symbol Ann]))
-> ([Term Symbol Ann], [Type Symbol Ann])
forall a b. a -> (a -> b) -> b
& ((Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann))
 -> ([Term Symbol Ann], [Type Symbol Ann]))
-> Map
     Symbol (Ann, Maybe Id, Term Symbol Ann, Maybe (Type Symbol Ann))
-> ([Term Symbol Ann], [Type Symbol Ann])
forall m a. Monoid m => (a -> m) -> Map Symbol a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \(Ann
_ann, Maybe Id
_ref, Term Symbol Ann
trm, Maybe (Type Symbol Ann)
mayTyp) -> ([Term Symbol Ann
trm], Maybe (Type Symbol Ann) -> [Type Symbol Ann]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Maybe (Type Symbol Ann)
mayTyp)
  ( (Term Symbol Ann -> MaybeT Lsp (SourceNode Ann))
-> [Term Symbol Ann] -> MaybeT Lsp (SourceNode Ann)
forall (f :: * -> *) (t :: * -> *) a b.
(Alternative f, Foldable t) =>
(a -> f b) -> t a -> f b
altMap (Maybe (SourceNode Ann) -> MaybeT Lsp (SourceNode Ann)
forall a. Maybe a -> MaybeT Lsp a
hoistMaybe (Maybe (SourceNode Ann) -> MaybeT Lsp (SourceNode Ann))
-> (Term Symbol Ann -> Maybe (SourceNode Ann))
-> Term Symbol Ann
-> MaybeT Lsp (SourceNode Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos (Term Symbol Ann -> Maybe (SourceNode Ann))
-> (Term Symbol Ann -> Term Symbol Ann)
-> Term Symbol Ann
-> Maybe (SourceNode Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term Symbol Ann -> Term Symbol Ann
forall v. Ord v => Term v Ann -> Term v Ann
removeInferredTypeAnnotations) [Term Symbol Ann]
trms
      MaybeT Lsp (SourceNode Ann)
-> MaybeT Lsp (SourceNode Ann) -> MaybeT Lsp (SourceNode Ann)
forall a. MaybeT Lsp a -> MaybeT Lsp a -> MaybeT Lsp a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Term Symbol Ann -> MaybeT Lsp (SourceNode Ann))
-> [Term Symbol Ann] -> MaybeT Lsp (SourceNode Ann)
forall (f :: * -> *) (t :: * -> *) a b.
(Alternative f, Foldable t) =>
(a -> f b) -> t a -> f b
altMap (Maybe (SourceNode Ann) -> MaybeT Lsp (SourceNode Ann)
forall a. Maybe a -> MaybeT Lsp a
hoistMaybe (Maybe (SourceNode Ann) -> MaybeT Lsp (SourceNode Ann))
-> (Term Symbol Ann -> Maybe (SourceNode Ann))
-> Term Symbol Ann
-> MaybeT Lsp (SourceNode Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos (Term Symbol Ann -> Maybe (SourceNode Ann))
-> (Term Symbol Ann -> Term Symbol Ann)
-> Term Symbol Ann
-> Maybe (SourceNode Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term Symbol Ann -> Term Symbol Ann
forall v. Ord v => Term v Ann -> Term v Ann
removeInferredTypeAnnotations) ([(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
  Maybe (Type Symbol Ann))]
testWatchSummary [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
  Maybe (Type Symbol Ann))]
-> Getting
     (Endo [Term Symbol Ann])
     [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
       Maybe (Type Symbol Ann))]
     (Term Symbol Ann)
-> [Term Symbol Ann]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. ((Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
  Maybe (Type Symbol Ann))
 -> Const
      (Endo [Term Symbol Ann])
      (Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
       Maybe (Type Symbol Ann)))
-> [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
     Maybe (Type Symbol Ann))]
-> Const
     (Endo [Term Symbol Ann])
     [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
       Maybe (Type Symbol Ann))]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold
  Int
  [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
    Maybe (Type Symbol Ann))]
  (Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
   Maybe (Type Symbol Ann))
folded (((Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
   Maybe (Type Symbol Ann))
  -> Const
       (Endo [Term Symbol Ann])
       (Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
        Maybe (Type Symbol Ann)))
 -> [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
      Maybe (Type Symbol Ann))]
 -> Const
      (Endo [Term Symbol Ann])
      [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
        Maybe (Type Symbol Ann))])
-> ((Term Symbol Ann
     -> Const (Endo [Term Symbol Ann]) (Term Symbol Ann))
    -> (Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
        Maybe (Type Symbol Ann))
    -> Const
         (Endo [Term Symbol Ann])
         (Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
          Maybe (Type Symbol Ann)))
-> Getting
     (Endo [Term Symbol Ann])
     [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
       Maybe (Type Symbol Ann))]
     (Term Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term Symbol Ann
 -> Const (Endo [Term Symbol Ann]) (Term Symbol Ann))
-> (Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
    Maybe (Type Symbol Ann))
-> Const
     (Endo [Term Symbol Ann])
     (Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
      Maybe (Type Symbol Ann))
forall s t a b. Field4 s t a b => Lens s t a b
Lens
  (Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
   Maybe (Type Symbol Ann))
  (Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
   Maybe (Type Symbol Ann))
  (Term Symbol Ann)
  (Term Symbol Ann)
_4)
      MaybeT Lsp (SourceNode Ann)
-> MaybeT Lsp (SourceNode Ann) -> MaybeT Lsp (SourceNode Ann)
forall a. MaybeT Lsp a -> MaybeT Lsp a -> MaybeT Lsp a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Term Symbol Ann -> MaybeT Lsp (SourceNode Ann))
-> [Term Symbol Ann] -> MaybeT Lsp (SourceNode Ann)
forall (f :: * -> *) (t :: * -> *) a b.
(Alternative f, Foldable t) =>
(a -> f b) -> t a -> f b
altMap (Maybe (SourceNode Ann) -> MaybeT Lsp (SourceNode Ann)
forall a. Maybe a -> MaybeT Lsp a
hoistMaybe (Maybe (SourceNode Ann) -> MaybeT Lsp (SourceNode Ann))
-> (Term Symbol Ann -> Maybe (SourceNode Ann))
-> Term Symbol Ann
-> MaybeT Lsp (SourceNode Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Term Symbol Ann -> Maybe (SourceNode Ann)
findSmallestEnclosingNode Pos
pos (Term Symbol Ann -> Maybe (SourceNode Ann))
-> (Term Symbol Ann -> Term Symbol Ann)
-> Term Symbol Ann
-> Maybe (SourceNode Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term Symbol Ann -> Term Symbol Ann
forall v. Ord v => Term v Ann -> Term v Ann
removeInferredTypeAnnotations) ([(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
  Maybe (Type Symbol Ann), Maybe WatchKind)]
exprWatchSummary [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
  Maybe (Type Symbol Ann), Maybe WatchKind)]
-> Getting
     (Endo [Term Symbol Ann])
     [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
       Maybe (Type Symbol Ann), Maybe WatchKind)]
     (Term Symbol Ann)
-> [Term Symbol Ann]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. ((Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
  Maybe (Type Symbol Ann), Maybe WatchKind)
 -> Const
      (Endo [Term Symbol Ann])
      (Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
       Maybe (Type Symbol Ann), Maybe WatchKind))
-> [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
     Maybe (Type Symbol Ann), Maybe WatchKind)]
-> Const
     (Endo [Term Symbol Ann])
     [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
       Maybe (Type Symbol Ann), Maybe WatchKind)]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold
  Int
  [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
    Maybe (Type Symbol Ann), Maybe WatchKind)]
  (Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
   Maybe (Type Symbol Ann), Maybe WatchKind)
folded (((Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
   Maybe (Type Symbol Ann), Maybe WatchKind)
  -> Const
       (Endo [Term Symbol Ann])
       (Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
        Maybe (Type Symbol Ann), Maybe WatchKind))
 -> [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
      Maybe (Type Symbol Ann), Maybe WatchKind)]
 -> Const
      (Endo [Term Symbol Ann])
      [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
        Maybe (Type Symbol Ann), Maybe WatchKind)])
-> ((Term Symbol Ann
     -> Const (Endo [Term Symbol Ann]) (Term Symbol Ann))
    -> (Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
        Maybe (Type Symbol Ann), Maybe WatchKind)
    -> Const
         (Endo [Term Symbol Ann])
         (Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
          Maybe (Type Symbol Ann), Maybe WatchKind))
-> Getting
     (Endo [Term Symbol Ann])
     [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
       Maybe (Type Symbol Ann), Maybe WatchKind)]
     (Term Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term Symbol Ann
 -> Const (Endo [Term Symbol Ann]) (Term Symbol Ann))
-> (Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
    Maybe (Type Symbol Ann), Maybe WatchKind)
-> Const
     (Endo [Term Symbol Ann])
     (Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
      Maybe (Type Symbol Ann), Maybe WatchKind)
forall s t a b. Field4 s t a b => Lens s t a b
Lens
  (Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
   Maybe (Type Symbol Ann), Maybe WatchKind)
  (Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
   Maybe (Type Symbol Ann), Maybe WatchKind)
  (Term Symbol Ann)
  (Term Symbol Ann)
_4)
      MaybeT Lsp (SourceNode Ann)
-> MaybeT Lsp (SourceNode Ann) -> MaybeT Lsp (SourceNode Ann)
forall a. MaybeT Lsp a -> MaybeT Lsp a -> MaybeT Lsp a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Type Symbol Ann -> MaybeT Lsp (SourceNode Ann))
-> [Type Symbol Ann] -> MaybeT Lsp (SourceNode Ann)
forall (f :: * -> *) (t :: * -> *) a b.
(Alternative f, Foldable t) =>
(a -> f b) -> t a -> f b
altMap ((Type Symbol Ann -> SourceNode Ann)
-> MaybeT Lsp (Type Symbol Ann) -> MaybeT Lsp (SourceNode Ann)
forall a b. (a -> b) -> MaybeT Lsp a -> MaybeT Lsp b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type Symbol Ann -> SourceNode Ann
forall a. Type Symbol a -> SourceNode a
TypeNode (MaybeT Lsp (Type Symbol Ann) -> MaybeT Lsp (SourceNode Ann))
-> (Type Symbol Ann -> MaybeT Lsp (Type Symbol Ann))
-> Type Symbol Ann
-> MaybeT Lsp (SourceNode Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Type Symbol Ann) -> MaybeT Lsp (Type Symbol Ann)
forall a. Maybe a -> MaybeT Lsp a
hoistMaybe (Maybe (Type Symbol Ann) -> MaybeT Lsp (Type Symbol Ann))
-> (Type Symbol Ann -> Maybe (Type Symbol Ann))
-> Type Symbol Ann
-> MaybeT Lsp (Type Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Type Symbol Ann -> Maybe (Type Symbol Ann)
findSmallestEnclosingType Pos
pos) [Type Symbol Ann]
typs
    )
  where
    hoistMaybe :: Maybe a -> MaybeT Lsp a
    hoistMaybe :: forall a. Maybe a -> MaybeT Lsp a
hoistMaybe = Lsp (Maybe a) -> MaybeT Lsp a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Lsp (Maybe a) -> MaybeT Lsp a)
-> (Maybe a -> Lsp (Maybe a)) -> Maybe a -> MaybeT Lsp a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> Lsp (Maybe a)
forall a. a -> Lsp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

annIsFilePosition :: Ann -> Bool
annIsFilePosition :: Ann -> IsTop
annIsFilePosition = \case
  Ann
Ann.Intrinsic -> IsTop
False
  Ann
Ann.External -> IsTop
False
  Ann.Ann {} -> IsTop
True
  Ann.GeneratedFrom Ann
ann -> Ann -> IsTop
annIsFilePosition Ann
ann

-- | Okay, so currently during synthesis in typechecking the typechecker adds `Ann` nodes
-- to the term specifying types of subterms. This is a problem because we the types in these
-- Ann nodes are just tagged with the full `Ann` from the term it was inferred for, even
-- though none of these types exist in the file, and at a glance we can't tell whether a type
-- is inferred or user-specified.
--
-- So for now we crawl the term and remove any Ann nodes from within. The downside being you
-- can no longer hover on Type signatures within a term, but the benefit is that hover
-- actually works.
removeInferredTypeAnnotations :: (Ord v) => Term.Term v Ann -> Term.Term v Ann
removeInferredTypeAnnotations :: forall v. Ord v => Term v Ann -> Term v Ann
removeInferredTypeAnnotations =
  ASetter (Term v Ann) (Term v Ann) (Term v Ann) (Term v Ann)
-> (Term v Ann -> Term v Ann) -> Term v Ann -> Term v Ann
forall a b. ASetter a b a b -> (b -> b) -> a -> b
Lens.transformOf (forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"out" ((ABT (F v Ann Ann) v (Term v Ann)
  -> Identity (ABT (F v Ann Ann) v (Term v Ann)))
 -> Term v Ann -> Identity (Term v Ann))
-> ((Term v Ann -> Identity (Term v Ann))
    -> ABT (F v Ann Ann) v (Term v Ann)
    -> Identity (ABT (F v Ann Ann) v (Term v Ann)))
-> ASetter (Term v Ann) (Term v Ann) (Term v Ann) (Term v Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term v Ann -> Identity (Term v Ann))
-> ABT (F v Ann Ann) v (Term v Ann)
-> Identity (ABT (F v Ann Ann) v (Term v Ann))
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  (ABT (F v Ann Ann) v (Term v Ann))
  (ABT (F v Ann Ann) v (Term v Ann))
  (Term v Ann)
  (Term v Ann)
traversed) \case
    ABT.Term {out :: forall (f :: * -> *) v a. Term f v a -> ABT f v (Term f v a)
out = ABT.Tm (Term.Ann Term v Ann
trm Type v Ann
typ)}
      -- If the type's annotation is identical to the term's annotation, then this must be an inferred type
      | Type v Ann -> Ann
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Type v Ann
typ Ann -> Ann -> IsTop
forall a. Eq a => a -> a -> IsTop
== Term v Ann -> Ann
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v Ann
trm -> Term v Ann
trm
    Term v Ann
t -> Term v Ann
t

-- | Renders all docs for a given FQN to markdown.
markdownDocsForFQN :: Uri -> HQ.HashQualified Name -> Lsp [Text]
markdownDocsForFQN :: Uri -> HashQualified Name -> Lsp [Text]
markdownDocsForFQN Uri
fileUri HashQualified Name
fqn =
  [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Text] -> [Text]) -> Lsp (Maybe [Text]) -> Lsp [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeT Lsp [Text] -> Lsp (Maybe [Text])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
    PrettyPrintEnvDecl
pped <- 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
$ Uri -> Lsp PrettyPrintEnvDecl
ppedForFile Uri
fileUri
    Name
name <- Lsp (Maybe Name) -> MaybeT Lsp Name
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Lsp (Maybe Name) -> MaybeT Lsp Name)
-> (Maybe Name -> Lsp (Maybe Name))
-> Maybe Name
-> MaybeT Lsp Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Name -> Lsp (Maybe Name)
forall a. a -> Lsp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Name -> MaybeT Lsp Name) -> Maybe Name -> MaybeT Lsp Name
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Maybe Name
forall n. HashQualified n -> Maybe n
HQ.toName HashQualified Name
fqn
    NameSearch Transaction
nameSearch <- Lsp (NameSearch Transaction) -> MaybeT Lsp (NameSearch Transaction)
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 (NameSearch Transaction)
 -> MaybeT Lsp (NameSearch Transaction))
-> Lsp (NameSearch Transaction)
-> MaybeT Lsp (NameSearch Transaction)
forall a b. (a -> b) -> a -> b
$ Lsp (NameSearch Transaction)
getNameSearch
    Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase, Runtime Symbol
runtime :: Runtime Symbol
$sel:runtime:Env :: Env -> Runtime Symbol
runtime} <- MaybeT Lsp Env
forall r (m :: * -> *). MonadReader r m => m r
ask
    IO [Text] -> MaybeT Lsp [Text]
forall a. IO a -> MaybeT Lsp a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> MaybeT Lsp [Text]) -> IO [Text] -> MaybeT Lsp [Text]
forall a b. (a -> b) -> a -> b
$ do
      [TypeReference]
docRefs <- Codebase IO Symbol Ann
-> Transaction [TypeReference] -> IO [TypeReference]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase (Transaction [TypeReference] -> IO [TypeReference])
-> Transaction [TypeReference] -> IO [TypeReference]
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann
-> NameSearch Transaction
-> SearchType
-> Name
-> Transaction [TypeReference]
Backend.docsForDefinitionName Codebase IO Symbol Ann
codebase NameSearch Transaction
nameSearch SearchType
ExactName Name
name
      [TypeReference] -> (TypeReference -> IO Text) -> IO [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [TypeReference]
docRefs ((TypeReference -> IO Text) -> IO [Text])
-> (TypeReference -> IO Text) -> IO [Text]
forall a b. (a -> b) -> a -> b
$ \TypeReference
docRef -> do
        Identity (Text
_, Text
_, Doc
doc, [Error]
_evalErrs) <- PrettyPrintEnvDecl
-> Width
-> Codebase IO Symbol Ann
-> Runtime Symbol
-> Identity TypeReference
-> IO (Identity (Text, Text, Doc, [Error]))
forall (t :: * -> *).
Traversable t =>
PrettyPrintEnvDecl
-> Width
-> Codebase IO Symbol Ann
-> Runtime Symbol
-> t TypeReference
-> IO (t (Text, Text, Doc, [Error]))
Backend.renderDocRefs PrettyPrintEnvDecl
pped (Int -> Width
Pretty.Width Int
80) Codebase IO Symbol Ann
codebase Runtime Symbol
runtime (TypeReference -> Identity TypeReference
forall a. a -> Identity a
Identity TypeReference
docRef)
        Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> ([Markdown] -> Text) -> [Markdown] -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Markdown] -> Text
Md.toText ([Markdown] -> IO Text) -> [Markdown] -> IO Text
forall a b. (a -> b) -> a -> b
$ Doc -> [Markdown]
Md.toMarkdown Doc
doc