-- | 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
(BoundTo -> BoundTo -> Bool)
-> (BoundTo -> BoundTo -> Bool) -> Eq BoundTo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BoundTo -> BoundTo -> Bool
== :: BoundTo -> BoundTo -> Bool
$c/= :: BoundTo -> BoundTo -> Bool
/= :: BoundTo -> BoundTo -> Bool
Eq, Int -> BoundTo -> ShowS
[BoundTo] -> ShowS
BoundTo -> String
(Int -> BoundTo -> ShowS)
-> (BoundTo -> String) -> ([BoundTo] -> ShowS) -> Show BoundTo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BoundTo -> ShowS
showsPrec :: Int -> BoundTo -> ShowS
$cshow :: BoundTo -> String
show :: BoundTo -> String
$cshowList :: [BoundTo] -> ShowS
showList :: [BoundTo] -> ShowS
Show)

data Def = DefBound BoundTo | DefIndirect VName
  deriving (Def -> Def -> Bool
(Def -> Def -> Bool) -> (Def -> Def -> Bool) -> Eq Def
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Def -> Def -> Bool
== :: Def -> Def -> Bool
$c/= :: Def -> Def -> Bool
/= :: Def -> Def -> Bool
Eq, Int -> Def -> ShowS
[Def] -> ShowS
Def -> String
(Int -> Def -> ShowS)
-> (Def -> String) -> ([Def] -> ShowS) -> Show Def
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Def -> ShowS
showsPrec :: Int -> Def -> ShowS
$cshow :: Def -> String
show :: Def -> String
$cshowList :: [Def] -> ShowS
showList :: [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) =
  VName -> Def -> Defs
forall k a. k -> a -> Map k a
M.singleton VName
v (Def -> Defs) -> Def -> Defs
forall a b. (a -> b) -> a -> b
$ BoundTo -> Def
DefBound (BoundTo -> Def) -> BoundTo -> Def
forall a b. (a -> b) -> a -> b
$ StructType -> Loc -> BoundTo
BoundTerm (ScalarTypeBase (ExpBase Info VName) NoUniqueness -> StructType
forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (PrimType -> ScalarTypeBase (ExpBase Info VName) NoUniqueness
forall dim u. PrimType -> ScalarTypeBase dim u
Prim (IntType -> PrimType
Signed IntType
Int64))) (SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc)

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

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

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

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

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

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

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

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

modExpDefs :: ModExp -> Defs
modExpDefs :: ModExp -> Defs
modExpDefs ModVar {} =
  Defs
forall a. Monoid a => a
mempty
modExpDefs (ModParens ModExp
me SrcLoc
_) =
  ModExp -> Defs
modExpDefs ModExp
me
modExpDefs ModImport {} =
  Defs
forall a. Monoid a => a
mempty
modExpDefs (ModDecs [Dec]
decs SrcLoc
_) =
  [Defs] -> Defs
forall a. Monoid a => [a] -> a
mconcat ([Defs] -> Defs) -> [Defs] -> Defs
forall a b. (a -> b) -> a -> b
$ (Dec -> Defs) -> [Dec] -> [Defs]
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 Defs -> Defs -> Defs
forall a. Semigroup a => a -> a -> a
<> ModExp -> Defs
modExpDefs ModExp
e2 Defs -> Defs -> Defs
forall a. Semigroup a => a -> a -> a
<> (VName -> Def) -> Map VName VName -> Defs
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 ModTypeExpBase Info VName
_ (Info Map VName VName
substs) SrcLoc
_) =
  ModExp -> Defs
modExpDefs ModExp
e Defs -> Defs -> Defs
forall a. Semigroup a => a -> a -> a
<> (VName -> Def) -> Map VName VName -> Defs
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 (ModTypeExpBase Info VName, Info (Map VName VName))
_ ModExp
e SrcLoc
_) =
  ModParam -> Defs
modParamDefs ModParam
p Defs -> Defs -> Defs
forall a. Semigroup a => a -> a -> a
<> ModExp -> Defs
modExpDefs ModExp
e

modBindDefs :: ModBind -> Defs
modBindDefs :: ModBind -> Defs
modBindDefs ModBind
mbind =
  VName -> Def -> Defs
forall k a. k -> a -> Map k a
M.singleton (ModBind -> VName
forall (f :: * -> *) vn. ModBindBase f vn -> vn
modName ModBind
mbind) (BoundTo -> Def
DefBound (BoundTo -> Def) -> BoundTo -> Def
forall a b. (a -> b) -> a -> b
$ Loc -> BoundTo
BoundModule (Loc -> BoundTo) -> Loc -> BoundTo
forall a b. (a -> b) -> a -> b
$ ModBind -> Loc
forall a. Located a => a -> Loc
locOf ModBind
mbind)
    Defs -> Defs -> Defs
forall a. Semigroup a => a -> a -> a
<> [Defs] -> Defs
forall a. Monoid a => [a] -> a
mconcat ((ModParam -> Defs) -> [ModParam] -> [Defs]
forall a b. (a -> b) -> [a] -> [b]
map ModParam -> Defs
modParamDefs (ModBind -> [ModParam]
forall (f :: * -> *) vn. ModBindBase f vn -> [ModParamBase f vn]
modParams ModBind
mbind))
    Defs -> Defs -> Defs
forall a. Semigroup a => a -> a -> a
<> ModExp -> Defs
modExpDefs (ModBind -> ModExp
forall (f :: * -> *) vn. ModBindBase f vn -> ModExpBase f vn
modExp ModBind
mbind)
    Defs -> Defs -> Defs
forall a. Semigroup a => a -> a -> a
<> case ModBind
-> Maybe (ModTypeExpBase Info VName, Info (Map VName VName))
forall (f :: * -> *) vn.
ModBindBase f vn
-> Maybe (ModTypeExpBase f vn, f (Map VName VName))
modType ModBind
mbind of
      Maybe (ModTypeExpBase Info VName, Info (Map VName VName))
Nothing -> Defs
forall a. Monoid a => a
mempty
      Just (ModTypeExpBase Info VName
_, Info Map VName VName
substs) ->
        (VName -> Def) -> Map VName VName -> Defs
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 (ExpBase Info VName) VName
_ (Info StructType
t) Maybe DocComment
_ SrcLoc
loc ->
      let vdef :: Def
vdef = BoundTo -> Def
DefBound (BoundTo -> Def) -> BoundTo -> Def
forall a b. (a -> b) -> a -> b
$ StructType -> Loc -> BoundTo
BoundTerm StructType
t (SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc)
       in VName -> Def -> Defs -> Defs
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert VName
v Def
vdef (Defs -> Defs) -> Defs -> Defs
forall a b. (a -> b) -> a -> b
$ [Defs] -> Defs
forall a. Monoid a => [a] -> a
mconcat ((TypeParamBase VName -> Defs) -> [TypeParamBase VName] -> [Defs]
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 ->
      VName -> Def -> Defs
forall k a. k -> a -> Map k a
M.singleton VName
v (Def -> Defs) -> Def -> Defs
forall a b. (a -> b) -> a -> b
$ BoundTo -> Def
DefBound (BoundTo -> Def) -> BoundTo -> Def
forall a b. (a -> b) -> a -> b
$ Loc -> BoundTo
BoundType (Loc -> BoundTo) -> Loc -> BoundTo
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
    ModSpec VName
v ModTypeExpBase Info VName
se Maybe DocComment
_ SrcLoc
loc ->
      VName -> Def -> Defs
forall k a. k -> a -> Map k a
M.singleton VName
v (BoundTo -> Def
DefBound (BoundTo -> Def) -> BoundTo -> Def
forall a b. (a -> b) -> a -> b
$ Loc -> BoundTo
BoundModuleType (Loc -> BoundTo) -> Loc -> BoundTo
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc)
        Defs -> Defs -> Defs
forall a. Semigroup a => a -> a -> a
<> ModTypeExpBase Info VName -> Defs
modTypeExpDefs ModTypeExpBase Info VName
se
    IncludeSpec ModTypeExpBase Info VName
se SrcLoc
_ -> ModTypeExpBase Info VName -> Defs
modTypeExpDefs ModTypeExpBase Info VName
se

modTypeExpDefs :: ModTypeExp -> Defs
modTypeExpDefs :: ModTypeExpBase Info VName -> Defs
modTypeExpDefs ModTypeExpBase Info VName
se =
  case ModTypeExpBase Info VName
se of
    ModTypeVar QualName VName
_ (Info Map VName VName
substs) SrcLoc
_ -> (VName -> Def) -> Map VName VName -> Defs
forall a b k. (a -> b) -> Map k a -> Map k b
M.map VName -> Def
DefIndirect Map VName VName
substs
    ModTypeParens ModTypeExpBase Info VName
e SrcLoc
_ -> ModTypeExpBase Info VName -> Defs
modTypeExpDefs ModTypeExpBase Info VName
e
    ModTypeSpecs [Spec]
specs SrcLoc
_ -> [Defs] -> Defs
forall a. Monoid a => [a] -> a
mconcat ([Defs] -> Defs) -> [Defs] -> Defs
forall a b. (a -> b) -> a -> b
$ (Spec -> Defs) -> [Spec] -> [Defs]
forall a b. (a -> b) -> [a] -> [b]
map Spec -> Defs
specDefs [Spec]
specs
    ModTypeWith ModTypeExpBase Info VName
e TypeRefBase Info VName
_ SrcLoc
_ -> ModTypeExpBase Info VName -> Defs
modTypeExpDefs ModTypeExpBase Info VName
e
    ModTypeArrow Maybe VName
_ ModTypeExpBase Info VName
e1 ModTypeExpBase Info VName
e2 SrcLoc
_ -> ModTypeExpBase Info VName -> Defs
modTypeExpDefs ModTypeExpBase Info VName
e1 Defs -> Defs -> Defs
forall a. Semigroup a => a -> a -> a
<> ModTypeExpBase Info VName -> Defs
modTypeExpDefs ModTypeExpBase Info VName
e2

sigBindDefs :: ModTypeBind -> Defs
sigBindDefs :: ModTypeBind -> Defs
sigBindDefs ModTypeBind
sbind =
  VName -> Def -> Defs
forall k a. k -> a -> Map k a
M.singleton (ModTypeBind -> VName
forall (f :: * -> *) vn. ModTypeBindBase f vn -> vn
modTypeName ModTypeBind
sbind) (BoundTo -> Def
DefBound (BoundTo -> Def) -> BoundTo -> Def
forall a b. (a -> b) -> a -> b
$ Loc -> BoundTo
BoundModuleType (Loc -> BoundTo) -> Loc -> BoundTo
forall a b. (a -> b) -> a -> b
$ ModTypeBind -> Loc
forall a. Located a => a -> Loc
locOf ModTypeBind
sbind)
    Defs -> Defs -> Defs
forall a. Semigroup a => a -> a -> a
<> ModTypeExpBase Info VName -> Defs
modTypeExpDefs (ModTypeBind -> ModTypeExpBase Info VName
forall (f :: * -> *) vn.
ModTypeBindBase f vn -> ModTypeExpBase f vn
modTypeExp ModTypeBind
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 (ModTypeDec ModTypeBind
mbind) = ModTypeBind -> Defs
sigBindDefs ModTypeBind
mbind
decDefs (OpenDec ModExp
me SrcLoc
_) = ModExp -> Defs
modExpDefs ModExp
me
decDefs (LocalDec Dec
dec SrcLoc
_) = Dec -> Defs
decDefs Dec
dec
decDefs ImportDec {} = Defs
forall a. Monoid a => a
mempty

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

allBindings :: Imports -> M.Map VName BoundTo
allBindings :: Imports -> Map VName BoundTo
allBindings Imports
imports = (Def -> Maybe BoundTo) -> Defs -> Map VName BoundTo
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 = [Defs] -> Defs
forall a. Monoid a => [a] -> a
mconcat ([Defs] -> Defs) -> [Defs] -> Defs
forall a b. (a -> b) -> a -> b
$ ((ImportName, FileModule) -> Defs) -> Imports -> [Defs]
forall a b. (a -> b) -> [a] -> [b]
map (Prog -> Defs
progDefs (Prog -> Defs)
-> ((ImportName, FileModule) -> Prog)
-> (ImportName, FileModule)
-> Defs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileModule -> Prog
fileProg (FileModule -> Prog)
-> ((ImportName, FileModule) -> FileModule)
-> (ImportName, FileModule)
-> Prog
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ImportName, FileModule) -> FileModule
forall a b. (a, b) -> b
snd) Imports
imports
    forward :: Def -> Maybe BoundTo
forward (DefBound BoundTo
x) = BoundTo -> Maybe BoundTo
forall a. a -> Maybe a
Just BoundTo
x
    forward (DefIndirect VName
v) = Def -> Maybe BoundTo
forward (Def -> Maybe BoundTo) -> Maybe Def -> Maybe BoundTo
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< VName -> Defs -> Maybe Def
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 a -> Loc
forall a. Located a => a -> Loc
locOf a
a of
    Loc Pos
start Pos
end -> Pos
pos Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
>= Pos
start Bool -> Bool -> Bool
&& Pos
pos Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
<= Pos
end
    Loc
NoLoc -> Bool
False

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

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

atPosInExp :: Exp -> Pos -> Maybe RawAtPos
atPosInExp :: ExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInExp (Var QualName VName
qn Info StructType
_ SrcLoc
loc) Pos
pos = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ SrcLoc
loc SrcLoc -> Pos -> Bool
forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos
  RawAtPos -> Maybe RawAtPos
forall a. a -> Maybe a
Just (RawAtPos -> Maybe RawAtPos) -> RawAtPos -> Maybe RawAtPos
forall a b. (a -> b) -> a -> b
$ QualName VName -> Loc -> RawAtPos
RawAtName QualName VName
qn (Loc -> RawAtPos) -> Loc -> RawAtPos
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
atPosInExp (QualParens (QualName VName
qn, SrcLoc
loc) ExpBase Info VName
_ SrcLoc
_) Pos
pos
  | SrcLoc
loc SrcLoc -> Pos -> Bool
forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos = RawAtPos -> Maybe RawAtPos
forall a. a -> Maybe a
Just (RawAtPos -> Maybe RawAtPos) -> RawAtPos -> Maybe RawAtPos
forall a b. (a -> b) -> a -> b
$ QualName VName -> Loc -> RawAtPos
RawAtName QualName VName
qn (Loc -> RawAtPos) -> Loc -> RawAtPos
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
-- All the value cases are TODO - we need another RawAtPos constructor.
atPosInExp Literal {} Pos
_ = Maybe RawAtPos
forall a. Maybe a
Nothing
atPosInExp IntLit {} Pos
_ = Maybe RawAtPos
forall a. Maybe a
Nothing
atPosInExp FloatLit {} Pos
_ = Maybe RawAtPos
forall a. Maybe a
Nothing
atPosInExp (AppExp (LetPat [SizeBinder VName]
_ PatBase Info VName StructType
pat ExpBase Info VName
_ ExpBase Info VName
_ SrcLoc
_) Info AppRes
_) Pos
pos
  | PatBase Info VName StructType
pat PatBase Info VName StructType -> Pos -> Bool
forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos = PatBase Info VName StructType -> Pos -> Maybe RawAtPos
forall u.
Pat (TypeBase (ExpBase Info VName) u) -> Pos -> Maybe RawAtPos
atPosInPat PatBase Info VName StructType
pat Pos
pos
atPosInExp (AppExp (LetWith IdentBase Info VName StructType
a IdentBase Info VName StructType
b SliceBase Info VName
_ ExpBase Info VName
_ ExpBase Info VName
_ SrcLoc
_) Info AppRes
_) Pos
pos
  | IdentBase Info VName StructType
a IdentBase Info VName StructType -> Pos -> Bool
forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos = RawAtPos -> Maybe RawAtPos
forall a. a -> Maybe a
Just (RawAtPos -> Maybe RawAtPos) -> RawAtPos -> Maybe RawAtPos
forall a b. (a -> b) -> a -> b
$ QualName VName -> Loc -> RawAtPos
RawAtName (VName -> QualName VName
forall v. v -> QualName v
qualName (VName -> QualName VName) -> VName -> QualName VName
forall a b. (a -> b) -> a -> b
$ IdentBase Info VName StructType -> VName
forall {k} (f :: k -> *) vn (t :: k). IdentBase f vn t -> vn
identName IdentBase Info VName StructType
a) (IdentBase Info VName StructType -> Loc
forall a. Located a => a -> Loc
locOf IdentBase Info VName StructType
a)
  | IdentBase Info VName StructType
b IdentBase Info VName StructType -> Pos -> Bool
forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos = RawAtPos -> Maybe RawAtPos
forall a. a -> Maybe a
Just (RawAtPos -> Maybe RawAtPos) -> RawAtPos -> Maybe RawAtPos
forall a b. (a -> b) -> a -> b
$ QualName VName -> Loc -> RawAtPos
RawAtName (VName -> QualName VName
forall v. v -> QualName v
qualName (VName -> QualName VName) -> VName -> QualName VName
forall a b. (a -> b) -> a -> b
$ IdentBase Info VName StructType -> VName
forall {k} (f :: k -> *) vn (t :: k). IdentBase f vn t -> vn
identName IdentBase Info VName StructType
b) (IdentBase Info VName StructType -> Loc
forall a. Located a => a -> Loc
locOf IdentBase Info VName StructType
b)
atPosInExp (AppExp (Loop [VName]
_ PatBase Info VName ParamType
merge ExpBase Info VName
_ LoopFormBase Info VName
_ ExpBase Info VName
_ SrcLoc
_) Info AppRes
_) Pos
pos
  | PatBase Info VName ParamType
merge PatBase Info VName ParamType -> Pos -> Bool
forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos = PatBase Info VName ParamType -> Pos -> Maybe RawAtPos
forall u.
Pat (TypeBase (ExpBase Info VName) u) -> Pos -> Maybe RawAtPos
atPosInPat PatBase Info VName ParamType
merge Pos
pos
atPosInExp (Ascript ExpBase Info VName
_ TypeExp (ExpBase Info VName) VName
te SrcLoc
_) Pos
pos
  | TypeExp (ExpBase Info VName) VName
te TypeExp (ExpBase Info VName) VName -> Pos -> Bool
forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos = TypeExp (ExpBase Info VName) VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp (ExpBase Info VName) VName
te Pos
pos
atPosInExp (Coerce ExpBase Info VName
_ TypeExp (ExpBase Info VName) VName
te Info StructType
_ SrcLoc
_) Pos
pos
  | TypeExp (ExpBase Info VName) VName
te TypeExp (ExpBase Info VName) VName -> Pos -> Bool
forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos = TypeExp (ExpBase Info VName) VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp (ExpBase Info VName) VName
te Pos
pos
atPosInExp ExpBase Info VName
e Pos
pos = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ExpBase Info VName
e ExpBase Info VName -> Pos -> Bool
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 ASTMapper (Either RawAtPos)
-> ExpBase Info VName -> Either RawAtPos (ExpBase Info VName)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
astMap ASTMapper (Either RawAtPos)
mapper ExpBase Info VName
e of
    Left RawAtPos
atpos -> RawAtPos -> Maybe RawAtPos
forall a. a -> Maybe a
Just RawAtPos
atpos
    Right ExpBase Info VName
_ -> Maybe RawAtPos
forall a. Maybe a
Nothing
  where
    mapper :: ASTMapper (Either RawAtPos)
mapper =
      ASTMapper (Either RawAtPos)
forall (m :: * -> *). Monad m => ASTMapper m
identityMapper {mapOnExp = onExp}
    onExp :: ExpBase Info VName -> Either RawAtPos (ExpBase Info VName)
onExp ExpBase Info VName
e' =
      case ExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInExp ExpBase Info VName
e' Pos
pos of
        Just RawAtPos
atpos -> RawAtPos -> Either RawAtPos (ExpBase Info VName)
forall a b. a -> Either a b
Left RawAtPos
atpos
        Maybe RawAtPos
Nothing -> ExpBase Info VName -> Either RawAtPos (ExpBase Info VName)
forall a b. b -> Either a b
Right ExpBase Info VName
e'

atPosInModExp :: ModExp -> Pos -> Maybe RawAtPos
atPosInModExp :: ModExp -> Pos -> Maybe RawAtPos
atPosInModExp (ModVar QualName VName
qn SrcLoc
loc) Pos
pos = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ SrcLoc
loc SrcLoc -> Pos -> Bool
forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos
  RawAtPos -> Maybe RawAtPos
forall a. a -> Maybe a
Just (RawAtPos -> Maybe RawAtPos) -> RawAtPos -> Maybe RawAtPos
forall a b. (a -> b) -> a -> b
$ QualName VName -> Loc -> RawAtPos
RawAtName QualName VName
qn (Loc -> RawAtPos) -> Loc -> RawAtPos
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Loc
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
_ =
  Maybe RawAtPos
forall a. Maybe a
Nothing
atPosInModExp (ModDecs [Dec]
decs SrcLoc
_) Pos
pos =
  [Maybe RawAtPos] -> Maybe RawAtPos
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe RawAtPos] -> Maybe RawAtPos)
-> [Maybe RawAtPos] -> Maybe RawAtPos
forall a b. (a -> b) -> a -> b
$ (Dec -> Maybe RawAtPos) -> [Dec] -> [Maybe RawAtPos]
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 Maybe RawAtPos -> Maybe RawAtPos -> Maybe RawAtPos
forall a. Maybe a -> Maybe a -> Maybe a
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 ModTypeExpBase Info VName
_ Info (Map VName VName)
_ SrcLoc
_) Pos
pos =
  ModExp -> Pos -> Maybe RawAtPos
atPosInModExp ModExp
e Pos
pos
atPosInModExp (ModLambda ModParam
_ Maybe (ModTypeExpBase 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 (ExpBase Info VName) VName
te Info StructType
_ Maybe DocComment
_ SrcLoc
_ -> TypeExp (ExpBase Info VName) VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp (ExpBase Info VName) VName
te Pos
pos
    TypeAbbrSpec TypeBind
tbind -> TypeBind -> Pos -> Maybe RawAtPos
atPosInTypeBind TypeBind
tbind Pos
pos
    TypeSpec {} -> Maybe RawAtPos
forall a. Maybe a
Nothing
    ModSpec VName
_ ModTypeExpBase Info VName
se Maybe DocComment
_ SrcLoc
_ -> ModTypeExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInModTypeExp ModTypeExpBase Info VName
se Pos
pos
    IncludeSpec ModTypeExpBase Info VName
se SrcLoc
_ -> ModTypeExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInModTypeExp ModTypeExpBase Info VName
se Pos
pos

atPosInModTypeExp :: ModTypeExp -> Pos -> Maybe RawAtPos
atPosInModTypeExp :: ModTypeExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInModTypeExp ModTypeExpBase Info VName
se Pos
pos =
  case ModTypeExpBase Info VName
se of
    ModTypeVar QualName VName
qn Info (Map VName VName)
_ SrcLoc
loc -> do
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ SrcLoc
loc SrcLoc -> Pos -> Bool
forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos
      RawAtPos -> Maybe RawAtPos
forall a. a -> Maybe a
Just (RawAtPos -> Maybe RawAtPos) -> RawAtPos -> Maybe RawAtPos
forall a b. (a -> b) -> a -> b
$ QualName VName -> Loc -> RawAtPos
RawAtName QualName VName
qn (Loc -> RawAtPos) -> Loc -> RawAtPos
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc
    ModTypeParens ModTypeExpBase Info VName
e SrcLoc
_ -> ModTypeExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInModTypeExp ModTypeExpBase Info VName
e Pos
pos
    ModTypeSpecs [Spec]
specs SrcLoc
_ -> [Maybe RawAtPos] -> Maybe RawAtPos
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe RawAtPos] -> Maybe RawAtPos)
-> [Maybe RawAtPos] -> Maybe RawAtPos
forall a b. (a -> b) -> a -> b
$ (Spec -> Maybe RawAtPos) -> [Spec] -> [Maybe RawAtPos]
forall a b. (a -> b) -> [a] -> [b]
map (Spec -> Pos -> Maybe RawAtPos
`atPosInSpec` Pos
pos) [Spec]
specs
    ModTypeWith ModTypeExpBase Info VName
e TypeRefBase Info VName
_ SrcLoc
_ -> ModTypeExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInModTypeExp ModTypeExpBase Info VName
e Pos
pos
    ModTypeArrow Maybe VName
_ ModTypeExpBase Info VName
e1 ModTypeExpBase Info VName
e2 SrcLoc
_ -> ModTypeExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInModTypeExp ModTypeExpBase Info VName
e1 Pos
pos Maybe RawAtPos -> Maybe RawAtPos -> Maybe RawAtPos
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` ModTypeExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInModTypeExp ModTypeExpBase Info VName
e2 Pos
pos

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

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

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

atPosInModTypeBind :: ModTypeBind -> Pos -> Maybe RawAtPos
atPosInModTypeBind :: ModTypeBind -> Pos -> Maybe RawAtPos
atPosInModTypeBind = ModTypeExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInModTypeExp (ModTypeExpBase Info VName -> Pos -> Maybe RawAtPos)
-> (ModTypeBind -> ModTypeExpBase Info VName)
-> ModTypeBind
-> Pos
-> Maybe RawAtPos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModTypeBind -> ModTypeExpBase Info VName
forall (f :: * -> *) vn.
ModTypeBindBase f vn -> ModTypeExpBase f vn
modTypeExp

atPosInDec :: Dec -> Pos -> Maybe RawAtPos
atPosInDec :: Dec -> Pos -> Maybe RawAtPos
atPosInDec Dec
dec Pos
pos = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Dec
dec Dec -> Pos -> Bool
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
    ModTypeDec ModTypeBind
sbind -> ModTypeBind -> Pos -> Maybe RawAtPos
atPosInModTypeBind ModTypeBind
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 {} -> Maybe RawAtPos
forall a. Maybe a
Nothing

atPosInProg :: Prog -> Pos -> Maybe RawAtPos
atPosInProg :: Prog -> Pos -> Maybe RawAtPos
atPosInProg Prog
prog Pos
pos =
  [Maybe RawAtPos] -> Maybe RawAtPos
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe RawAtPos] -> Maybe RawAtPos)
-> [Maybe RawAtPos] -> Maybe RawAtPos
forall a b. (a -> b) -> a -> b
$ (Dec -> Maybe RawAtPos) -> [Dec] -> [Maybe RawAtPos]
forall a b. (a -> b) -> [a] -> [b]
map (Dec -> Pos -> Maybe RawAtPos
`atPosInDec` Pos
pos) (Prog -> [Dec]
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
_) =
  (ImportName, FileModule) -> FileModule
forall a b. (a, b) -> b
snd ((ImportName, FileModule) -> FileModule)
-> Maybe (ImportName, FileModule) -> Maybe FileModule
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ImportName, FileModule) -> Bool)
-> Imports -> Maybe (ImportName, FileModule)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((ImportName -> ImportName -> Bool
forall a. Eq a => a -> a -> Bool
== ImportName
file') (ImportName -> Bool)
-> ((ImportName, FileModule) -> ImportName)
-> (ImportName, FileModule)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ImportName, FileModule) -> ImportName
forall a b. (a, b) -> a
fst) Imports
imports
  where
    file' :: ImportName
file' = String -> ImportName
mkInitialImport (String -> ImportName) -> String -> ImportName
forall a b. (a -> b) -> a -> b
$ (String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String) -> (String, String) -> String
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
(AtPos -> AtPos -> Bool) -> (AtPos -> AtPos -> Bool) -> Eq AtPos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AtPos -> AtPos -> Bool
== :: AtPos -> AtPos -> Bool
$c/= :: AtPos -> AtPos -> Bool
/= :: AtPos -> AtPos -> Bool
Eq, Int -> AtPos -> ShowS
[AtPos] -> ShowS
AtPos -> String
(Int -> AtPos -> ShowS)
-> (AtPos -> String) -> ([AtPos] -> ShowS) -> Show AtPos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AtPos -> ShowS
showsPrec :: Int -> AtPos -> ShowS
$cshow :: AtPos -> String
show :: AtPos -> String
$cshowList :: [AtPos] -> ShowS
showList :: [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 (FileModule -> Prog) -> Maybe FileModule -> Maybe Prog
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
  AtPos -> Maybe AtPos
forall a. a -> Maybe a
Just (AtPos -> Maybe AtPos) -> AtPos -> Maybe AtPos
forall a b. (a -> b) -> a -> b
$ QualName VName -> Maybe BoundTo -> Loc -> AtPos
AtName QualName VName
qn (QualName VName -> VName
forall vn. QualName vn -> vn
qualLeaf QualName VName
qn VName -> Map VName BoundTo -> Maybe BoundTo
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Imports -> Map VName BoundTo
allBindings Imports
imports) Loc
loc