-- | Facilities for answering queries about a program, such as "what
-- appears at this source location", or "where is this name bound".
-- The intent is that this is used as a building block for IDE-like
-- functionality.
module Language.Futhark.Query
  ( BoundTo (..),
    boundLoc,
    AtPos (..),
    atPos,
    Pos (..),
  )
where

import Control.Monad
import Control.Monad.State
import Data.List (find)
import Data.Map qualified as M
import Futhark.Util.Loc (Loc (..), Pos (..))
import Language.Futhark
import Language.Futhark.Semantic
import Language.Futhark.Traversals
import System.FilePath.Posix qualified as Posix

-- | What a name is bound to.
data BoundTo
  = BoundTerm StructType Loc
  | BoundModule Loc
  | BoundModuleType Loc
  | BoundType Loc
  deriving (BoundTo -> BoundTo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BoundTo -> BoundTo -> Bool
$c/= :: BoundTo -> BoundTo -> Bool
== :: BoundTo -> BoundTo -> Bool
$c== :: BoundTo -> BoundTo -> Bool
Eq, Int -> BoundTo -> ShowS
[BoundTo] -> ShowS
BoundTo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BoundTo] -> ShowS
$cshowList :: [BoundTo] -> ShowS
show :: BoundTo -> String
$cshow :: BoundTo -> String
showsPrec :: Int -> BoundTo -> ShowS
$cshowsPrec :: Int -> BoundTo -> ShowS
Show)

data Def = DefBound BoundTo | DefIndirect VName
  deriving (Def -> Def -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Def -> Def -> Bool
$c/= :: Def -> Def -> Bool
== :: Def -> Def -> Bool
$c== :: Def -> Def -> Bool
Eq, Int -> Def -> ShowS
[Def] -> ShowS
Def -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Def] -> ShowS
$cshowList :: [Def] -> ShowS
show :: Def -> String
$cshow :: Def -> String
showsPrec :: Int -> Def -> ShowS
$cshowsPrec :: Int -> Def -> ShowS
Show)

type Defs = M.Map VName Def

-- | Where was a bound variable actually bound?  That is, what is the
-- location of its definition?
boundLoc :: BoundTo -> Loc
boundLoc :: BoundTo -> Loc
boundLoc (BoundTerm StructType
_ Loc
loc) = Loc
loc
boundLoc (BoundModule Loc
loc) = Loc
loc
boundLoc (BoundModuleType Loc
loc) = Loc
loc
boundLoc (BoundType Loc
loc) = Loc
loc

sizeDefs :: SizeBinder VName -> Defs
sizeDefs :: SizeBinder VName -> Defs
sizeDefs (SizeBinder VName
v SrcLoc
loc) =
  forall k a. k -> a -> Map k a
M.singleton VName
v forall a b. (a -> b) -> a -> b
$ BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ StructType -> Loc -> BoundTo
BoundTerm (forall dim as. ScalarTypeBase dim as -> TypeBase dim as
Scalar (forall dim as. PrimType -> ScalarTypeBase dim as
Prim (IntType -> PrimType
Signed IntType
Int64))) (forall a. Located a => a -> Loc
locOf SrcLoc
loc)

patternDefs :: Pat -> Defs
patternDefs :: PatBase Info VName -> Defs
patternDefs (Id VName
vn (Info PatType
t) SrcLoc
loc) =
  forall k a. k -> a -> Map k a
M.singleton VName
vn forall a b. (a -> b) -> a -> b
$ BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ StructType -> Loc -> BoundTo
BoundTerm (forall dim as. TypeBase dim as -> TypeBase dim ()
toStruct PatType
t) (forall a. Located a => a -> Loc
locOf SrcLoc
loc)
patternDefs (TuplePat [PatBase Info VName]
pats SrcLoc
_) =
  forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map PatBase Info VName -> Defs
patternDefs [PatBase Info VName]
pats
patternDefs (RecordPat [(Name, PatBase Info VName)]
fields SrcLoc
_) =
  forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (PatBase Info VName -> Defs
patternDefs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Name, PatBase Info VName)]
fields
patternDefs (PatParens PatBase Info VName
pat SrcLoc
_) = PatBase Info VName -> Defs
patternDefs PatBase Info VName
pat
patternDefs (PatAttr AttrInfo VName
_ PatBase Info VName
pat SrcLoc
_) = PatBase Info VName -> Defs
patternDefs PatBase Info VName
pat
patternDefs Wildcard {} = forall a. Monoid a => a
mempty
patternDefs PatLit {} = forall a. Monoid a => a
mempty
patternDefs (PatAscription PatBase Info VName
pat TypeExp VName
_ SrcLoc
_) =
  PatBase Info VName -> Defs
patternDefs PatBase Info VName
pat
patternDefs (PatConstr Name
_ Info PatType
_ [PatBase Info VName]
pats SrcLoc
_) =
  forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map PatBase Info VName -> Defs
patternDefs [PatBase Info VName]
pats

typeParamDefs :: TypeParamBase VName -> Defs
typeParamDefs :: TypeParamBase VName -> Defs
typeParamDefs (TypeParamDim VName
vn SrcLoc
loc) =
  forall k a. k -> a -> Map k a
M.singleton VName
vn forall a b. (a -> b) -> a -> b
$ BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ StructType -> Loc -> BoundTo
BoundTerm (forall dim as. ScalarTypeBase dim as -> TypeBase dim as
Scalar forall a b. (a -> b) -> a -> b
$ forall dim as. PrimType -> ScalarTypeBase dim as
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64) (forall a. Located a => a -> Loc
locOf SrcLoc
loc)
typeParamDefs (TypeParamType Liftedness
_ VName
vn SrcLoc
loc) =
  forall k a. k -> a -> Map k a
M.singleton VName
vn forall a b. (a -> b) -> a -> b
$ BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ Loc -> BoundTo
BoundType forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf SrcLoc
loc

expDefs :: Exp -> Defs
expDefs :: Exp -> Defs
expDefs Exp
e =
  forall s a. State s a -> s -> s
execState (forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper (StateT Defs Identity)
mapper Exp
e) Defs
extra
  where
    mapper :: ASTMapper (StateT Defs Identity)
mapper =
      forall (m :: * -> *). Monad m => ASTMapper m
identityMapper {mapOnExp :: Exp -> StateT Defs Identity Exp
mapOnExp = forall {m :: * -> *}. MonadState Defs m => Exp -> m Exp
onExp}
    onExp :: Exp -> m Exp
onExp Exp
e' = do
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall a. Semigroup a => a -> a -> a
<> Exp -> Defs
expDefs Exp
e')
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
e'

    identDefs :: IdentBase Info k -> Map k Def
identDefs (Ident k
v (Info PatType
vt) SrcLoc
vloc) =
      forall k a. k -> a -> Map k a
M.singleton k
v forall a b. (a -> b) -> a -> b
$ BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ StructType -> Loc -> BoundTo
BoundTerm (forall dim as. TypeBase dim as -> TypeBase dim ()
toStruct PatType
vt) forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf SrcLoc
vloc

    extra :: Defs
extra =
      case Exp
e of
        AppExp (LetPat [SizeBinder VName]
sizes PatBase Info VName
pat Exp
_ Exp
_ SrcLoc
_) Info AppRes
_ ->
          forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap SizeBinder VName -> Defs
sizeDefs [SizeBinder VName]
sizes forall a. Semigroup a => a -> a -> a
<> PatBase Info VName -> Defs
patternDefs PatBase Info VName
pat
        Lambda [PatBase Info VName]
params Exp
_ Maybe (TypeExp VName)
_ Info (Aliasing, StructRetType)
_ SrcLoc
_ ->
          forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map PatBase Info VName -> Defs
patternDefs [PatBase Info VName]
params)
        AppExp (LetFun VName
name ([TypeParamBase VName]
tparams, [PatBase Info VName]
params, Maybe (TypeExp VName)
_, Info StructRetType
ret, Exp
_) Exp
_ SrcLoc
loc) Info AppRes
_ ->
          let name_t :: StructType
name_t = forall as dim pas.
Monoid as =>
[TypeBase dim pas] -> RetTypeBase dim as -> TypeBase dim as
foldFunType (forall a b. (a -> b) -> [a] -> [b]
map PatBase Info VName -> StructType
patternStructType [PatBase Info VName]
params) StructRetType
ret
           in forall k a. k -> a -> Map k a
M.singleton VName
name (BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ StructType -> Loc -> BoundTo
BoundTerm StructType
name_t (forall a. Located a => a -> Loc
locOf SrcLoc
loc))
                forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map TypeParamBase VName -> Defs
typeParamDefs [TypeParamBase VName]
tparams)
                forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map PatBase Info VName -> Defs
patternDefs [PatBase Info VName]
params)
        AppExp (LetWith IdentBase Info VName
v IdentBase Info VName
_ SliceBase Info VName
_ Exp
_ Exp
_ SrcLoc
_) Info AppRes
_ ->
          forall {k}. IdentBase Info k -> Map k Def
identDefs IdentBase Info VName
v
        AppExp (DoLoop [VName]
_ PatBase Info VName
merge Exp
_ LoopFormBase Info VName
form Exp
_ SrcLoc
_) Info AppRes
_ ->
          PatBase Info VName -> Defs
patternDefs PatBase Info VName
merge
            forall a. Semigroup a => a -> a -> a
<> case LoopFormBase Info VName
form of
              For IdentBase Info VName
i Exp
_ -> forall {k}. IdentBase Info k -> Map k Def
identDefs IdentBase Info VName
i
              ForIn PatBase Info VName
pat Exp
_ -> PatBase Info VName -> Defs
patternDefs PatBase Info VName
pat
              While {} -> forall a. Monoid a => a
mempty
        Exp
_ ->
          forall a. Monoid a => a
mempty

valBindDefs :: ValBind -> Defs
valBindDefs :: ValBind -> Defs
valBindDefs ValBind
vbind =
  forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (forall (f :: * -> *) vn. ValBindBase f vn -> vn
valBindName ValBind
vbind) (BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ StructType -> Loc -> BoundTo
BoundTerm StructType
vbind_t (forall a. Located a => a -> Loc
locOf ValBind
vbind)) forall a b. (a -> b) -> a -> b
$
    forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map TypeParamBase VName -> Defs
typeParamDefs (forall (f :: * -> *) vn. ValBindBase f vn -> [TypeParamBase vn]
valBindTypeParams ValBind
vbind))
      forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map PatBase Info VName -> Defs
patternDefs (forall (f :: * -> *) vn. ValBindBase f vn -> [PatBase f vn]
valBindParams ValBind
vbind))
      forall a. Semigroup a => a -> a -> a
<> Exp -> Defs
expDefs (forall (f :: * -> *) vn. ValBindBase f vn -> ExpBase f vn
valBindBody ValBind
vbind)
  where
    vbind_t :: StructType
vbind_t =
      forall as dim pas.
Monoid as =>
[TypeBase dim pas] -> RetTypeBase dim as -> TypeBase dim as
foldFunType (forall a b. (a -> b) -> [a] -> [b]
map PatBase Info VName -> StructType
patternStructType (forall (f :: * -> *) vn. ValBindBase f vn -> [PatBase f vn]
valBindParams ValBind
vbind)) forall a b. (a -> b) -> a -> b
$
        forall a. Info a -> a
unInfo forall a b. (a -> b) -> a -> b
$
          forall (f :: * -> *) vn. ValBindBase f vn -> f StructRetType
valBindRetType ValBind
vbind

typeBindDefs :: TypeBind -> Defs
typeBindDefs :: TypeBind -> Defs
typeBindDefs TypeBind
tbind =
  forall k a. k -> a -> Map k a
M.singleton (forall (f :: * -> *) vn. TypeBindBase f vn -> vn
typeAlias TypeBind
tbind) forall a b. (a -> b) -> a -> b
$ BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ Loc -> BoundTo
BoundType forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf TypeBind
tbind

modParamDefs :: ModParam -> Defs
modParamDefs :: ModParam -> Defs
modParamDefs (ModParam VName
p SigExpBase Info VName
se Info [VName]
_ SrcLoc
loc) =
  forall k a. k -> a -> Map k a
M.singleton VName
p (BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ Loc -> BoundTo
BoundModule forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf SrcLoc
loc)
    forall a. Semigroup a => a -> a -> a
<> SigExpBase Info VName -> Defs
sigExpDefs SigExpBase Info VName
se

modExpDefs :: ModExp -> Defs
modExpDefs :: ModExp -> Defs
modExpDefs ModVar {} =
  forall a. Monoid a => a
mempty
modExpDefs (ModParens ModExp
me SrcLoc
_) =
  ModExp -> Defs
modExpDefs ModExp
me
modExpDefs ModImport {} =
  forall a. Monoid a => a
mempty
modExpDefs (ModDecs [Dec]
decs SrcLoc
_) =
  forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Dec -> Defs
decDefs [Dec]
decs
modExpDefs (ModApply ModExp
e1 ModExp
e2 Info (Map VName VName)
_ (Info Map VName VName
substs) SrcLoc
_) =
  ModExp -> Defs
modExpDefs ModExp
e1 forall a. Semigroup a => a -> a -> a
<> ModExp -> Defs
modExpDefs ModExp
e2 forall a. Semigroup a => a -> a -> a
<> forall a b k. (a -> b) -> Map k a -> Map k b
M.map VName -> Def
DefIndirect Map VName VName
substs
modExpDefs (ModAscript ModExp
e SigExpBase Info VName
_ (Info Map VName VName
substs) SrcLoc
_) =
  ModExp -> Defs
modExpDefs ModExp
e forall a. Semigroup a => a -> a -> a
<> forall a b k. (a -> b) -> Map k a -> Map k b
M.map VName -> Def
DefIndirect Map VName VName
substs
modExpDefs (ModLambda ModParam
p Maybe (SigExpBase Info VName, Info (Map VName VName))
_ ModExp
e SrcLoc
_) =
  ModParam -> Defs
modParamDefs ModParam
p forall a. Semigroup a => a -> a -> a
<> ModExp -> Defs
modExpDefs ModExp
e

modBindDefs :: ModBind -> Defs
modBindDefs :: ModBind -> Defs
modBindDefs ModBind
mbind =
  forall k a. k -> a -> Map k a
M.singleton (forall (f :: * -> *) vn. ModBindBase f vn -> vn
modName ModBind
mbind) (BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ Loc -> BoundTo
BoundModule forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf ModBind
mbind)
    forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map ModParam -> Defs
modParamDefs (forall (f :: * -> *) vn. ModBindBase f vn -> [ModParamBase f vn]
modParams ModBind
mbind))
    forall a. Semigroup a => a -> a -> a
<> ModExp -> Defs
modExpDefs (forall (f :: * -> *) vn. ModBindBase f vn -> ModExpBase f vn
modExp ModBind
mbind)
    forall a. Semigroup a => a -> a -> a
<> case forall (f :: * -> *) vn.
ModBindBase f vn -> Maybe (SigExpBase f vn, f (Map VName VName))
modSignature ModBind
mbind of
      Maybe (SigExpBase Info VName, Info (Map VName VName))
Nothing -> forall a. Monoid a => a
mempty
      Just (SigExpBase Info VName
_, Info Map VName VName
substs) ->
        forall a b k. (a -> b) -> Map k a -> Map k b
M.map VName -> Def
DefIndirect Map VName VName
substs

specDefs :: Spec -> Defs
specDefs :: Spec -> Defs
specDefs Spec
spec =
  case Spec
spec of
    ValSpec VName
v [TypeParamBase VName]
tparams TypeExp VName
_ (Info StructType
t) Maybe DocComment
_ SrcLoc
loc ->
      let vdef :: Def
vdef = BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ StructType -> Loc -> BoundTo
BoundTerm StructType
t (forall a. Located a => a -> Loc
locOf SrcLoc
loc)
       in forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert VName
v Def
vdef forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map TypeParamBase VName -> Defs
typeParamDefs [TypeParamBase VName]
tparams)
    TypeAbbrSpec TypeBind
tbind -> TypeBind -> Defs
typeBindDefs TypeBind
tbind
    TypeSpec Liftedness
_ VName
v [TypeParamBase VName]
_ Maybe DocComment
_ SrcLoc
loc ->
      forall k a. k -> a -> Map k a
M.singleton VName
v forall a b. (a -> b) -> a -> b
$ BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ Loc -> BoundTo
BoundType forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf SrcLoc
loc
    ModSpec VName
v SigExpBase Info VName
se Maybe DocComment
_ SrcLoc
loc ->
      forall k a. k -> a -> Map k a
M.singleton VName
v (BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ Loc -> BoundTo
BoundModuleType forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf SrcLoc
loc)
        forall a. Semigroup a => a -> a -> a
<> SigExpBase Info VName -> Defs
sigExpDefs SigExpBase Info VName
se
    IncludeSpec SigExpBase Info VName
se SrcLoc
_ -> SigExpBase Info VName -> Defs
sigExpDefs SigExpBase Info VName
se

sigExpDefs :: SigExp -> Defs
sigExpDefs :: SigExpBase Info VName -> Defs
sigExpDefs SigExpBase Info VName
se =
  case SigExpBase Info VName
se of
    SigVar QualName VName
_ (Info Map VName VName
substs) SrcLoc
_ -> forall a b k. (a -> b) -> Map k a -> Map k b
M.map VName -> Def
DefIndirect Map VName VName
substs
    SigParens SigExpBase Info VName
e SrcLoc
_ -> SigExpBase Info VName -> Defs
sigExpDefs SigExpBase Info VName
e
    SigSpecs [Spec]
specs SrcLoc
_ -> forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Spec -> Defs
specDefs [Spec]
specs
    SigWith SigExpBase Info VName
e TypeRefBase VName
_ SrcLoc
_ -> SigExpBase Info VName -> Defs
sigExpDefs SigExpBase Info VName
e
    SigArrow Maybe VName
_ SigExpBase Info VName
e1 SigExpBase Info VName
e2 SrcLoc
_ -> SigExpBase Info VName -> Defs
sigExpDefs SigExpBase Info VName
e1 forall a. Semigroup a => a -> a -> a
<> SigExpBase Info VName -> Defs
sigExpDefs SigExpBase Info VName
e2

sigBindDefs :: SigBind -> Defs
sigBindDefs :: SigBind -> Defs
sigBindDefs SigBind
sbind =
  forall k a. k -> a -> Map k a
M.singleton (forall (f :: * -> *) vn. SigBindBase f vn -> vn
sigName SigBind
sbind) (BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ Loc -> BoundTo
BoundModuleType forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf SigBind
sbind)
    forall a. Semigroup a => a -> a -> a
<> SigExpBase Info VName -> Defs
sigExpDefs (forall (f :: * -> *) vn. SigBindBase f vn -> SigExpBase f vn
sigExp SigBind
sbind)

decDefs :: Dec -> Defs
decDefs :: Dec -> Defs
decDefs (ValDec ValBind
vbind) = ValBind -> Defs
valBindDefs ValBind
vbind
decDefs (TypeDec TypeBind
vbind) = TypeBind -> Defs
typeBindDefs TypeBind
vbind
decDefs (ModDec ModBind
mbind) = ModBind -> Defs
modBindDefs ModBind
mbind
decDefs (SigDec SigBind
mbind) = SigBind -> Defs
sigBindDefs SigBind
mbind
decDefs (OpenDec ModExp
me SrcLoc
_) = ModExp -> Defs
modExpDefs ModExp
me
decDefs (LocalDec Dec
dec SrcLoc
_) = Dec -> Defs
decDefs Dec
dec
decDefs ImportDec {} = forall a. Monoid a => a
mempty

-- | All bindings of everything in the program.
progDefs :: Prog -> Defs
progDefs :: Prog -> Defs
progDefs = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Dec -> Defs
decDefs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) vn. ProgBase f vn -> [DecBase f vn]
progDecs

allBindings :: Imports -> M.Map VName BoundTo
allBindings :: Imports -> Map VName BoundTo
allBindings Imports
imports = forall a b k. (a -> Maybe b) -> Map k a -> Map k b
M.mapMaybe Def -> Maybe BoundTo
forward Defs
defs
  where
    defs :: Defs
defs = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Prog -> Defs
progDefs forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileModule -> Prog
fileProg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) Imports
imports
    forward :: Def -> Maybe BoundTo
forward (DefBound BoundTo
x) = forall a. a -> Maybe a
Just BoundTo
x
    forward (DefIndirect VName
v) = Def -> Maybe BoundTo
forward forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VName
v Defs
defs

data RawAtPos = RawAtName (QualName VName) Loc

contains :: Located a => a -> Pos -> Bool
contains :: forall a. Located a => a -> Pos -> Bool
contains a
a Pos
pos =
  case forall a. Located a => a -> Loc
locOf a
a of
    Loc Pos
start Pos
end -> Pos
pos forall a. Ord a => a -> a -> Bool
>= Pos
start Bool -> Bool -> Bool
&& Pos
pos forall a. Ord a => a -> a -> Bool
<= Pos
end
    Loc
NoLoc -> Bool
False

atPosInTypeExp :: TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp :: TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp VName
te Pos
pos =
  case TypeExp VName
te of
    TEVar QualName VName
qn SrcLoc
loc -> do
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ SrcLoc
loc forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos
      forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ QualName VName -> Loc -> RawAtPos
RawAtName QualName VName
qn forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf SrcLoc
loc
    TETuple [TypeExp VName]
es SrcLoc
_ ->
      forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (TypeExp VName -> Pos -> Maybe RawAtPos
`atPosInTypeExp` Pos
pos) [TypeExp VName]
es
    TERecord [(Name, TypeExp VName)]
fields SrcLoc
_ ->
      forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((TypeExp VName -> Pos -> Maybe RawAtPos
`atPosInTypeExp` Pos
pos) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Name, TypeExp VName)]
fields
    TEArray SizeExp VName
dim TypeExp VName
te' SrcLoc
_ ->
      TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp VName
te' Pos
pos forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` SizeExp VName -> Maybe RawAtPos
inDim SizeExp VName
dim
    TEUnique TypeExp VName
te' SrcLoc
_ ->
      TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp VName
te' Pos
pos
    TEApply TypeExp VName
e1 TypeArgExp VName
arg SrcLoc
_ ->
      TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp VName
e1 Pos
pos forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` TypeArgExp VName -> Maybe RawAtPos
inArg TypeArgExp VName
arg
    TEArrow Maybe VName
_ TypeExp VName
e1 TypeExp VName
e2 SrcLoc
_ ->
      TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp VName
e1 Pos
pos forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp VName
e2 Pos
pos
    TESum [(Name, [TypeExp VName])]
cs SrcLoc
_ ->
      forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (TypeExp VName -> Pos -> Maybe RawAtPos
`atPosInTypeExp` Pos
pos) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [(Name, [TypeExp VName])]
cs
    TEDim [VName]
_ TypeExp VName
t SrcLoc
_ ->
      TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp VName
t Pos
pos
  where
    inArg :: TypeArgExp VName -> Maybe RawAtPos
inArg (TypeArgExpDim SizeExp VName
dim SrcLoc
_) = SizeExp VName -> Maybe RawAtPos
inDim SizeExp VName
dim
    inArg (TypeArgExpType TypeExp VName
e2) = TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp VName
e2 Pos
pos
    inDim :: SizeExp VName -> Maybe RawAtPos
inDim (SizeExpNamed QualName VName
qn SrcLoc
loc) = do
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ SrcLoc
loc forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos
      forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ QualName VName -> Loc -> RawAtPos
RawAtName QualName VName
qn forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf SrcLoc
loc
    inDim SizeExp VName
_ = forall a. Maybe a
Nothing

atPosInPat :: Pat -> Pos -> Maybe RawAtPos
atPosInPat :: PatBase Info VName -> Pos -> Maybe RawAtPos
atPosInPat (Id VName
vn Info PatType
_ SrcLoc
loc) Pos
pos = do
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ SrcLoc
loc forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos
  forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ QualName VName -> Loc -> RawAtPos
RawAtName (forall v. v -> QualName v
qualName VName
vn) forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf SrcLoc
loc
atPosInPat (TuplePat [PatBase Info VName]
pats SrcLoc
_) Pos
pos =
  forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (PatBase Info VName -> Pos -> Maybe RawAtPos
`atPosInPat` Pos
pos) [PatBase Info VName]
pats
atPosInPat (RecordPat [(Name, PatBase Info VName)]
fields SrcLoc
_) Pos
pos =
  forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((PatBase Info VName -> Pos -> Maybe RawAtPos
`atPosInPat` Pos
pos) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Name, PatBase Info VName)]
fields
atPosInPat (PatParens PatBase Info VName
pat SrcLoc
_) Pos
pos =
  PatBase Info VName -> Pos -> Maybe RawAtPos
atPosInPat PatBase Info VName
pat Pos
pos
atPosInPat (PatAttr AttrInfo VName
_ PatBase Info VName
pat SrcLoc
_) Pos
pos =
  PatBase Info VName -> Pos -> Maybe RawAtPos
atPosInPat PatBase Info VName
pat Pos
pos
atPosInPat (PatAscription PatBase Info VName
pat TypeExp VName
te SrcLoc
_) Pos
pos =
  PatBase Info VName -> Pos -> Maybe RawAtPos
atPosInPat PatBase Info VName
pat Pos
pos forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp VName
te Pos
pos
atPosInPat (PatConstr Name
_ Info PatType
_ [PatBase Info VName]
pats SrcLoc
_) Pos
pos =
  forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (PatBase Info VName -> Pos -> Maybe RawAtPos
`atPosInPat` Pos
pos) [PatBase Info VName]
pats
atPosInPat PatLit {} Pos
_ = forall a. Maybe a
Nothing
atPosInPat Wildcard {} Pos
_ = forall a. Maybe a
Nothing

atPosInExp :: Exp -> Pos -> Maybe RawAtPos
atPosInExp :: Exp -> Pos -> Maybe RawAtPos
atPosInExp (Var QualName VName
qn Info PatType
_ SrcLoc
loc) Pos
pos = do
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ SrcLoc
loc forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos
  forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ QualName VName -> Loc -> RawAtPos
RawAtName QualName VName
qn forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf SrcLoc
loc
atPosInExp (QualParens (QualName VName
qn, SrcLoc
loc) Exp
_ SrcLoc
_) Pos
pos
  | SrcLoc
loc forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ QualName VName -> Loc -> RawAtPos
RawAtName QualName VName
qn forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf SrcLoc
loc
-- All the value cases are TODO - we need another RawAtPos constructor.
atPosInExp Literal {} Pos
_ = forall a. Maybe a
Nothing
atPosInExp IntLit {} Pos
_ = forall a. Maybe a
Nothing
atPosInExp FloatLit {} Pos
_ = forall a. Maybe a
Nothing
atPosInExp (AppExp (LetPat [SizeBinder VName]
_ PatBase Info VName
pat Exp
_ Exp
_ SrcLoc
_) Info AppRes
_) Pos
pos
  | PatBase Info VName
pat forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos = PatBase Info VName -> Pos -> Maybe RawAtPos
atPosInPat PatBase Info VName
pat Pos
pos
atPosInExp (AppExp (LetWith IdentBase Info VName
a IdentBase Info VName
b SliceBase Info VName
_ Exp
_ Exp
_ SrcLoc
_) Info AppRes
_) Pos
pos
  | IdentBase Info VName
a forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ QualName VName -> Loc -> RawAtPos
RawAtName (forall v. v -> QualName v
qualName forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) vn. IdentBase f vn -> vn
identName IdentBase Info VName
a) (forall a. Located a => a -> Loc
locOf IdentBase Info VName
a)
  | IdentBase Info VName
b forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ QualName VName -> Loc -> RawAtPos
RawAtName (forall v. v -> QualName v
qualName forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) vn. IdentBase f vn -> vn
identName IdentBase Info VName
b) (forall a. Located a => a -> Loc
locOf IdentBase Info VName
b)
atPosInExp (AppExp (DoLoop [VName]
_ PatBase Info VName
merge Exp
_ LoopFormBase Info VName
_ Exp
_ SrcLoc
_) Info AppRes
_) Pos
pos
  | PatBase Info VName
merge forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos = PatBase Info VName -> Pos -> Maybe RawAtPos
atPosInPat PatBase Info VName
merge Pos
pos
atPosInExp (Ascript Exp
_ TypeExp VName
te SrcLoc
_) Pos
pos
  | TypeExp VName
te forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos = TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp VName
te Pos
pos
atPosInExp (AppExp (Coerce Exp
_ TypeExp VName
te SrcLoc
_) Info AppRes
_) Pos
pos
  | TypeExp VName
te forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos = TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp VName
te Pos
pos
atPosInExp Exp
e Pos
pos = do
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Exp
e forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos
  -- Use the Either monad for short-circuiting for efficiency reasons.
  -- The first hit is going to be the only one.
  case forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper (Either RawAtPos)
mapper Exp
e of
    Left RawAtPos
atpos -> forall a. a -> Maybe a
Just RawAtPos
atpos
    Right Exp
_ -> forall a. Maybe a
Nothing
  where
    mapper :: ASTMapper (Either RawAtPos)
mapper =
      forall (m :: * -> *). Monad m => ASTMapper m
identityMapper {mapOnExp :: Exp -> Either RawAtPos Exp
mapOnExp = Exp -> Either RawAtPos Exp
onExp}
    onExp :: Exp -> Either RawAtPos Exp
onExp Exp
e' =
      case Exp -> Pos -> Maybe RawAtPos
atPosInExp Exp
e' Pos
pos of
        Just RawAtPos
atpos -> forall a b. a -> Either a b
Left RawAtPos
atpos
        Maybe RawAtPos
Nothing -> forall a b. b -> Either a b
Right Exp
e'

atPosInModExp :: ModExp -> Pos -> Maybe RawAtPos
atPosInModExp :: ModExp -> Pos -> Maybe RawAtPos
atPosInModExp (ModVar QualName VName
qn SrcLoc
loc) Pos
pos = do
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ SrcLoc
loc forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos
  forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ QualName VName -> Loc -> RawAtPos
RawAtName QualName VName
qn forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf SrcLoc
loc
atPosInModExp (ModParens ModExp
me SrcLoc
_) Pos
pos =
  ModExp -> Pos -> Maybe RawAtPos
atPosInModExp ModExp
me Pos
pos
atPosInModExp ModImport {} Pos
_ =
  forall a. Maybe a
Nothing
atPosInModExp (ModDecs [Dec]
decs SrcLoc
_) Pos
pos =
  forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Dec -> Pos -> Maybe RawAtPos
`atPosInDec` Pos
pos) [Dec]
decs
atPosInModExp (ModApply ModExp
e1 ModExp
e2 Info (Map VName VName)
_ Info (Map VName VName)
_ SrcLoc
_) Pos
pos =
  ModExp -> Pos -> Maybe RawAtPos
atPosInModExp ModExp
e1 Pos
pos forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` ModExp -> Pos -> Maybe RawAtPos
atPosInModExp ModExp
e2 Pos
pos
atPosInModExp (ModAscript ModExp
e SigExpBase Info VName
_ Info (Map VName VName)
_ SrcLoc
_) Pos
pos =
  ModExp -> Pos -> Maybe RawAtPos
atPosInModExp ModExp
e Pos
pos
atPosInModExp (ModLambda ModParam
_ Maybe (SigExpBase Info VName, Info (Map VName VName))
_ ModExp
e SrcLoc
_) Pos
pos =
  ModExp -> Pos -> Maybe RawAtPos
atPosInModExp ModExp
e Pos
pos

atPosInSpec :: Spec -> Pos -> Maybe RawAtPos
atPosInSpec :: Spec -> Pos -> Maybe RawAtPos
atPosInSpec Spec
spec Pos
pos =
  case Spec
spec of
    ValSpec VName
_ [TypeParamBase VName]
_ TypeExp VName
te Info StructType
_ Maybe DocComment
_ SrcLoc
_ -> TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp VName
te Pos
pos
    TypeAbbrSpec TypeBind
tbind -> TypeBind -> Pos -> Maybe RawAtPos
atPosInTypeBind TypeBind
tbind Pos
pos
    TypeSpec {} -> forall a. Maybe a
Nothing
    ModSpec VName
_ SigExpBase Info VName
se Maybe DocComment
_ SrcLoc
_ -> SigExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInSigExp SigExpBase Info VName
se Pos
pos
    IncludeSpec SigExpBase Info VName
se SrcLoc
_ -> SigExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInSigExp SigExpBase Info VName
se Pos
pos

atPosInSigExp :: SigExp -> Pos -> Maybe RawAtPos
atPosInSigExp :: SigExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInSigExp SigExpBase Info VName
se Pos
pos =
  case SigExpBase Info VName
se of
    SigVar QualName VName
qn Info (Map VName VName)
_ SrcLoc
loc -> do
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ SrcLoc
loc forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos
      forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ QualName VName -> Loc -> RawAtPos
RawAtName QualName VName
qn forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf SrcLoc
loc
    SigParens SigExpBase Info VName
e SrcLoc
_ -> SigExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInSigExp SigExpBase Info VName
e Pos
pos
    SigSpecs [Spec]
specs SrcLoc
_ -> forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Spec -> Pos -> Maybe RawAtPos
`atPosInSpec` Pos
pos) [Spec]
specs
    SigWith SigExpBase Info VName
e TypeRefBase VName
_ SrcLoc
_ -> SigExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInSigExp SigExpBase Info VName
e Pos
pos
    SigArrow Maybe VName
_ SigExpBase Info VName
e1 SigExpBase Info VName
e2 SrcLoc
_ -> SigExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInSigExp SigExpBase Info VName
e1 Pos
pos forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` SigExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInSigExp SigExpBase Info VName
e2 Pos
pos

atPosInValBind :: ValBind -> Pos -> Maybe RawAtPos
atPosInValBind :: ValBind -> Pos -> Maybe RawAtPos
atPosInValBind ValBind
vbind Pos
pos =
  forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum (forall a b. (a -> b) -> [a] -> [b]
map (PatBase Info VName -> Pos -> Maybe RawAtPos
`atPosInPat` Pos
pos) (forall (f :: * -> *) vn. ValBindBase f vn -> [PatBase f vn]
valBindParams ValBind
vbind))
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Exp -> Pos -> Maybe RawAtPos
atPosInExp (forall (f :: * -> *) vn. ValBindBase f vn -> ExpBase f vn
valBindBody ValBind
vbind) Pos
pos
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) vn. ValBindBase f vn -> Maybe (TypeExp vn)
valBindRetDecl ValBind
vbind forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Pos
pos)

atPosInTypeBind :: TypeBind -> Pos -> Maybe RawAtPos
atPosInTypeBind :: TypeBind -> Pos -> Maybe RawAtPos
atPosInTypeBind = TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) vn. TypeBindBase f vn -> TypeExp vn
typeExp

atPosInModBind :: ModBind -> Pos -> Maybe RawAtPos
atPosInModBind :: ModBind -> Pos -> Maybe RawAtPos
atPosInModBind (ModBind VName
_ [ModParam]
params Maybe (SigExpBase Info VName, Info (Map VName VName))
sig ModExp
e Maybe DocComment
_ SrcLoc
_) Pos
pos =
  forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum (forall a b. (a -> b) -> [a] -> [b]
map ModParam -> Maybe RawAtPos
inParam [ModParam]
params)
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` ModExp -> Pos -> Maybe RawAtPos
atPosInModExp ModExp
e Pos
pos
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` case Maybe (SigExpBase Info VName, Info (Map VName VName))
sig of
      Maybe (SigExpBase Info VName, Info (Map VName VName))
Nothing -> forall a. Maybe a
Nothing
      Just (SigExpBase Info VName
se, Info (Map VName VName)
_) -> SigExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInSigExp SigExpBase Info VName
se Pos
pos
  where
    inParam :: ModParam -> Maybe RawAtPos
inParam (ModParam VName
_ SigExpBase Info VName
se Info [VName]
_ SrcLoc
_) = SigExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInSigExp SigExpBase Info VName
se Pos
pos

atPosInSigBind :: SigBind -> Pos -> Maybe RawAtPos
atPosInSigBind :: SigBind -> Pos -> Maybe RawAtPos
atPosInSigBind = SigExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInSigExp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) vn. SigBindBase f vn -> SigExpBase f vn
sigExp

atPosInDec :: Dec -> Pos -> Maybe RawAtPos
atPosInDec :: Dec -> Pos -> Maybe RawAtPos
atPosInDec Dec
dec Pos
pos = do
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Dec
dec forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos
  case Dec
dec of
    ValDec ValBind
vbind -> ValBind -> Pos -> Maybe RawAtPos
atPosInValBind ValBind
vbind Pos
pos
    TypeDec TypeBind
tbind -> TypeBind -> Pos -> Maybe RawAtPos
atPosInTypeBind TypeBind
tbind Pos
pos
    ModDec ModBind
mbind -> ModBind -> Pos -> Maybe RawAtPos
atPosInModBind ModBind
mbind Pos
pos
    SigDec SigBind
sbind -> SigBind -> Pos -> Maybe RawAtPos
atPosInSigBind SigBind
sbind Pos
pos
    OpenDec ModExp
e SrcLoc
_ -> ModExp -> Pos -> Maybe RawAtPos
atPosInModExp ModExp
e Pos
pos
    LocalDec Dec
dec' SrcLoc
_ -> Dec -> Pos -> Maybe RawAtPos
atPosInDec Dec
dec' Pos
pos
    ImportDec {} -> forall a. Maybe a
Nothing

atPosInProg :: Prog -> Pos -> Maybe RawAtPos
atPosInProg :: Prog -> Pos -> Maybe RawAtPos
atPosInProg Prog
prog Pos
pos =
  forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Dec -> Pos -> Maybe RawAtPos
`atPosInDec` Pos
pos) (forall (f :: * -> *) vn. ProgBase f vn -> [DecBase f vn]
progDecs Prog
prog)

containingModule :: Imports -> Pos -> Maybe FileModule
containingModule :: Imports -> Pos -> Maybe FileModule
containingModule Imports
imports (Pos String
file Int
_ Int
_ Int
_) =
  forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== String
file') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) Imports
imports
  where
    file' :: String
file' = ImportName -> String
includeToString forall a b. (a -> b) -> a -> b
$ String -> ImportName
mkInitialImport forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ String -> (String, String)
Posix.splitExtension String
file

-- | Information about what is at the given source location.
data AtPos = AtName (QualName VName) (Maybe BoundTo) Loc
  deriving (AtPos -> AtPos -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AtPos -> AtPos -> Bool
$c/= :: AtPos -> AtPos -> Bool
== :: AtPos -> AtPos -> Bool
$c== :: AtPos -> AtPos -> Bool
Eq, Int -> AtPos -> ShowS
[AtPos] -> ShowS
AtPos -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AtPos] -> ShowS
$cshowList :: [AtPos] -> ShowS
show :: AtPos -> String
$cshow :: AtPos -> String
showsPrec :: Int -> AtPos -> ShowS
$cshowsPrec :: Int -> AtPos -> ShowS
Show)

-- | Information about what's at the given source position.  Returns
-- 'Nothing' if there is nothing there, including if the source
-- position is invalid.
atPos :: Imports -> Pos -> Maybe AtPos
atPos :: Imports -> Pos -> Maybe AtPos
atPos Imports
imports Pos
pos = do
  Prog
prog <- FileModule -> Prog
fileProg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Imports -> Pos -> Maybe FileModule
containingModule Imports
imports Pos
pos
  RawAtName QualName VName
qn Loc
loc <- Prog -> Pos -> Maybe RawAtPos
atPosInProg Prog
prog Pos
pos
  forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ QualName VName -> Maybe BoundTo -> Loc -> AtPos
AtName QualName VName
qn (forall vn. QualName vn -> vn
qualLeaf QualName VName
qn forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Imports -> Map VName BoundTo
allBindings Imports
imports) Loc
loc