{-# LANGUAGE FlexibleContexts #-}

-- | 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 qualified Data.Map as M
import Futhark.Util.Loc (Loc (..), Pos (..))
import Language.Futhark
import Language.Futhark.Semantic
import Language.Futhark.Traversals
import qualified System.FilePath.Posix 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
/= :: BoundTo -> BoundTo -> Bool
$c/= :: BoundTo -> BoundTo -> Bool
== :: BoundTo -> BoundTo -> Bool
$c== :: 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
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
(Def -> Def -> Bool) -> (Def -> Def -> Bool) -> Eq Def
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
(Int -> Def -> ShowS)
-> (Def -> String) -> ([Def] -> ShowS) -> Show Def
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) =
  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 (DimDecl VName) () -> StructType
forall dim as. ScalarTypeBase dim as -> TypeBase dim as
Scalar (PrimType -> ScalarTypeBase (DimDecl VName) ()
forall dim as. PrimType -> ScalarTypeBase dim as
Prim (IntType -> PrimType
Signed IntType
Int64))) (SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc)

patternDefs :: Pattern -> Defs
patternDefs :: PatternBase Info VName -> Defs
patternDefs (Id VName
vn (Info PatternType
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 (PatternType -> StructType
forall dim as. TypeBase dim as -> TypeBase dim ()
toStruct PatternType
t) (SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc)
patternDefs (TuplePattern [PatternBase Info VName]
pats SrcLoc
_) =
  [Defs] -> Defs
forall a. Monoid a => [a] -> a
mconcat ([Defs] -> Defs) -> [Defs] -> Defs
forall a b. (a -> b) -> a -> b
$ (PatternBase Info VName -> Defs)
-> [PatternBase Info VName] -> [Defs]
forall a b. (a -> b) -> [a] -> [b]
map PatternBase Info VName -> Defs
patternDefs [PatternBase Info VName]
pats
patternDefs (RecordPattern [(Name, PatternBase Info VName)]
fields SrcLoc
_) =
  [Defs] -> Defs
forall a. Monoid a => [a] -> a
mconcat ([Defs] -> Defs) -> [Defs] -> Defs
forall a b. (a -> b) -> a -> b
$ ((Name, PatternBase Info VName) -> Defs)
-> [(Name, PatternBase Info VName)] -> [Defs]
forall a b. (a -> b) -> [a] -> [b]
map (PatternBase Info VName -> Defs
patternDefs (PatternBase Info VName -> Defs)
-> ((Name, PatternBase Info VName) -> PatternBase Info VName)
-> (Name, PatternBase Info VName)
-> Defs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, PatternBase Info VName) -> PatternBase Info VName
forall a b. (a, b) -> b
snd) [(Name, PatternBase Info VName)]
fields
patternDefs (PatternParens PatternBase Info VName
pat SrcLoc
_) =
  PatternBase Info VName -> Defs
patternDefs PatternBase Info VName
pat
patternDefs Wildcard {} = Defs
forall a. Monoid a => a
mempty
patternDefs PatternLit {} = Defs
forall a. Monoid a => a
mempty
patternDefs (PatternAscription PatternBase Info VName
pat TypeDeclBase Info VName
_ SrcLoc
_) =
  PatternBase Info VName -> Defs
patternDefs PatternBase Info VName
pat
patternDefs (PatternConstr Name
_ Info PatternType
_ [PatternBase Info VName]
pats SrcLoc
_) =
  [Defs] -> Defs
forall a. Monoid a => [a] -> a
mconcat ([Defs] -> Defs) -> [Defs] -> Defs
forall a b. (a -> b) -> a -> b
$ (PatternBase Info VName -> Defs)
-> [PatternBase Info VName] -> [Defs]
forall a b. (a -> b) -> [a] -> [b]
map PatternBase Info VName -> Defs
patternDefs [PatternBase Info VName]
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 (DimDecl VName) () -> StructType
forall dim as. ScalarTypeBase dim as -> TypeBase dim as
Scalar (ScalarTypeBase (DimDecl VName) () -> StructType)
-> ScalarTypeBase (DimDecl VName) () -> StructType
forall a b. (a -> b) -> a -> b
$ PrimType -> ScalarTypeBase (DimDecl VName) ()
forall dim as. PrimType -> ScalarTypeBase dim as
Prim (PrimType -> ScalarTypeBase (DimDecl VName) ())
-> PrimType -> ScalarTypeBase (DimDecl VName) ()
forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int32) (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 :: Exp -> Defs
expDefs Exp
e =
  State Defs Exp -> Defs -> Defs
forall s a. State s a -> s -> s
execState (ASTMapper (StateT Defs Identity) -> Exp -> State Defs Exp
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 =
      ASTMapper :: forall (m :: * -> *).
(Exp -> m Exp)
-> (VName -> m VName)
-> (QualName VName -> m (QualName VName))
-> (StructType -> m StructType)
-> (PatternType -> m PatternType)
-> ASTMapper m
ASTMapper
        { mapOnExp :: Exp -> State Defs Exp
mapOnExp = Exp -> State Defs Exp
forall {m :: * -> *}. MonadState Defs m => Exp -> m Exp
onExp,
          mapOnName :: VName -> StateT Defs Identity VName
mapOnName = VName -> StateT Defs Identity VName
forall (f :: * -> *) a. Applicative f => a -> f a
pure,
          mapOnQualName :: QualName VName -> StateT Defs Identity (QualName VName)
mapOnQualName = QualName VName -> StateT Defs Identity (QualName VName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure,
          mapOnStructType :: StructType -> StateT Defs Identity StructType
mapOnStructType = StructType -> StateT Defs Identity StructType
forall (f :: * -> *) a. Applicative f => a -> f a
pure,
          mapOnPatternType :: PatternType -> StateT Defs Identity PatternType
mapOnPatternType = PatternType -> StateT Defs Identity PatternType
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        }
    onExp :: Exp -> m Exp
onExp Exp
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
<> Exp -> Defs
expDefs Exp
e')
      Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
e'

    identDefs :: IdentBase Info k -> Map k Def
identDefs (Ident k
v (Info PatternType
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 (PatternType -> StructType
forall dim as. TypeBase dim as -> TypeBase dim ()
toStruct PatternType
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 Exp
e of
        AppExp (LetPat [SizeBinder VName]
sizes PatternBase Info VName
pat Exp
_ Exp
_ SrcLoc
_) Info AppRes
_ ->
          (SizeBinder VName -> Defs) -> [SizeBinder VName] -> Defs
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
<> PatternBase Info VName -> Defs
patternDefs PatternBase Info VName
pat
        Lambda [PatternBase Info VName]
params Exp
_ Maybe (TypeExp VName)
_ Info (Aliasing, StructType)
_ SrcLoc
_ ->
          [Defs] -> Defs
forall a. Monoid a => [a] -> a
mconcat ((PatternBase Info VName -> Defs)
-> [PatternBase Info VName] -> [Defs]
forall a b. (a -> b) -> [a] -> [b]
map PatternBase Info VName -> Defs
patternDefs [PatternBase Info VName]
params)
        AppExp (LetFun VName
name ([TypeParamBase VName]
tparams, [PatternBase Info VName]
params, Maybe (TypeExp VName)
_, Info StructType
ret, Exp
_) Exp
_ SrcLoc
loc) Info AppRes
_ ->
          let name_t :: StructType
name_t = [StructType] -> StructType -> StructType
forall as dim.
Monoid as =>
[TypeBase dim as] -> TypeBase dim as -> TypeBase dim as
foldFunType ((PatternBase Info VName -> StructType)
-> [PatternBase Info VName] -> [StructType]
forall a b. (a -> b) -> [a] -> [b]
map PatternBase Info VName -> StructType
patternStructType [PatternBase Info VName]
params) StructType
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 ((PatternBase Info VName -> Defs)
-> [PatternBase Info VName] -> [Defs]
forall a b. (a -> b) -> [a] -> [b]
map PatternBase Info VName -> Defs
patternDefs [PatternBase Info VName]
params)
        AppExp (LetWith IdentBase Info VName
v IdentBase Info VName
_ [DimIndexBase Info VName]
_ Exp
_ Exp
_ SrcLoc
_) Info AppRes
_ ->
          IdentBase Info VName -> Defs
forall {k}. IdentBase Info k -> Map k Def
identDefs IdentBase Info VName
v
        AppExp (DoLoop [VName]
_ PatternBase Info VName
merge Exp
_ LoopFormBase Info VName
form Exp
_ SrcLoc
_) Info AppRes
_ ->
          PatternBase Info VName -> Defs
patternDefs PatternBase Info VName
merge
            Defs -> Defs -> Defs
forall a. Semigroup a => a -> a -> a
<> case LoopFormBase Info VName
form of
              For IdentBase Info VName
i Exp
_ -> IdentBase Info VName -> Defs
forall {k}. IdentBase Info k -> Map k Def
identDefs IdentBase Info VName
i
              ForIn PatternBase Info VName
pat Exp
_ -> PatternBase Info VName -> Defs
patternDefs PatternBase Info VName
pat
              While {} -> Defs
forall a. Monoid a => a
mempty
        Exp
_ ->
          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 ((PatternBase Info VName -> Defs)
-> [PatternBase Info VName] -> [Defs]
forall a b. (a -> b) -> [a] -> [b]
map PatternBase Info VName -> Defs
patternDefs (ValBind -> [PatternBase Info VName]
forall (f :: * -> *) vn. ValBindBase f vn -> [PatternBase f vn]
valBindParams ValBind
vbind))
      Defs -> Defs -> Defs
forall a. Semigroup a => a -> a -> a
<> Exp -> Defs
expDefs (ValBind -> Exp
forall (f :: * -> *) vn. ValBindBase f vn -> ExpBase f vn
valBindBody ValBind
vbind)
  where
    vbind_t :: StructType
vbind_t =
      [StructType] -> StructType -> StructType
forall as dim.
Monoid as =>
[TypeBase dim as] -> TypeBase dim as -> TypeBase dim as
foldFunType ((PatternBase Info VName -> StructType)
-> [PatternBase Info VName] -> [StructType]
forall a b. (a -> b) -> [a] -> [b]
map PatternBase Info VName -> StructType
patternStructType (ValBind -> [PatternBase Info VName]
forall (f :: * -> *) vn. ValBindBase f vn -> [PatternBase f vn]
valBindParams ValBind
vbind)) (StructType -> StructType) -> StructType -> StructType
forall a b. (a -> b) -> a -> b
$
        (StructType, [VName]) -> StructType
forall a b. (a, b) -> a
fst ((StructType, [VName]) -> StructType)
-> (StructType, [VName]) -> StructType
forall a b. (a -> b) -> a -> b
$ Info (StructType, [VName]) -> (StructType, [VName])
forall a. Info a -> a
unInfo (Info (StructType, [VName]) -> (StructType, [VName]))
-> Info (StructType, [VName]) -> (StructType, [VName])
forall a b. (a -> b) -> a -> b
$ ValBind -> Info (StructType, [VName])
forall (f :: * -> *) vn.
ValBindBase f vn -> f (StructType, [VName])
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 SigExpBase 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
<> SigExpBase Info VName -> Defs
sigExpDefs SigExpBase 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 SigExpBase 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 (SigExpBase 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 (SigExpBase Info VName, Info (Map VName VName))
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 -> Defs
forall a. Monoid a => a
mempty
      Just (SigExpBase 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 TypeDeclBase Info VName
tdecl 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 (Info StructType -> StructType
forall a. Info a -> a
unInfo (Info StructType -> StructType) -> Info StructType -> StructType
forall a b. (a -> b) -> a -> b
$ TypeDeclBase Info VName -> Info StructType
forall (f :: * -> *) vn. TypeDeclBase f vn -> f StructType
expandedType TypeDeclBase Info VName
tdecl) (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 SigExpBase 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
<> 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
_ -> (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
    SigParens SigExpBase Info VName
e SrcLoc
_ -> SigExpBase Info VName -> Defs
sigExpDefs SigExpBase Info VName
e
    SigSpecs [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
    SigWith SigExpBase Info VName
e TypeRefBase Info 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 Defs -> Defs -> Defs
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 =
  VName -> Def -> Defs
forall k a. k -> a -> Map k a
M.singleton (SigBind -> VName
forall (f :: * -> *) vn. SigBindBase f vn -> vn
sigName SigBind
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
$ SigBind -> Loc
forall a. Located a => a -> Loc
locOf SigBind
sbind)
    Defs -> Defs -> Defs
forall a. Semigroup a => a -> a -> a
<> SigExpBase Info VName -> Defs
sigExpDefs (SigBind -> SigExpBase Info VName
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 {} = 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
$ ((String, FileModule) -> Defs) -> Imports -> [Defs]
forall a b. (a -> b) -> [a] -> [b]
map (Prog -> Defs
progDefs (Prog -> Defs)
-> ((String, FileModule) -> Prog) -> (String, FileModule) -> Defs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileModule -> Prog
fileProg (FileModule -> Prog)
-> ((String, FileModule) -> FileModule)
-> (String, FileModule)
-> Prog
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, 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 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
      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
    TETuple [TypeExp 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 VName -> Maybe RawAtPos)
-> [TypeExp VName] -> [Maybe RawAtPos]
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
_ ->
      [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 VName) -> Maybe RawAtPos)
-> [(Name, TypeExp VName)] -> [Maybe RawAtPos]
forall a b. (a -> b) -> [a] -> [b]
map ((TypeExp VName -> Pos -> Maybe RawAtPos
`atPosInTypeExp` Pos
pos) (TypeExp VName -> Maybe RawAtPos)
-> ((Name, TypeExp VName) -> TypeExp VName)
-> (Name, TypeExp VName)
-> Maybe RawAtPos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, TypeExp VName) -> TypeExp VName
forall a b. (a, b) -> b
snd) [(Name, TypeExp VName)]
fields
    TEArray TypeExp VName
te' DimExp VName
dim SrcLoc
_ ->
      TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp VName
te' Pos
pos Maybe RawAtPos -> Maybe RawAtPos -> Maybe RawAtPos
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` DimExp VName -> Maybe RawAtPos
inDim DimExp 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 Maybe RawAtPos -> Maybe RawAtPos -> Maybe RawAtPos
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 Maybe RawAtPos -> Maybe RawAtPos -> Maybe RawAtPos
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
_ ->
      [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 VName -> Maybe RawAtPos)
-> [TypeExp VName] -> [Maybe RawAtPos]
forall a b. (a -> b) -> [a] -> [b]
map (TypeExp VName -> Pos -> Maybe RawAtPos
`atPosInTypeExp` Pos
pos) ([TypeExp VName] -> [Maybe RawAtPos])
-> [TypeExp VName] -> [Maybe RawAtPos]
forall a b. (a -> b) -> a -> b
$ ((Name, [TypeExp VName]) -> [TypeExp VName])
-> [(Name, [TypeExp VName])] -> [TypeExp VName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Name, [TypeExp VName]) -> [TypeExp VName]
forall a b. (a, b) -> b
snd [(Name, [TypeExp VName])]
cs
  where
    inArg :: TypeArgExp VName -> Maybe RawAtPos
inArg (TypeArgExpDim DimExp VName
dim SrcLoc
_) = DimExp VName -> Maybe RawAtPos
inDim DimExp VName
dim
    inArg (TypeArgExpType TypeExp VName
e2) = TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp VName
e2 Pos
pos
    inDim :: DimExp VName -> Maybe RawAtPos
inDim (DimExpNamed 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
    inDim DimExp VName
_ = Maybe RawAtPos
forall a. Maybe a
Nothing

atPosInPattern :: Pattern -> Pos -> Maybe RawAtPos
atPosInPattern :: PatternBase Info VName -> Pos -> Maybe RawAtPos
atPosInPattern (Id VName
vn Info PatternType
_ 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
atPosInPattern (TuplePattern [PatternBase Info VName]
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
$ (PatternBase Info VName -> Maybe RawAtPos)
-> [PatternBase Info VName] -> [Maybe RawAtPos]
forall a b. (a -> b) -> [a] -> [b]
map (PatternBase Info VName -> Pos -> Maybe RawAtPos
`atPosInPattern` Pos
pos) [PatternBase Info VName]
pats
atPosInPattern (RecordPattern [(Name, PatternBase Info VName)]
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, PatternBase Info VName) -> Maybe RawAtPos)
-> [(Name, PatternBase Info VName)] -> [Maybe RawAtPos]
forall a b. (a -> b) -> [a] -> [b]
map ((PatternBase Info VName -> Pos -> Maybe RawAtPos
`atPosInPattern` Pos
pos) (PatternBase Info VName -> Maybe RawAtPos)
-> ((Name, PatternBase Info VName) -> PatternBase Info VName)
-> (Name, PatternBase Info VName)
-> Maybe RawAtPos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, PatternBase Info VName) -> PatternBase Info VName
forall a b. (a, b) -> b
snd) [(Name, PatternBase Info VName)]
fields
atPosInPattern (PatternParens PatternBase Info VName
pat SrcLoc
_) Pos
pos =
  PatternBase Info VName -> Pos -> Maybe RawAtPos
atPosInPattern PatternBase Info VName
pat Pos
pos
atPosInPattern (PatternAscription PatternBase Info VName
pat TypeDeclBase Info VName
tdecl SrcLoc
_) Pos
pos =
  PatternBase Info VName -> Pos -> Maybe RawAtPos
atPosInPattern PatternBase Info VName
pat Pos
pos Maybe RawAtPos -> Maybe RawAtPos -> Maybe RawAtPos
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp (TypeDeclBase Info VName -> TypeExp VName
forall (f :: * -> *) vn. TypeDeclBase f vn -> TypeExp vn
declaredType TypeDeclBase Info VName
tdecl) Pos
pos
atPosInPattern (PatternConstr Name
_ Info PatternType
_ [PatternBase Info VName]
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
$ (PatternBase Info VName -> Maybe RawAtPos)
-> [PatternBase Info VName] -> [Maybe RawAtPos]
forall a b. (a -> b) -> [a] -> [b]
map (PatternBase Info VName -> Pos -> Maybe RawAtPos
`atPosInPattern` Pos
pos) [PatternBase Info VName]
pats
atPosInPattern PatternLit {} Pos
_ = Maybe RawAtPos
forall a. Maybe a
Nothing
atPosInPattern Wildcard {} Pos
_ = Maybe RawAtPos
forall a. Maybe a
Nothing

atPosInExp :: Exp -> Pos -> Maybe RawAtPos
atPosInExp :: Exp -> Pos -> Maybe RawAtPos
atPosInExp (Var QualName VName
qn Info PatternType
_ 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) Exp
_ 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]
_ PatternBase Info VName
pat Exp
_ Exp
_ SrcLoc
_) Info AppRes
_) Pos
pos
  | PatternBase Info VName
pat PatternBase Info VName -> Pos -> Bool
forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos = PatternBase Info VName -> Pos -> Maybe RawAtPos
atPosInPattern PatternBase Info VName
pat Pos
pos
atPosInExp (AppExp (LetWith IdentBase Info VName
a IdentBase Info VName
b [DimIndexBase Info VName]
_ Exp
_ Exp
_ SrcLoc
_) Info AppRes
_) Pos
pos
  | IdentBase Info VName
a IdentBase Info VName -> 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 -> VName
forall (f :: * -> *) vn. IdentBase f vn -> vn
identName IdentBase Info VName
a) (IdentBase Info VName -> Loc
forall a. Located a => a -> Loc
locOf IdentBase Info VName
a)
  | IdentBase Info VName
b IdentBase Info VName -> 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 -> VName
forall (f :: * -> *) vn. IdentBase f vn -> vn
identName IdentBase Info VName
b) (IdentBase Info VName -> Loc
forall a. Located a => a -> Loc
locOf IdentBase Info VName
b)
atPosInExp (AppExp (DoLoop [VName]
_ PatternBase Info VName
merge Exp
_ LoopFormBase Info VName
_ Exp
_ SrcLoc
_) Info AppRes
_) Pos
pos
  | PatternBase Info VName
merge PatternBase Info VName -> Pos -> Bool
forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos = PatternBase Info VName -> Pos -> Maybe RawAtPos
atPosInPattern PatternBase Info VName
merge Pos
pos
atPosInExp (Ascript Exp
_ TypeDeclBase Info VName
tdecl SrcLoc
_) Pos
pos
  | TypeDeclBase Info VName
tdecl TypeDeclBase Info VName -> Pos -> Bool
forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos = TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp (TypeDeclBase Info VName -> TypeExp VName
forall (f :: * -> *) vn. TypeDeclBase f vn -> TypeExp vn
declaredType TypeDeclBase Info VName
tdecl) Pos
pos
atPosInExp (AppExp (Coerce Exp
_ TypeDeclBase Info VName
tdecl SrcLoc
_) Info AppRes
_) Pos
pos
  | TypeDeclBase Info VName
tdecl TypeDeclBase Info VName -> Pos -> Bool
forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos = TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp (TypeDeclBase Info VName -> TypeExp VName
forall (f :: * -> *) vn. TypeDeclBase f vn -> TypeExp vn
declaredType TypeDeclBase Info VName
tdecl) Pos
pos
atPosInExp Exp
e Pos
pos = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Exp
e Exp -> 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) -> Exp -> Either RawAtPos Exp
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper (Either RawAtPos)
mapper Exp
e of
    Left RawAtPos
atpos -> RawAtPos -> Maybe RawAtPos
forall a. a -> Maybe a
Just RawAtPos
atpos
    Right Exp
_ -> Maybe RawAtPos
forall a. Maybe a
Nothing
  where
    mapper :: ASTMapper (Either RawAtPos)
mapper =
      ASTMapper :: forall (m :: * -> *).
(Exp -> m Exp)
-> (VName -> m VName)
-> (QualName VName -> m (QualName VName))
-> (StructType -> m StructType)
-> (PatternType -> m PatternType)
-> ASTMapper m
ASTMapper
        { mapOnExp :: Exp -> Either RawAtPos Exp
mapOnExp = Exp -> Either RawAtPos Exp
onExp,
          mapOnName :: VName -> Either RawAtPos VName
mapOnName = VName -> Either RawAtPos VName
forall (f :: * -> *) a. Applicative f => a -> f a
pure,
          mapOnQualName :: QualName VName -> Either RawAtPos (QualName VName)
mapOnQualName = QualName VName -> Either RawAtPos (QualName VName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure,
          mapOnStructType :: StructType -> Either RawAtPos StructType
mapOnStructType = StructType -> Either RawAtPos StructType
forall (f :: * -> *) a. Applicative f => a -> f a
pure,
          mapOnPatternType :: PatternType -> Either RawAtPos PatternType
mapOnPatternType = PatternType -> Either RawAtPos PatternType
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        }
    onExp :: Exp -> Either RawAtPos Exp
onExp Exp
e' =
      case Exp -> Pos -> Maybe RawAtPos
atPosInExp Exp
e' Pos
pos of
        Just RawAtPos
atpos -> RawAtPos -> Either RawAtPos Exp
forall a b. a -> Either a b
Left RawAtPos
atpos
        Maybe RawAtPos
Nothing -> Exp -> Either RawAtPos Exp
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
  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 (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]
_ TypeDeclBase Info VName
tdecl Maybe DocComment
_ SrcLoc
_ -> TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp (TypeDeclBase Info VName -> TypeExp VName
forall (f :: * -> *) vn. TypeDeclBase f vn -> TypeExp vn
declaredType TypeDeclBase Info VName
tdecl) Pos
pos
    TypeAbbrSpec TypeBind
tbind -> TypeBind -> Pos -> Maybe RawAtPos
atPosInTypeBind TypeBind
tbind Pos
pos
    TypeSpec {} -> Maybe RawAtPos
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
      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
    SigParens SigExpBase Info VName
e SrcLoc
_ -> SigExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInSigExp SigExpBase Info VName
e Pos
pos
    SigSpecs [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
    SigWith SigExpBase Info VName
e TypeRefBase Info 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 Maybe RawAtPos -> Maybe RawAtPos -> Maybe RawAtPos
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 =
  [Maybe RawAtPos] -> Maybe RawAtPos
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ((PatternBase Info VName -> Maybe RawAtPos)
-> [PatternBase Info VName] -> [Maybe RawAtPos]
forall a b. (a -> b) -> [a] -> [b]
map (PatternBase Info VName -> Pos -> Maybe RawAtPos
`atPosInPattern` Pos
pos) (ValBind -> [PatternBase Info VName]
forall (f :: * -> *) vn. ValBindBase f vn -> [PatternBase f vn]
valBindParams ValBind
vbind))
    Maybe RawAtPos -> Maybe RawAtPos -> Maybe RawAtPos
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Exp -> Pos -> Maybe RawAtPos
atPosInExp (ValBind -> Exp
forall (f :: * -> *) vn. ValBindBase f vn -> ExpBase f vn
valBindBody ValBind
vbind) Pos
pos
    Maybe RawAtPos -> Maybe RawAtPos -> Maybe RawAtPos
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 VName -> Pos -> Maybe RawAtPos
atPosInTypeExp (TypeExp VName -> Pos -> Maybe RawAtPos)
-> Maybe (TypeExp VName) -> Maybe (Pos -> Maybe RawAtPos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValBind -> Maybe (TypeExp VName)
forall (f :: * -> *) vn. ValBindBase f vn -> Maybe (TypeExp vn)
valBindRetDecl ValBind
vbind Maybe (Pos -> Maybe RawAtPos)
-> Maybe Pos -> Maybe (Maybe RawAtPos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pos -> Maybe Pos
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 (TypeExp VName -> Pos -> Maybe RawAtPos)
-> (TypeBind -> TypeExp VName) -> TypeBind -> Pos -> Maybe RawAtPos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDeclBase Info VName -> TypeExp VName
forall (f :: * -> *) vn. TypeDeclBase f vn -> TypeExp vn
declaredType (TypeDeclBase Info VName -> TypeExp VName)
-> (TypeBind -> TypeDeclBase Info VName)
-> TypeBind
-> TypeExp VName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeBind -> TypeDeclBase Info VName
forall (f :: * -> *) vn. TypeBindBase f vn -> TypeDeclBase f 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 =
  [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 (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 (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 -> Maybe RawAtPos
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 (SigExpBase Info VName -> Pos -> Maybe RawAtPos)
-> (SigBind -> SigExpBase Info VName)
-> SigBind
-> Pos
-> Maybe RawAtPos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigBind -> SigExpBase Info VName
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
  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
    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 {} -> 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
_) =
  (String, FileModule) -> FileModule
forall a b. (a, b) -> b
snd ((String, FileModule) -> FileModule)
-> Maybe (String, FileModule) -> Maybe FileModule
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((String, FileModule) -> Bool)
-> Imports -> Maybe (String, FileModule)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
file') (String -> Bool)
-> ((String, FileModule) -> String) -> (String, FileModule) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, FileModule) -> String
forall a b. (a, b) -> a
fst) Imports
imports
  where
    file' :: String
file' =
      ImportName -> String
includeToString (ImportName -> String) -> ImportName -> String
forall a b. (a -> b) -> a -> b
$
        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
/= :: AtPos -> AtPos -> Bool
$c/= :: AtPos -> AtPos -> Bool
== :: AtPos -> AtPos -> Bool
$c== :: 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
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 (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