{-# 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,
    nodeAtPositionMatching,
    refInTerm,
    refInType,
    findSmallestEnclosingNode,
    findSmallestEnclosingType,
    findSmallestEnclosingTypeMatching,
    findSmallestEnclosingNodeMatching,
    findSmallestEnclosingPattern,
    findSmallestEnclosingPatternMatching,
    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 :: forall m. (Lspish m) => Uri -> Position -> MaybeT m LabeledDependency
refAtPosition :: forall (m :: * -> *).
Lspish m =>
Uri -> Position -> MaybeT m LabeledDependency
refAtPosition Uri
uri Position
pos = do
  MaybeT m LabeledDependency
findInNode MaybeT m LabeledDependency
-> MaybeT m LabeledDependency -> MaybeT m LabeledDependency
forall a. MaybeT m a -> MaybeT m a -> MaybeT m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MaybeT m LabeledDependency
findInDecl
  where
    findInNode :: MaybeT m LabeledDependency
    findInNode :: MaybeT m LabeledDependency
findInNode =
      Uri -> Position -> MaybeT m (SourceNode Ann)
forall (m :: * -> *).
Lspish m =>
Uri -> Position -> MaybeT m (SourceNode Ann)
nodeAtPosition Uri
uri Position
pos MaybeT m (SourceNode Ann)
-> (SourceNode Ann -> MaybeT m LabeledDependency)
-> MaybeT m LabeledDependency
forall a b. MaybeT m a -> (a -> MaybeT m b) -> MaybeT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        TermNode Term Symbol Ann
term -> Maybe LabeledDependency -> MaybeT m LabeledDependency
forall a. Maybe a -> MaybeT m a
hoistMaybe (Maybe LabeledDependency -> MaybeT m LabeledDependency)
-> Maybe LabeledDependency -> MaybeT m 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 m LabeledDependency
forall a. Maybe a -> MaybeT m a
hoistMaybe (Maybe LabeledDependency -> MaybeT m LabeledDependency)
-> Maybe LabeledDependency -> MaybeT m LabeledDependency
forall a b. (a -> b) -> a -> b
$ (Reference -> LabeledDependency)
-> Maybe Reference -> Maybe LabeledDependency
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Reference -> LabeledDependency
TypeReference (Type Symbol Ann -> Maybe Reference
forall v a. Type v a -> Maybe Reference
refInType Type Symbol Ann
typ)
        PatternNode Pattern Ann
pat -> Maybe LabeledDependency -> MaybeT m LabeledDependency
forall a. Maybe a -> MaybeT m a
hoistMaybe (Maybe LabeledDependency -> MaybeT m LabeledDependency)
-> Maybe LabeledDependency -> MaybeT m LabeledDependency
forall a b. (a -> b) -> a -> b
$ Pattern Ann -> Maybe LabeledDependency
forall a. Pattern a -> Maybe LabeledDependency
refInPattern Pattern Ann
pat
    findInDecl :: MaybeT m LabeledDependency
    findInDecl :: MaybeT m LabeledDependency
findInDecl =
      Reference -> LabeledDependency
LD.TypeReference (Reference -> LabeledDependency)
-> MaybeT m Reference -> MaybeT m 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 m FileSummary
forall (m :: * -> *). Lspish m => Uri -> MaybeT m FileSummary
getFileSummary Uri
uri
        ( ((Id, DataDeclaration Symbol Ann) -> MaybeT m Reference)
-> Map Symbol (Id, DataDeclaration Symbol Ann)
-> MaybeT m Reference
forall (f :: * -> *) (t :: * -> *) a b.
(Alternative f, Foldable t) =>
(a -> f b) -> t a -> f b
altMap (Maybe Reference -> MaybeT m Reference
forall a. Maybe a -> MaybeT m a
hoistMaybe (Maybe Reference -> MaybeT m Reference)
-> ((Id, DataDeclaration Symbol Ann) -> Maybe Reference)
-> (Id, DataDeclaration Symbol Ann)
-> MaybeT m Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Decl Symbol Ann -> Maybe Reference
refInDecl Pos
uPos (Decl Symbol Ann -> Maybe Reference)
-> ((Id, DataDeclaration Symbol Ann) -> Decl Symbol Ann)
-> (Id, DataDeclaration Symbol Ann)
-> Maybe Reference
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 m Reference -> MaybeT m Reference -> MaybeT m Reference
forall a. MaybeT m a -> MaybeT m a -> MaybeT m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Id, EffectDeclaration Symbol Ann) -> MaybeT m Reference)
-> Map Symbol (Id, EffectDeclaration Symbol Ann)
-> MaybeT m Reference
forall (f :: * -> *) (t :: * -> *) a b.
(Alternative f, Foldable t) =>
(a -> f b) -> t a -> f b
altMap (Maybe Reference -> MaybeT m Reference
forall a. Maybe a -> MaybeT m a
hoistMaybe (Maybe Reference -> MaybeT m Reference)
-> ((Id, EffectDeclaration Symbol Ann) -> Maybe Reference)
-> (Id, EffectDeclaration Symbol Ann)
-> MaybeT m Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Decl Symbol Ann -> Maybe Reference
refInDecl Pos
uPos (Decl Symbol Ann -> Maybe Reference)
-> ((Id, EffectDeclaration Symbol Ann) -> Decl Symbol Ann)
-> (Id, EffectDeclaration Symbol Ann)
-> Maybe Reference
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 m a
    hoistMaybe :: forall a. Maybe a -> MaybeT m a
hoistMaybe = m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe a) -> MaybeT m a)
-> (Maybe a -> m (Maybe a)) -> Maybe a -> MaybeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> m (Maybe a)
forall a. a -> m 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 :: (Lspish m) => Uri -> Referent -> MaybeT m (Type Symbol Ann)
getTypeOfReferent :: forall (m :: * -> *).
Lspish m =>
Uri -> Referent -> MaybeT m (Type Symbol Ann)
getTypeOfReferent Uri
fileUri Referent
ref = do
  MaybeT m (Type Symbol Ann)
getFromFile MaybeT m (Type Symbol Ann)
-> MaybeT m (Type Symbol Ann) -> MaybeT m (Type Symbol Ann)
forall a. MaybeT m a -> MaybeT m a -> MaybeT m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MaybeT m (Type Symbol Ann)
getFromCodebase
  where
    getFromFile :: MaybeT m (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 m FileSummary
forall (m :: * -> *). Lspish m => Uri -> MaybeT m FileSummary
getFileSummary Uri
fileUri
      case Referent
ref of
        Referent.Ref (Reference.Builtin {}) -> MaybeT m (Type Symbol Ann)
forall a. MaybeT m a
forall (f :: * -> *) a. Alternative f => f a
empty
        Referent.Ref (Reference.DerivedId Id
termRefId) -> do
          m (Maybe (Type Symbol Ann)) -> MaybeT m (Type Symbol Ann)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe (Type Symbol Ann)) -> MaybeT m (Type Symbol Ann))
-> (Maybe (Type Symbol Ann) -> m (Maybe (Type Symbol Ann)))
-> Maybe (Type Symbol Ann)
-> MaybeT m (Type Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Type Symbol Ann) -> m (Maybe (Type Symbol Ann))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Type Symbol Ann) -> MaybeT m (Type Symbol Ann))
-> Maybe (Type Symbol Ann) -> MaybeT m (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 Reference
r0 ConstructorId
cid) ConstructorType
_type -> do
          case Reference
r0 of
            Reference.DerivedId Id
r -> do
              Decl Symbol Ann
decl <- Uri -> Id -> MaybeT m (Decl Symbol Ann)
forall (m :: * -> *).
Lspish m =>
Uri -> Id -> MaybeT m (Decl Symbol Ann)
getTypeDeclaration Uri
fileUri Id
r
              m (Maybe (Type Symbol Ann)) -> MaybeT m (Type Symbol Ann)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe (Type Symbol Ann)) -> MaybeT m (Type Symbol Ann))
-> (Maybe (Type Symbol Ann) -> m (Maybe (Type Symbol Ann)))
-> Maybe (Type Symbol Ann)
-> MaybeT m (Type Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Type Symbol Ann) -> m (Maybe (Type Symbol Ann))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Type Symbol Ann) -> MaybeT m (Type Symbol Ann))
-> Maybe (Type Symbol Ann) -> MaybeT m (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 m (Type Symbol Ann)
forall a. MaybeT m a
forall (f :: * -> *) a. Alternative f => f a
empty
    getFromCodebase :: MaybeT m (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 m Env
forall r (m :: * -> *). MonadReader r m => m r
ask
      m (Maybe (Type Symbol Ann)) -> MaybeT m (Type Symbol Ann)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe (Type Symbol Ann)) -> MaybeT m (Type Symbol Ann))
-> (IO (Maybe (Type Symbol Ann)) -> m (Maybe (Type Symbol Ann)))
-> IO (Maybe (Type Symbol Ann))
-> MaybeT m (Type Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe (Type Symbol Ann)) -> m (Maybe (Type Symbol Ann))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Type Symbol Ann)) -> MaybeT m (Type Symbol Ann))
-> IO (Maybe (Type Symbol Ann)) -> MaybeT m (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 :: forall m. (Lspish m) => Uri -> Reference.Id -> MaybeT m (Decl Symbol Ann)
getTypeDeclaration :: forall (m :: * -> *).
Lspish m =>
Uri -> Id -> MaybeT m (Decl Symbol Ann)
getTypeDeclaration Uri
fileUri Id
refId = do
  MaybeT m (Decl Symbol Ann)
getFromFile MaybeT m (Decl Symbol Ann)
-> MaybeT m (Decl Symbol Ann) -> MaybeT m (Decl Symbol Ann)
forall a. MaybeT m a -> MaybeT m a -> MaybeT m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MaybeT m (Decl Symbol Ann)
getFromCodebase
  where
    getFromFile :: MaybeT m (Decl Symbol Ann)
    getFromFile :: MaybeT m (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 m FileSummary
forall (m :: * -> *). Lspish m => Uri -> MaybeT m 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
      m (Maybe (Decl Symbol Ann)) -> MaybeT m (Decl Symbol Ann)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe (Decl Symbol Ann)) -> MaybeT m (Decl Symbol Ann))
-> ([Decl Symbol Ann] -> m (Maybe (Decl Symbol Ann)))
-> [Decl Symbol Ann]
-> MaybeT m (Decl Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Decl Symbol Ann) -> m (Maybe (Decl Symbol Ann))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Decl Symbol Ann) -> m (Maybe (Decl Symbol Ann)))
-> ([Decl Symbol Ann] -> Maybe (Decl Symbol Ann))
-> [Decl Symbol Ann]
-> m (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 m (Decl Symbol Ann))
-> [Decl Symbol Ann] -> MaybeT m (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 m (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 m Env
forall r (m :: * -> *). MonadReader r m => m r
ask
      m (Maybe (Decl Symbol Ann)) -> MaybeT m (Decl Symbol Ann)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe (Decl Symbol Ann)) -> MaybeT m (Decl Symbol Ann))
-> (IO (Maybe (Decl Symbol Ann)) -> m (Maybe (Decl Symbol Ann)))
-> IO (Maybe (Decl Symbol Ann))
-> MaybeT m (Decl Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe (Decl Symbol Ann)) -> m (Maybe (Decl Symbol Ann))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Decl Symbol Ann)) -> MaybeT m (Decl Symbol Ann))
-> IO (Maybe (Decl Symbol Ann)) -> MaybeT m (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 Reference
ref -> LabeledDependency -> Maybe LabeledDependency
forall a. a -> Maybe a
Just (Reference -> LabeledDependency
LD.TermReference Reference
ref)
      Term.Constructor GConstructorReference Reference
conRef -> LabeledDependency -> Maybe LabeledDependency
forall a. a -> Maybe a
Just (GConstructorReference Reference
-> ConstructorType -> LabeledDependency
LD.ConReference GConstructorReference Reference
conRef ConstructorType
CT.Data)
      Term.Request GConstructorReference Reference
conRef -> LabeledDependency -> Maybe LabeledDependency
forall a. a -> Maybe a
Just (GConstructorReference Reference
-> ConstructorType -> LabeledDependency
LD.ConReference GConstructorReference Reference
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 Reference
ref -> LabeledDependency -> Maybe LabeledDependency
forall a. a -> Maybe a
Just (Reference -> LabeledDependency
LD.TypeReference Reference
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 Reference
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 Reference
ref -> Reference -> Maybe Reference
forall a. a -> Maybe a
Just Reference
ref
    Type.Arrow Type v a
_a Type v a
_b -> Maybe Reference
forall a. Maybe a
Nothing
    Type.Effect Type v a
_a Type v a
_b -> Maybe Reference
forall a. Maybe a
Nothing
    Type.App Type v a
_a Type v a
_b -> Maybe Reference
forall a. Maybe a
Nothing
    Type.Forall Type v a
_r -> Maybe Reference
forall a. Maybe a
Nothing
    Type.Ann Type v a
_a Kind
_kind -> Maybe Reference
forall a. Maybe a
Nothing
    Type.Effects [Type v a]
_es -> Maybe Reference
forall a. Maybe a
Nothing
    Type.IntroOuter Type v a
_a -> Maybe Reference
forall a. Maybe a
Nothing
  ABT.Var v
_v -> Maybe Reference
forall a. Maybe a
Nothing
  ABT.Cycle Type v a
_r -> Maybe Reference
forall a. Maybe a
Nothing
  ABT.Abs v
_v Type v a
_r -> Maybe Reference
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 Reference
conRef [Pattern a]
_ -> LabeledDependency -> Maybe LabeledDependency
forall a. a -> Maybe a
Just (GConstructorReference Reference
-> ConstructorType -> LabeledDependency
LD.ConReference GConstructorReference Reference
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 Reference
conRef [Pattern a]
_ Pattern a
_ -> LabeledDependency -> Maybe LabeledDependency
forall a. a -> Maybe a
Just (GConstructorReference Reference
-> ConstructorType -> LabeledDependency
LD.ConReference GConstructorReference Reference
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 -> String
(Int -> SourceNode a -> ShowS)
-> (SourceNode a -> String)
-> ([SourceNode a] -> ShowS)
-> Show (SourceNode a)
forall a. Int -> SourceNode a -> ShowS
forall a. [SourceNode a] -> ShowS
forall a. SourceNode a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> SourceNode a -> ShowS
showsPrec :: Int -> SourceNode a -> ShowS
$cshow :: forall a. SourceNode a -> String
show :: SourceNode a -> String
$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 = Pos
-> (SourceNode Ann -> Maybe (SourceNode Ann))
-> Term Symbol Ann
-> Maybe (SourceNode Ann)
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> Maybe (SourceNode Ann)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term Symbol Ann
term

-- | Find the node in a term which contains the specified position, but none of its
-- children contain that position
findSmallestEnclosingNodeMatching :: forall m a. (MonadPlus m) => Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching :: forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred Term Symbol Ann
term
  | ABT.Term Set Symbol
_ Ann
absAnn (ABT.Abs Symbol
_ Term Symbol Ann
body) <- Term Symbol Ann
term =
      -- Abs nodes annotate the location of the var being bound, not the body of the binding, so we either match on
      -- the binding, or skip over them to the body.
      if Ann
absAnn Ann -> Pos -> IsTop
`Ann.contains` Pos
pos
        then Term Symbol Ann -> m a
termPred Term Symbol Ann
term m a -> m a -> m a
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred Term Symbol Ann
body
        else Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred Term Symbol Ann
body
  | Ann -> IsTop
annIsFilePosition Ann
ann IsTop -> IsTop -> IsTop
&& IsTop -> IsTop
not (Ann
ann Ann -> Pos -> IsTop
`Ann.contains` Pos
pos) = m a
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
  | Just Term Symbol Ann
r <- Term Symbol Ann -> Maybe (Term Symbol Ann)
cleanImplicitUnit Term Symbol Ann
term = Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred 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 :: m ()
guardInFile = IsTop -> m ()
forall (f :: * -> *). Alternative f => IsTop -> f ()
guard (Ann -> IsTop
annIsFilePosition Ann
ann)
      let bestChild :: m a
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 {} -> m ()
guardInFile m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Term Symbol Ann -> m a
termPred Term Symbol Ann
term
              Term.Nat {} -> m ()
guardInFile m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Term Symbol Ann -> m a
termPred Term Symbol Ann
term
              Term.Float {} -> m ()
guardInFile m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Term Symbol Ann -> m a
termPred Term Symbol Ann
term
              Term.Boolean {} -> m ()
guardInFile m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Term Symbol Ann -> m a
termPred Term Symbol Ann
term
              Term.Text {} -> m ()
guardInFile m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Term Symbol Ann -> m a
termPred Term Symbol Ann
term
              Term.Char {} -> m ()
guardInFile m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Term Symbol Ann -> m a
termPred Term Symbol Ann
term
              Term.Blank {} -> m ()
guardInFile m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Term Symbol Ann -> m a
termPred Term Symbol Ann
term
              Term.Ref {} -> m ()
guardInFile m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Term Symbol Ann -> m a
termPred Term Symbol Ann
term
              Term.Constructor {} -> m ()
guardInFile m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Term Symbol Ann -> m a
termPred Term Symbol Ann
term
              Term.Request {} -> m ()
guardInFile m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Term Symbol Ann -> m a
termPred Term Symbol Ann
term
              Term.Handle Term Symbol Ann
a Term Symbol Ann
b -> Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred Term Symbol Ann
a m a -> m a -> m a
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred 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 -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred Term Symbol Ann
b m a -> m a -> m a
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred Term Symbol Ann
a
              Term.Ann Term Symbol Ann
a Type Symbol Ann
typ -> Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred Term Symbol Ann
a m a -> m a -> m a
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
findSmallestEnclosingTypeMatching Pos
pos Type Symbol Ann -> m a
typePred Type Symbol Ann
typ)
              Term.List Seq (Term Symbol Ann)
xs -> Seq (m a) -> m a
forall (f :: * -> *) (t :: * -> *) a.
(Alternative f, Foldable t) =>
t (f a) -> f a
altSum (Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred (Term Symbol Ann -> m a) -> Seq (Term Symbol Ann) -> Seq (m a)
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 -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred Term Symbol Ann
cond m a -> m a -> m a
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred Term Symbol Ann
a m a -> m a -> m a
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred Term Symbol Ann
b
              Term.And Term Symbol Ann
l Term Symbol Ann
r -> Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred Term Symbol Ann
l m a -> m a -> m a
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred Term Symbol Ann
r
              Term.Or Term Symbol Ann
l Term Symbol Ann
r -> Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred Term Symbol Ann
l m a -> m a -> m a
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred Term Symbol Ann
r
              Term.Lam Term Symbol Ann
a -> Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred Term Symbol Ann
a
              Term.LetRec IsTop
_isTop [Term Symbol Ann]
xs Term Symbol Ann
y ->
                [m a] -> m a
forall (f :: * -> *) (t :: * -> *) a.
(Alternative f, Foldable t) =>
t (f a) -> f a
altSum (Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred (Term Symbol Ann -> m a) -> [Term Symbol Ann] -> [m a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Term Symbol Ann]
xs)
                  m a -> m a -> m a
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred Term Symbol Ann
y
              Term.Let IsTop
_isTop Term Symbol Ann
a Term Symbol Ann
b ->
                Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred Term Symbol Ann
a
                  m a -> m a -> m a
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred Term Symbol Ann
b
              Term.Match Term Symbol Ann
a [MatchCase Ann (Term Symbol Ann)]
cases ->
                Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred Term Symbol Ann
a
                  m a -> m a -> m a
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [m a] -> m a
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) -> m a) -> [m a]
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) -> ((Pos -> (Pattern Ann -> m a) -> Pattern Ann -> m a
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Pattern Ann -> m a) -> Pattern Ann -> m a
findSmallestEnclosingPatternMatching Pos
pos Pattern Ann -> m a
patPred Pattern Ann
pat) m a -> m a -> m a
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe (Term Symbol Ann) -> m (Term Symbol Ann)
forall x. Maybe x -> m x
altMaybe Maybe (Term Symbol Ann)
grd m (Term Symbol Ann) -> (Term Symbol Ann -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred) m a -> m a -> m a
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred Term Symbol Ann
body))
              Term.TermLink {} -> m ()
guardInFile m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Term Symbol Ann -> m a
termPred Term Symbol Ann
term
              Term.TypeLink {} -> m ()
guardInFile m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Term Symbol Ann -> m a
termPred Term Symbol Ann
term
            ABT.Var Symbol
_v -> m ()
guardInFile m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Term Symbol Ann -> m a
termPred Term Symbol Ann
term
            ABT.Cycle Term Symbol Ann
r -> Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred Term Symbol Ann
r
            ABT.Abs Symbol
_v Term Symbol Ann
r -> Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> m a
pred Term Symbol Ann
r
      let fallback :: m a
fallback = if Ann -> IsTop
annIsFilePosition Ann
ann then Term Symbol Ann -> m a
termPred Term Symbol Ann
term else m a
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
      m a
bestChild m a -> m a -> m a
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m a
fallback
  where
    altMaybe :: Maybe x -> m x
    altMaybe :: forall x. Maybe x -> m x
altMaybe = m x -> (x -> m x) -> Maybe x -> m x
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m x
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty x -> m x
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    -- 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 Reference
ref ConstructorId
0))) Term Symbol Ann
x)) Term Symbol Ann
trm)
        | Reference
ref Reference -> Reference -> IsTop
forall a. Eq a => a -> a -> IsTop
== Reference
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
    termPred :: Term Symbol Ann -> m a
termPred = SourceNode Ann -> m a
pred (SourceNode Ann -> m a)
-> (Term Symbol Ann -> SourceNode Ann) -> Term Symbol Ann -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term Symbol Ann -> SourceNode Ann
forall a. Term Symbol a -> SourceNode a
TermNode
    typePred :: Type Symbol Ann -> m a
typePred = SourceNode Ann -> m a
pred (SourceNode Ann -> m a)
-> (Type Symbol Ann -> SourceNode Ann) -> Type Symbol Ann -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type Symbol Ann -> SourceNode Ann
forall a. Type Symbol a -> SourceNode a
TypeNode
    patPred :: Pattern Ann -> m a
patPred = SourceNode Ann -> m a
pred (SourceNode Ann -> m a)
-> (Pattern Ann -> SourceNode Ann) -> Pattern Ann -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern Ann -> SourceNode Ann
forall a. Pattern a -> SourceNode a
PatternNode

-- | 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 = Pos
-> (Pattern Ann -> Maybe (Pattern Ann))
-> Pattern Ann
-> Maybe (Pattern Ann)
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Pattern Ann -> m a) -> Pattern Ann -> m a
findSmallestEnclosingPatternMatching Pos
pos Pattern Ann -> Maybe (Pattern Ann)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pattern Ann
pat

findSmallestEnclosingPatternMatching ::
  forall m a.
  (Alternative m) =>
  Pos ->
  (Pattern.Pattern Ann -> m a) ->
  Pattern.Pattern Ann ->
  m a
findSmallestEnclosingPatternMatching :: forall (m :: * -> *) a.
Alternative m =>
Pos -> (Pattern Ann -> m a) -> Pattern Ann -> m a
findSmallestEnclosingPatternMatching Pos
pos Pattern Ann -> m a
pred Pattern Ann
pat
  | Just Pattern Ann
validTargets <- Pattern Ann -> Maybe (Pattern Ann)
cleanImplicitUnit Pattern Ann
pat = Pos -> (Pattern Ann -> m a) -> Pattern Ann -> m a
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Pattern Ann -> m a) -> Pattern Ann -> m a
findSmallestEnclosingPatternMatching Pos
pos Pattern Ann -> m a
pred 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) = m a
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
  | 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 :: m ()
guardInFile = IsTop -> m ()
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 :: m a
bestChild = case Pattern Ann
pat of
            Pattern.Unbound {} -> m ()
guardInFile m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Pattern Ann -> m a
pred Pattern Ann
pat
            Pattern.Var {} -> m ()
guardInFile m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Pattern Ann -> m a
pred Pattern Ann
pat
            Pattern.Boolean {} -> m ()
guardInFile m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Pattern Ann -> m a
pred Pattern Ann
pat
            Pattern.Int {} -> m ()
guardInFile m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Pattern Ann -> m a
pred Pattern Ann
pat
            Pattern.Nat {} -> m ()
guardInFile m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Pattern Ann -> m a
pred Pattern Ann
pat
            Pattern.Float {} -> m ()
guardInFile m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Pattern Ann -> m a
pred Pattern Ann
pat
            Pattern.Text {} -> m ()
guardInFile m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Pattern Ann -> m a
pred Pattern Ann
pat
            Pattern.Char {} -> m ()
guardInFile m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Pattern Ann -> m a
pred Pattern Ann
pat
            Pattern.Constructor Ann
_loc GConstructorReference Reference
_conRef [Pattern Ann]
pats -> [m a] -> m a
forall (f :: * -> *) (t :: * -> *) a.
(Alternative f, Foldable t) =>
t (f a) -> f a
altSum (Pos -> (Pattern Ann -> m a) -> Pattern Ann -> m a
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Pattern Ann -> m a) -> Pattern Ann -> m a
findSmallestEnclosingPatternMatching Pos
pos Pattern Ann -> m a
pred (Pattern Ann -> m a) -> [Pattern Ann] -> [m a]
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 -> m a) -> Pattern Ann -> m a
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Pattern Ann -> m a) -> Pattern Ann -> m a
findSmallestEnclosingPatternMatching Pos
pos Pattern Ann -> m a
pred Pattern Ann
p
            Pattern.EffectPure Ann
_loc Pattern Ann
p -> Pos -> (Pattern Ann -> m a) -> Pattern Ann -> m a
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Pattern Ann -> m a) -> Pattern Ann -> m a
findSmallestEnclosingPatternMatching Pos
pos Pattern Ann -> m a
pred Pattern Ann
p
            Pattern.EffectBind Ann
_loc GConstructorReference Reference
_conRef [Pattern Ann]
pats Pattern Ann
p -> [m a] -> m a
forall (f :: * -> *) (t :: * -> *) a.
(Alternative f, Foldable t) =>
t (f a) -> f a
altSum (Pos -> (Pattern Ann -> m a) -> Pattern Ann -> m a
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Pattern Ann -> m a) -> Pattern Ann -> m a
findSmallestEnclosingPatternMatching Pos
pos Pattern Ann -> m a
pred (Pattern Ann -> m a) -> [Pattern Ann] -> [m a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern Ann]
pats) m a -> m a -> m a
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> (Pattern Ann -> m a) -> Pattern Ann -> m a
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Pattern Ann -> m a) -> Pattern Ann -> m a
findSmallestEnclosingPatternMatching Pos
pos Pattern Ann -> m a
pred Pattern Ann
p
            Pattern.SequenceLiteral Ann
_loc [Pattern Ann]
pats -> [m a] -> m a
forall (f :: * -> *) (t :: * -> *) a.
(Alternative f, Foldable t) =>
t (f a) -> f a
altSum (Pos -> (Pattern Ann -> m a) -> Pattern Ann -> m a
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Pattern Ann -> m a) -> Pattern Ann -> m a
findSmallestEnclosingPatternMatching Pos
pos Pattern Ann -> m a
pred (Pattern Ann -> m a) -> [Pattern Ann] -> [m a]
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 -> m a) -> Pattern Ann -> m a
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Pattern Ann -> m a) -> Pattern Ann -> m a
findSmallestEnclosingPatternMatching Pos
pos Pattern Ann -> m a
pred Pattern Ann
p1 m a -> m a -> m a
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> (Pattern Ann -> m a) -> Pattern Ann -> m a
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Pattern Ann -> m a) -> Pattern Ann -> m a
findSmallestEnclosingPatternMatching Pos
pos Pattern Ann -> m a
pred Pattern Ann
p2
      let fallback :: m a
fallback = if Ann -> IsTop
annIsFilePosition (Pattern Ann -> Ann
forall a. Annotated a => a -> Ann
ann Pattern Ann
pat) then Pattern Ann -> m a
pred Pattern Ann
pat else m a
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
      m a
bestChild m a -> m a -> m a
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m a
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 Reference
conRef ConstructorId
0) [Pattern Ann
pat1, Pattern.Constructor Ann
_ (ConstructorReference Reference
mayUnitRef ConstructorId
0) [Pattern Ann]
_])
        | Reference
conRef Reference -> Reference -> IsTop
forall a. Eq a => a -> a -> IsTop
== Reference
Builtins.pairRef IsTop -> IsTop -> IsTop
&& Reference
mayUnitRef Reference -> Reference -> IsTop
forall a. Eq a => a -> a -> IsTop
== Reference
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 = Pos
-> (Type Symbol Ann -> Maybe (Type Symbol Ann))
-> Type Symbol Ann
-> Maybe (Type Symbol Ann)
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
findSmallestEnclosingTypeMatching Pos
pos Type Symbol Ann -> Maybe (Type Symbol Ann)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type Symbol Ann
typ

-- | 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.
findSmallestEnclosingTypeMatching :: (Alternative m) => Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
findSmallestEnclosingTypeMatching :: forall (m :: * -> *) a.
Alternative m =>
Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
findSmallestEnclosingTypeMatching Pos
pos Type Symbol Ann -> m a
pred Type Symbol Ann
typ
  | -- Abs nodes annotate the location of the var being bound, not the body of the binding, so we just skip over them.
    ABT.Abs'' Symbol
_ Type Symbol Ann
body <- Type Symbol Ann
typ =
      Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
findSmallestEnclosingTypeMatching Pos
pos Type Symbol Ann -> m a
pred Type Symbol Ann
body
  | 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) = m a
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
  | 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 :: m ()
guardInFile = IsTop -> m ()
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 :: m a
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 {} -> m ()
guardInFile m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Type Symbol Ann -> m a
pred Type Symbol Ann
typ
              Type.Arrow Type Symbol Ann
a Type Symbol Ann
b -> Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
findSmallestEnclosingTypeMatching Pos
pos Type Symbol Ann -> m a
pred Type Symbol Ann
a m a -> m a -> m a
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
findSmallestEnclosingTypeMatching Pos
pos Type Symbol Ann -> m a
pred 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 -> m a) -> Type Symbol Ann -> m a
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
findSmallestEnclosingTypeMatching Pos
pos Type Symbol Ann -> m a
pred Type Symbol Ann
rhs m a -> m a -> m a
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
findSmallestEnclosingTypeMatching Pos
pos Type Symbol Ann -> m a
pred Type Symbol Ann
effs
              Type.App Type Symbol Ann
a Type Symbol Ann
b -> Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
findSmallestEnclosingTypeMatching Pos
pos Type Symbol Ann -> m a
pred Type Symbol Ann
a m a -> m a -> m a
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
findSmallestEnclosingTypeMatching Pos
pos Type Symbol Ann -> m a
pred Type Symbol Ann
b
              Type.Forall Type Symbol Ann
r -> Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
findSmallestEnclosingTypeMatching Pos
pos Type Symbol Ann -> m a
pred Type Symbol Ann
r
              Type.Ann Type Symbol Ann
a Kind
_kind -> Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
findSmallestEnclosingTypeMatching Pos
pos Type Symbol Ann -> m a
pred Type Symbol Ann
a
              Type.Effects [Type Symbol Ann]
es -> [m a] -> m a
forall (f :: * -> *) (t :: * -> *) a.
(Alternative f, Foldable t) =>
t (f a) -> f a
altSum (Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
findSmallestEnclosingTypeMatching Pos
pos Type Symbol Ann -> m a
pred (Type Symbol Ann -> m a) -> [Type Symbol Ann] -> [m a]
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 -> m a) -> Type Symbol Ann -> m a
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
findSmallestEnclosingTypeMatching Pos
pos Type Symbol Ann -> m a
pred Type Symbol Ann
a
            ABT.Var Symbol
_v -> m ()
guardInFile m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Type Symbol Ann -> m a
pred Type Symbol Ann
typ
            ABT.Cycle Type Symbol Ann
r -> Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
findSmallestEnclosingTypeMatching Pos
pos Type Symbol Ann -> m a
pred Type Symbol Ann
r
            ABT.Abs Symbol
_v Type Symbol Ann
r -> Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
findSmallestEnclosingTypeMatching Pos
pos Type Symbol Ann -> m a
pred Type Symbol Ann
r
      let fallback :: m a
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 -> m a
pred Type Symbol Ann
typ else m a
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
      m a
bestChild m a -> m a -> m a
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m a
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 Reference
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 Reference)
-> Maybe Reference
forall a b. a -> (a -> b) -> b
& ((Ann, Symbol, Type Symbol Ann) -> Maybe Reference)
-> [(Ann, Symbol, Type Symbol Ann)] -> Maybe Reference
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
      Reference
ref <- Type Symbol Ann -> Maybe Reference
forall v a. Type v a -> Maybe Reference
refInType Type Symbol Ann
typeNode
      Reference -> Maybe Reference
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Reference
ref

-- | Returns the ABT node at the provided position.
-- Does not return Decl nodes.
nodeAtPosition :: (Lspish m) => Uri -> Position -> MaybeT m (SourceNode Ann)
nodeAtPosition :: forall (m :: * -> *).
Lspish m =>
Uri -> Position -> MaybeT m (SourceNode Ann)
nodeAtPosition Uri
uri Position
pos = Uri
-> Position
-> (SourceNode Ann -> MaybeT m (SourceNode Ann))
-> MaybeT m (SourceNode Ann)
forall (m :: * -> *) a.
Lspish m =>
Uri -> Position -> (SourceNode Ann -> MaybeT m a) -> MaybeT m a
nodeAtPositionMatching Uri
uri Position
pos SourceNode Ann -> MaybeT m (SourceNode Ann)
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Search the ABT for nodes which intersect at a given position, running the
-- provided selector on them and aligning results to prefer smaller containing nodes first.
-- The caller may use either 'pure' or 'empty' in the selector to select or ignore a given option.
--
-- Does not return Decl nodes.
nodeAtPositionMatching :: (Lspish m) => Uri -> Position -> (SourceNode Ann -> MaybeT m a) -> MaybeT m a
nodeAtPositionMatching :: forall (m :: * -> *) a.
Lspish m =>
Uri -> Position -> (SourceNode Ann -> MaybeT m a) -> MaybeT m a
nodeAtPositionMatching Uri
uri (Position -> Pos
lspToUPos -> Pos
pos) SourceNode Ann -> MaybeT m a
pred = 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 String)]
exprWatchSummary :: [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
  Maybe (Type Symbol Ann), Maybe String)]
$sel:exprWatchSummary:FileSummary :: FileSummary
-> [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
     Maybe (Type Symbol Ann), Maybe String)]
exprWatchSummary}) <- Uri -> MaybeT m FileSummary
forall (m :: * -> *). Lspish m => Uri -> MaybeT m 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 m a) -> [Term Symbol Ann] -> MaybeT m a
forall (f :: * -> *) (t :: * -> *) a b.
(Alternative f, Foldable t) =>
(a -> f b) -> t a -> f b
altMap (Pos
-> (SourceNode Ann -> MaybeT m a) -> Term Symbol Ann -> MaybeT m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> MaybeT m a
pred (Term Symbol Ann -> MaybeT m a)
-> (Term Symbol Ann -> Term Symbol Ann)
-> Term Symbol Ann
-> MaybeT m a
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 m a -> MaybeT m a -> MaybeT m a
forall a. MaybeT m a -> MaybeT m a -> MaybeT m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Term Symbol Ann -> MaybeT m a) -> [Term Symbol Ann] -> MaybeT m a
forall (f :: * -> *) (t :: * -> *) a b.
(Alternative f, Foldable t) =>
(a -> f b) -> t a -> f b
altMap (Pos
-> (SourceNode Ann -> MaybeT m a) -> Term Symbol Ann -> MaybeT m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> MaybeT m a
pred (Term Symbol Ann -> MaybeT m a)
-> (Term Symbol Ann -> Term Symbol Ann)
-> Term Symbol Ann
-> MaybeT m a
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 m a -> MaybeT m a -> MaybeT m a
forall a. MaybeT m a -> MaybeT m a -> MaybeT m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Term Symbol Ann -> MaybeT m a) -> [Term Symbol Ann] -> MaybeT m a
forall (f :: * -> *) (t :: * -> *) a b.
(Alternative f, Foldable t) =>
(a -> f b) -> t a -> f b
altMap (Pos
-> (SourceNode Ann -> MaybeT m a) -> Term Symbol Ann -> MaybeT m a
forall (m :: * -> *) a.
MonadPlus m =>
Pos -> (SourceNode Ann -> m a) -> Term Symbol Ann -> m a
findSmallestEnclosingNodeMatching Pos
pos SourceNode Ann -> MaybeT m a
pred (Term Symbol Ann -> MaybeT m a)
-> (Term Symbol Ann -> Term Symbol Ann)
-> Term Symbol Ann
-> MaybeT m a
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 String)]
exprWatchSummary [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
  Maybe (Type Symbol Ann), Maybe String)]
-> Getting
     (Endo [Term Symbol Ann])
     [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
       Maybe (Type Symbol Ann), Maybe String)]
     (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 String)
 -> Const
      (Endo [Term Symbol Ann])
      (Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
       Maybe (Type Symbol Ann), Maybe String))
-> [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
     Maybe (Type Symbol Ann), Maybe String)]
-> Const
     (Endo [Term Symbol Ann])
     [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
       Maybe (Type Symbol Ann), Maybe String)]
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 String)]
  (Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
   Maybe (Type Symbol Ann), Maybe String)
folded (((Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
   Maybe (Type Symbol Ann), Maybe String)
  -> Const
       (Endo [Term Symbol Ann])
       (Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
        Maybe (Type Symbol Ann), Maybe String))
 -> [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
      Maybe (Type Symbol Ann), Maybe String)]
 -> Const
      (Endo [Term Symbol Ann])
      [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
        Maybe (Type Symbol Ann), Maybe String)])
-> ((Term Symbol Ann
     -> Const (Endo [Term Symbol Ann]) (Term Symbol Ann))
    -> (Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
        Maybe (Type Symbol Ann), Maybe String)
    -> Const
         (Endo [Term Symbol Ann])
         (Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
          Maybe (Type Symbol Ann), Maybe String))
-> Getting
     (Endo [Term Symbol Ann])
     [(Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
       Maybe (Type Symbol Ann), Maybe String)]
     (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 String)
-> Const
     (Endo [Term Symbol Ann])
     (Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
      Maybe (Type Symbol Ann), Maybe String)
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 String)
  (Ann, Maybe Symbol, Maybe Id, Term Symbol Ann,
   Maybe (Type Symbol Ann), Maybe String)
  (Term Symbol Ann)
  (Term Symbol Ann)
_4)
      MaybeT m a -> MaybeT m a -> MaybeT m a
forall a. MaybeT m a -> MaybeT m a -> MaybeT m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Type Symbol Ann -> MaybeT m a) -> [Type Symbol Ann] -> MaybeT m a
forall (f :: * -> *) (t :: * -> *) a b.
(Alternative f, Foldable t) =>
(a -> f b) -> t a -> f b
altMap (Pos
-> (Type Symbol Ann -> MaybeT m a) -> Type Symbol Ann -> MaybeT m a
forall (m :: * -> *) a.
Alternative m =>
Pos -> (Type Symbol Ann -> m a) -> Type Symbol Ann -> m a
findSmallestEnclosingTypeMatching Pos
pos (SourceNode Ann -> MaybeT m a
pred (SourceNode Ann -> MaybeT m a)
-> (Type Symbol Ann -> SourceNode Ann)
-> Type Symbol Ann
-> MaybeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type Symbol Ann -> SourceNode Ann
forall a. Type Symbol a -> SourceNode a
TypeNode)) [Type Symbol Ann]
typs
    )

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 :: (Lspish m) => Uri -> HQ.HashQualified Name -> m [Text]
markdownDocsForFQN :: forall (m :: * -> *).
Lspish m =>
Uri -> HashQualified Name -> m [Text]
markdownDocsForFQN Uri
fileUri HashQualified Name
fqn =
  [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Text] -> [Text]) -> m (Maybe [Text]) -> m [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeT m [Text] -> m (Maybe [Text])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
    PrettyPrintEnvDecl
pped <- m PrettyPrintEnvDecl -> MaybeT m 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 (m PrettyPrintEnvDecl -> MaybeT m PrettyPrintEnvDecl)
-> m PrettyPrintEnvDecl -> MaybeT m PrettyPrintEnvDecl
forall a b. (a -> b) -> a -> b
$ Uri -> m PrettyPrintEnvDecl
forall (m :: * -> *). Lspish m => Uri -> m PrettyPrintEnvDecl
ppedForFile Uri
fileUri
    Name
name <- m (Maybe Name) -> MaybeT m Name
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe Name) -> MaybeT m Name)
-> (Maybe Name -> m (Maybe Name)) -> Maybe Name -> MaybeT m Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Name -> m (Maybe Name)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Name -> MaybeT m Name) -> Maybe Name -> MaybeT m 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 <- MaybeT m (NameSearch Transaction)
forall (m :: * -> *). Lspish m => m (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 m Env
forall r (m :: * -> *). MonadReader r m => m r
ask
    IO [Text] -> MaybeT m [Text]
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> MaybeT m [Text]) -> IO [Text] -> MaybeT m [Text]
forall a b. (a -> b) -> a -> b
$ do
      [Reference]
docRefs <- Codebase IO Symbol Ann -> Transaction [Reference] -> IO [Reference]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase (Transaction [Reference] -> IO [Reference])
-> Transaction [Reference] -> IO [Reference]
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann
-> NameSearch Transaction
-> SearchType
-> Name
-> Transaction [Reference]
Backend.docsForDefinitionName Codebase IO Symbol Ann
codebase NameSearch Transaction
nameSearch SearchType
ExactName Name
name
      [Reference] -> (Reference -> IO Text) -> IO [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Reference]
docRefs ((Reference -> IO Text) -> IO [Text])
-> (Reference -> IO Text) -> IO [Text]
forall a b. (a -> b) -> a -> b
$ \Reference
docRef -> do
        Identity (Text
_, Text
_, Doc
doc, [DecompError]
_evalErrs) <- PrettyPrintEnvDecl
-> Width
-> Codebase IO Symbol Ann
-> Runtime Symbol
-> Identity Reference
-> IO (Identity (Text, Text, Doc, [DecompError]))
forall (t :: * -> *).
Traversable t =>
PrettyPrintEnvDecl
-> Width
-> Codebase IO Symbol Ann
-> Runtime Symbol
-> t Reference
-> IO (t (Text, Text, Doc, [DecompError]))
Backend.renderDocRefs PrettyPrintEnvDecl
pped (Int -> Width
Pretty.Width Int
80) Codebase IO Symbol Ann
codebase Runtime Symbol
runtime (Reference -> Identity Reference
forall a. a -> Identity a
Identity Reference
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