{-# LANGUAGE RankNTypes #-}

module HsDev.Symbols.Parsed (
	Ann, Parsed,
	qnames, names, binders, locals, globals, references, unresolveds,
	usages, named, imports, declarations, moduleNames,

	annL, symbolL, file, pos, defPos, resolvedName,
	isBinder, isLocal, isGlobal, isReference, isUnresolved, resolveError,
	refsTo, refsToName,
	nameInfoL, positionL, regionL, fileL,
	symbolNameL,

	prettyPrint
	) where

import Control.Lens
import Data.Data
import Data.Data.Lens
import Data.Maybe (isJust)
import Data.Text (Text)
import Language.Haskell.Exts hiding (Name(..))
import qualified Language.Haskell.Exts as E (Name(..))
import Language.Haskell.Names

import HsDev.Symbols.Name
import HsDev.Symbols.Location (Position(..), positionLine, positionColumn, Region(..), region)

-- | Annotation of parsed and resolved nodes
type Ann = Scoped SrcSpanInfo

-- | Parsed and resolved module
type Parsed = Module Ann

-- | Get all qualified names
qnames :: Data (ast Ann) => Traversal' (ast Ann) (QName Ann)
qnames :: Traversal' (ast Ann) (QName Ann)
qnames = (QName Ann -> f (QName Ann)) -> ast Ann -> f (ast Ann)
forall s a. (Data s, Typeable a) => Traversal' s a
biplate

-- | Get all names
names :: Data (ast Ann) => Traversal' (ast Ann) (E.Name Ann)
names :: Traversal' (ast Ann) (Name Ann)
names = (Name Ann -> f (Name Ann)) -> ast Ann -> f (ast Ann)
forall s a. (Data s, Typeable a) => Traversal' s a
biplate

-- | Get all binders
binders :: Annotated ast => Traversal' (ast Ann) (ast Ann)
binders :: Traversal' (ast Ann) (ast Ann)
binders = (ast Ann -> Bool) -> Optic' (->) f (ast Ann) (ast Ann)
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered ast Ann -> Bool
forall (ast :: * -> *). Annotated ast => ast Ann -> Bool
isBinder

-- | Get all names locally defined
locals :: Annotated ast => Traversal' (ast Ann) (ast Ann)
locals :: Traversal' (ast Ann) (ast Ann)
locals = (ast Ann -> Bool) -> Optic' (->) f (ast Ann) (ast Ann)
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered ast Ann -> Bool
forall (ast :: * -> *). Annotated ast => ast Ann -> Bool
isLocal

-- | Get all names, references global symbol
globals :: Annotated ast => Traversal' (ast Ann) (ast Ann)
globals :: Traversal' (ast Ann) (ast Ann)
globals = (ast Ann -> Bool) -> Optic' (->) f (ast Ann) (ast Ann)
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered ast Ann -> Bool
forall (ast :: * -> *). Annotated ast => ast Ann -> Bool
isGlobal

-- | Get all resolved references
references :: Annotated ast => Traversal' (ast Ann) (ast Ann)
references :: Traversal' (ast Ann) (ast Ann)
references = (ast Ann -> Bool) -> Optic' (->) f (ast Ann) (ast Ann)
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered ast Ann -> Bool
forall (ast :: * -> *). Annotated ast => ast Ann -> Bool
isReference

-- | Get all names with not in scope error
unresolveds :: Annotated ast => Traversal' (ast Ann) (ast Ann)
unresolveds :: Traversal' (ast Ann) (ast Ann)
unresolveds = (ast Ann -> Bool) -> Optic' (->) f (ast Ann) (ast Ann)
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered ast Ann -> Bool
forall (ast :: * -> *). Annotated ast => ast Ann -> Bool
isUnresolved

-- | Get all usages of symbol
usages :: Annotated ast => Name -> Traversal' (ast Ann) (ast Ann)
usages :: Name -> Traversal' (ast Ann) (ast Ann)
usages = (ast Ann -> Bool) -> Optic' (->) f (ast Ann) (ast Ann)
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered ((ast Ann -> Bool) -> Optic' (->) f (ast Ann) (ast Ann))
-> (Name -> ast Ann -> Bool)
-> Name
-> Optic' (->) f (ast Ann) (ast Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> ast Ann -> Bool
forall (ast :: * -> *). Annotated ast => Name -> ast Ann -> Bool
refsTo

-- | Get usages of symbols with unqualified name
named :: Annotated ast => Text -> Traversal' (ast Ann) (ast Ann)
named :: Text -> Traversal' (ast Ann) (ast Ann)
named = (ast Ann -> Bool) -> Optic' (->) f (ast Ann) (ast Ann)
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered ((ast Ann -> Bool) -> Optic' (->) f (ast Ann) (ast Ann))
-> (Text -> ast Ann -> Bool)
-> Text
-> Optic' (->) f (ast Ann) (ast Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ast Ann -> Bool
forall (ast :: * -> *). Annotated ast => Text -> ast Ann -> Bool
refsToName

-- | Get imports
imports :: Data (ast Ann) => Traversal' (ast Ann) (ImportDecl Ann)
imports :: Traversal' (ast Ann) (ImportDecl Ann)
imports = (ImportDecl Ann -> f (ImportDecl Ann)) -> ast Ann -> f (ast Ann)
forall s a. (Data s, Typeable a) => Traversal' s a
biplate

-- | Get declarations
declarations :: Data (ast Ann) => Traversal' (ast Ann) (Decl Ann)
declarations :: Traversal' (ast Ann) (Decl Ann)
declarations = (Decl Ann -> f (Decl Ann)) -> ast Ann -> f (ast Ann)
forall s a. (Data s, Typeable a) => Traversal' s a
biplate

-- | Get module names
moduleNames :: Data (ast Ann) => Traversal' (ast Ann) (ModuleName Ann)
moduleNames :: Traversal' (ast Ann) (ModuleName Ann)
moduleNames = (ModuleName Ann -> f (ModuleName Ann)) -> ast Ann -> f (ast Ann)
forall s a. (Data s, Typeable a) => Traversal' s a
biplate

-- | Get annotation
annL :: Annotated ast => Lens' (ast a) a
annL :: Lens' (ast a) a
annL = (ast a -> a) -> (ast a -> a -> ast a) -> Lens' (ast a) a
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ast a -> a
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann (\ast a
v a
a' -> (a -> a) -> ast a -> ast a
forall (ast :: * -> *) l.
Annotated ast =>
(l -> l) -> ast l -> ast l
amap (a -> a -> a
forall a b. a -> b -> a
const a
a') ast a
v)

-- | Get haskell-names symbols
symbolL :: Data a => Traversal' a Symbol
symbolL :: Traversal' a Symbol
symbolL = (Symbol -> f Symbol) -> a -> f a
forall s a. (Data s, Typeable a) => Traversal' s a
biplate

-- | Get source file
file :: Annotated ast => Lens' (ast Ann) FilePath
file :: Lens' (ast Ann) FilePath
file = (Ann -> f Ann) -> ast Ann -> f (ast Ann)
forall (ast :: * -> *) a. Annotated ast => Lens' (ast a) a
annL ((Ann -> f Ann) -> ast Ann -> f (ast Ann))
-> ((FilePath -> f FilePath) -> Ann -> f Ann)
-> (FilePath -> f FilePath)
-> ast Ann
-> f (ast Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> f FilePath) -> Ann -> f Ann
forall isrc. (SrcInfo isrc, Data isrc) => Lens' isrc FilePath
fileL

-- | Get source location
pos :: (Annotated ast, SrcInfo isrc, Data isrc) => Lens' (ast isrc) Position
pos :: Lens' (ast isrc) Position
pos = (isrc -> f isrc) -> ast isrc -> f (ast isrc)
forall (ast :: * -> *) a. Annotated ast => Lens' (ast a) a
annL ((isrc -> f isrc) -> ast isrc -> f (ast isrc))
-> ((Position -> f Position) -> isrc -> f isrc)
-> (Position -> f Position)
-> ast isrc
-> f (ast isrc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position -> f Position) -> isrc -> f isrc
forall isrc. (SrcInfo isrc, Data isrc) => Lens' isrc Position
positionL

-- | Definition position, if binder - returns current position
defPos :: Annotated ast => Traversal' (ast Ann) Position
defPos :: Traversal' (ast Ann) Position
defPos = (Ann -> f Ann) -> ast Ann -> f (ast Ann)
forall (ast :: * -> *) a. Annotated ast => Lens' (ast a) a
annL ((Ann -> f Ann) -> ast Ann -> f (ast Ann))
-> ((Position -> f Position) -> Ann -> f Ann)
-> (Position -> f Position)
-> ast Ann
-> f (ast Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position -> f Position) -> Ann -> f Ann
Traversal' Ann Position
defLoc' where
	defLoc' :: Traversal' Ann Position
	defLoc' :: (Position -> f Position) -> Ann -> f Ann
defLoc' Position -> f Position
f (Scoped (LocalValue SrcLoc
s) SrcSpanInfo
i) = NameInfo SrcSpanInfo -> SrcSpanInfo -> Ann
forall l. NameInfo l -> l -> Scoped l
Scoped (NameInfo SrcSpanInfo -> SrcSpanInfo -> Ann)
-> f (NameInfo SrcSpanInfo) -> f (SrcSpanInfo -> Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SrcLoc -> NameInfo SrcSpanInfo
forall l. SrcLoc -> NameInfo l
LocalValue (SrcLoc -> NameInfo SrcSpanInfo)
-> f SrcLoc -> f (NameInfo SrcSpanInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Position -> f Position) -> SrcLoc -> f SrcLoc
forall isrc. (SrcInfo isrc, Data isrc) => Lens' isrc Position
positionL Position -> f Position
f SrcLoc
s) f (SrcSpanInfo -> Ann) -> f SrcSpanInfo -> f Ann
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcSpanInfo -> f SrcSpanInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcSpanInfo
i
	defLoc' Position -> f Position
f (Scoped (TypeVar SrcLoc
s) SrcSpanInfo
i) = NameInfo SrcSpanInfo -> SrcSpanInfo -> Ann
forall l. NameInfo l -> l -> Scoped l
Scoped (NameInfo SrcSpanInfo -> SrcSpanInfo -> Ann)
-> f (NameInfo SrcSpanInfo) -> f (SrcSpanInfo -> Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SrcLoc -> NameInfo SrcSpanInfo
forall l. SrcLoc -> NameInfo l
TypeVar (SrcLoc -> NameInfo SrcSpanInfo)
-> f SrcLoc -> f (NameInfo SrcSpanInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Position -> f Position) -> SrcLoc -> f SrcLoc
forall isrc. (SrcInfo isrc, Data isrc) => Lens' isrc Position
positionL Position -> f Position
f SrcLoc
s) f (SrcSpanInfo -> Ann) -> f SrcSpanInfo -> f Ann
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcSpanInfo -> f SrcSpanInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcSpanInfo
i
	defLoc' Position -> f Position
f (Scoped NameInfo SrcSpanInfo
ValueBinder SrcSpanInfo
i) = NameInfo SrcSpanInfo -> SrcSpanInfo -> Ann
forall l. NameInfo l -> l -> Scoped l
Scoped NameInfo SrcSpanInfo
forall l. NameInfo l
ValueBinder (SrcSpanInfo -> Ann) -> f SrcSpanInfo -> f Ann
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Position -> f Position) -> SrcSpanInfo -> f SrcSpanInfo
forall isrc. (SrcInfo isrc, Data isrc) => Lens' isrc Position
positionL Position -> f Position
f SrcSpanInfo
i
	defLoc' Position -> f Position
f (Scoped NameInfo SrcSpanInfo
TypeBinder SrcSpanInfo
i) = NameInfo SrcSpanInfo -> SrcSpanInfo -> Ann
forall l. NameInfo l -> l -> Scoped l
Scoped NameInfo SrcSpanInfo
forall l. NameInfo l
TypeBinder (SrcSpanInfo -> Ann) -> f SrcSpanInfo -> f Ann
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Position -> f Position) -> SrcSpanInfo -> f SrcSpanInfo
forall isrc. (SrcInfo isrc, Data isrc) => Lens' isrc Position
positionL Position -> f Position
f SrcSpanInfo
i
	defLoc' Position -> f Position
_ Ann
s = Ann -> f Ann
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ann
s

-- | Resolved global name
resolvedName :: Annotated ast => Traversal' (ast Ann) Name
resolvedName :: Traversal' (ast Ann) Name
resolvedName = (Ann -> f Ann) -> ast Ann -> f (ast Ann)
forall (ast :: * -> *) a. Annotated ast => Lens' (ast a) a
annL ((Ann -> f Ann) -> ast Ann -> f (ast Ann))
-> ((Name -> f Name) -> Ann -> f Ann)
-> (Name -> f Name)
-> ast Ann
-> f (ast Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NameInfo SrcSpanInfo -> f (NameInfo SrcSpanInfo)) -> Ann -> f Ann
forall a. Lens' (Scoped a) (NameInfo a)
nameInfoL ((NameInfo SrcSpanInfo -> f (NameInfo SrcSpanInfo))
 -> Ann -> f Ann)
-> ((Name -> f Name)
    -> NameInfo SrcSpanInfo -> f (NameInfo SrcSpanInfo))
-> (Name -> f Name)
-> Ann
-> f Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol -> f Symbol)
-> NameInfo SrcSpanInfo -> f (NameInfo SrcSpanInfo)
forall a. Data a => Traversal' a Symbol
symbolL ((Symbol -> f Symbol)
 -> NameInfo SrcSpanInfo -> f (NameInfo SrcSpanInfo))
-> ((Name -> f Name) -> Symbol -> f Symbol)
-> (Name -> f Name)
-> NameInfo SrcSpanInfo
-> f (NameInfo SrcSpanInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> f Name) -> Symbol -> f Symbol
Lens' Symbol Name
symbolNameL

-- | Does ast node binds something
isBinder :: Annotated ast => ast Ann -> Bool
isBinder :: ast Ann -> Bool
isBinder ast Ann
e = (ast Ann
e ast Ann
-> Getting (NameInfo SrcSpanInfo) (ast Ann) (NameInfo SrcSpanInfo)
-> NameInfo SrcSpanInfo
forall s a. s -> Getting a s a -> a
^. (Ann -> Const (NameInfo SrcSpanInfo) Ann)
-> ast Ann -> Const (NameInfo SrcSpanInfo) (ast Ann)
forall (ast :: * -> *) a. Annotated ast => Lens' (ast a) a
annL ((Ann -> Const (NameInfo SrcSpanInfo) Ann)
 -> ast Ann -> Const (NameInfo SrcSpanInfo) (ast Ann))
-> ((NameInfo SrcSpanInfo
     -> Const (NameInfo SrcSpanInfo) (NameInfo SrcSpanInfo))
    -> Ann -> Const (NameInfo SrcSpanInfo) Ann)
-> Getting (NameInfo SrcSpanInfo) (ast Ann) (NameInfo SrcSpanInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NameInfo SrcSpanInfo
 -> Const (NameInfo SrcSpanInfo) (NameInfo SrcSpanInfo))
-> Ann -> Const (NameInfo SrcSpanInfo) Ann
forall a. Lens' (Scoped a) (NameInfo a)
nameInfoL) NameInfo SrcSpanInfo -> [NameInfo SrcSpanInfo] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [NameInfo SrcSpanInfo
forall l. NameInfo l
TypeBinder, NameInfo SrcSpanInfo
forall l. NameInfo l
ValueBinder]

-- | Does ast node locally defined
isLocal :: Annotated ast => ast Ann -> Bool
isLocal :: ast Ann -> Bool
isLocal ast Ann
e = case ast Ann
e ast Ann
-> Getting (NameInfo SrcSpanInfo) (ast Ann) (NameInfo SrcSpanInfo)
-> NameInfo SrcSpanInfo
forall s a. s -> Getting a s a -> a
^. (Ann -> Const (NameInfo SrcSpanInfo) Ann)
-> ast Ann -> Const (NameInfo SrcSpanInfo) (ast Ann)
forall (ast :: * -> *) a. Annotated ast => Lens' (ast a) a
annL ((Ann -> Const (NameInfo SrcSpanInfo) Ann)
 -> ast Ann -> Const (NameInfo SrcSpanInfo) (ast Ann))
-> ((NameInfo SrcSpanInfo
     -> Const (NameInfo SrcSpanInfo) (NameInfo SrcSpanInfo))
    -> Ann -> Const (NameInfo SrcSpanInfo) Ann)
-> Getting (NameInfo SrcSpanInfo) (ast Ann) (NameInfo SrcSpanInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NameInfo SrcSpanInfo
 -> Const (NameInfo SrcSpanInfo) (NameInfo SrcSpanInfo))
-> Ann -> Const (NameInfo SrcSpanInfo) Ann
forall a. Lens' (Scoped a) (NameInfo a)
nameInfoL of
	LocalValue SrcLoc
_ -> Bool
True
	TypeVar SrcLoc
_ -> Bool
True
	NameInfo SrcSpanInfo
_ -> Bool
False

-- | Does ast node reference something
isGlobal :: Annotated ast => ast Ann -> Bool
isGlobal :: ast Ann -> Bool
isGlobal ast Ann
e = case ast Ann
e ast Ann
-> Getting (NameInfo SrcSpanInfo) (ast Ann) (NameInfo SrcSpanInfo)
-> NameInfo SrcSpanInfo
forall s a. s -> Getting a s a -> a
^. (Ann -> Const (NameInfo SrcSpanInfo) Ann)
-> ast Ann -> Const (NameInfo SrcSpanInfo) (ast Ann)
forall (ast :: * -> *) a. Annotated ast => Lens' (ast a) a
annL ((Ann -> Const (NameInfo SrcSpanInfo) Ann)
 -> ast Ann -> Const (NameInfo SrcSpanInfo) (ast Ann))
-> ((NameInfo SrcSpanInfo
     -> Const (NameInfo SrcSpanInfo) (NameInfo SrcSpanInfo))
    -> Ann -> Const (NameInfo SrcSpanInfo) Ann)
-> Getting (NameInfo SrcSpanInfo) (ast Ann) (NameInfo SrcSpanInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NameInfo SrcSpanInfo
 -> Const (NameInfo SrcSpanInfo) (NameInfo SrcSpanInfo))
-> Ann -> Const (NameInfo SrcSpanInfo) Ann
forall a. Lens' (Scoped a) (NameInfo a)
nameInfoL of
	GlobalSymbol Symbol
_ Name
_ -> Bool
True
	NameInfo SrcSpanInfo
_ -> Bool
False

-- | Does ast node reference something
isReference :: Annotated ast => ast Ann -> Bool
isReference :: ast Ann -> Bool
isReference ast Ann
e = ast Ann -> Bool
forall (ast :: * -> *). Annotated ast => ast Ann -> Bool
isLocal ast Ann
e Bool -> Bool -> Bool
|| ast Ann -> Bool
forall (ast :: * -> *). Annotated ast => ast Ann -> Bool
isGlobal ast Ann
e

-- | Is ast node not resolved
isUnresolved :: Annotated ast => ast Ann -> Bool
isUnresolved :: ast Ann -> Bool
isUnresolved = Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (Maybe FilePath -> Bool)
-> (ast Ann -> Maybe FilePath) -> ast Ann -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ast Ann -> Maybe FilePath
forall (ast :: * -> *). Annotated ast => ast Ann -> Maybe FilePath
resolveError

-- | Resolve error
resolveError :: Annotated ast => ast Ann -> Maybe String
resolveError :: ast Ann -> Maybe FilePath
resolveError ast Ann
e = case ast Ann
e ast Ann
-> Getting (NameInfo SrcSpanInfo) (ast Ann) (NameInfo SrcSpanInfo)
-> NameInfo SrcSpanInfo
forall s a. s -> Getting a s a -> a
^. (Ann -> Const (NameInfo SrcSpanInfo) Ann)
-> ast Ann -> Const (NameInfo SrcSpanInfo) (ast Ann)
forall (ast :: * -> *) a. Annotated ast => Lens' (ast a) a
annL ((Ann -> Const (NameInfo SrcSpanInfo) Ann)
 -> ast Ann -> Const (NameInfo SrcSpanInfo) (ast Ann))
-> ((NameInfo SrcSpanInfo
     -> Const (NameInfo SrcSpanInfo) (NameInfo SrcSpanInfo))
    -> Ann -> Const (NameInfo SrcSpanInfo) Ann)
-> Getting (NameInfo SrcSpanInfo) (ast Ann) (NameInfo SrcSpanInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NameInfo SrcSpanInfo
 -> Const (NameInfo SrcSpanInfo) (NameInfo SrcSpanInfo))
-> Ann -> Const (NameInfo SrcSpanInfo) Ann
forall a. Lens' (Scoped a) (NameInfo a)
nameInfoL of
	ScopeError Error SrcSpanInfo
err -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ Error SrcSpanInfo -> FilePath
forall l. SrcInfo l => Error l -> FilePath
ppError Error SrcSpanInfo
err
	NameInfo SrcSpanInfo
_ -> Maybe FilePath
forall a. Maybe a
Nothing

-- | Node references to specified symbol
refsTo :: Annotated ast => Name -> ast Ann -> Bool
refsTo :: Name -> ast Ann -> Bool
refsTo Name
n ast Ann
a = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n Maybe Name -> Maybe Name -> Bool
forall a. Eq a => a -> a -> Bool
== ast Ann
a ast Ann -> Getting (First Name) (ast Ann) Name -> Maybe Name
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First Name) (ast Ann) Name
forall (ast :: * -> *). Annotated ast => Traversal' (ast Ann) Name
resolvedName

-- | Node references to specified unqualified name
refsToName :: Annotated ast => Text -> ast Ann -> Bool
refsToName :: Text -> ast Ann -> Bool
refsToName Text
n ast Ann
a = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
n Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Name -> Text) -> Maybe Name -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> Text
nameIdent (ast Ann
a ast Ann -> Getting (First Name) (ast Ann) Name -> Maybe Name
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First Name) (ast Ann) Name
forall (ast :: * -> *). Annotated ast => Traversal' (ast Ann) Name
resolvedName)

nameInfoL :: Lens' (Scoped a) (NameInfo a)
nameInfoL :: (NameInfo a -> f (NameInfo a)) -> Scoped a -> f (Scoped a)
nameInfoL = (Scoped a -> NameInfo a)
-> (Scoped a -> NameInfo a -> Scoped a)
-> Lens (Scoped a) (Scoped a) (NameInfo a) (NameInfo a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Scoped a -> NameInfo a
forall l. Scoped l -> NameInfo l
g' Scoped a -> NameInfo a -> Scoped a
forall l. Scoped l -> NameInfo l -> Scoped l
s' where
	g' :: Scoped l -> NameInfo l
g' (Scoped NameInfo l
i l
_) = NameInfo l
i
	s' :: Scoped l -> NameInfo l -> Scoped l
s' (Scoped NameInfo l
_ l
s) NameInfo l
i' = NameInfo l -> l -> Scoped l
forall l. NameInfo l -> l -> Scoped l
Scoped NameInfo l
i' l
s

positionL :: (SrcInfo isrc, Data isrc) => Lens' isrc Position
positionL :: Lens' isrc Position
positionL = (isrc -> Position)
-> (isrc -> Position -> isrc) -> Lens' isrc Position
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens isrc -> Position
forall si. SrcInfo si => si -> Position
g' isrc -> Position -> isrc
forall si. (Data si, SrcInfo si) => si -> Position -> si
s' where
	g' :: si -> Position
g' si
i = Int -> Int -> Position
Position Int
l Int
c where
		SrcLoc FilePath
_ Int
l Int
c = si -> SrcLoc
forall si. SrcInfo si => si -> SrcLoc
getPointLoc si
i
	s' :: si -> Position -> si
s' si
i (Position Int
l Int
c) = ASetter si si SrcLoc SrcLoc -> (SrcLoc -> SrcLoc) -> si -> si
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter si si SrcLoc SrcLoc
forall s a. (Data s, Typeable a) => Traversal' s a
biplate SrcLoc -> SrcLoc
upd si
i where
		Position Int
sl Int
sc = si -> Position
forall si. SrcInfo si => si -> Position
g' si
i -- Old location
		-- main line: set new line and move column
		-- other lines: just move line, because altering first line's column doesn't affect other lines
		upd :: SrcLoc -> SrcLoc
		upd :: SrcLoc -> SrcLoc
upd (SrcLoc FilePath
f' Int
l' Int
c')
			| Int
l' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sl = FilePath -> Int -> Int -> SrcLoc
SrcLoc FilePath
f' Int
l (Int
c' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c)
			| Bool
otherwise = FilePath -> Int -> Int -> SrcLoc
SrcLoc FilePath
f' (Int
l' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l) Int
c'

regionL :: Annotated ast => Lens' (ast Ann) Region
regionL :: Lens' (ast Ann) Region
regionL = (ast Ann -> Region)
-> (ast Ann -> Region -> ast Ann) -> Lens' (ast Ann) Region
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ast Ann -> Region
forall (ast :: * -> *). Annotated ast => ast Ann -> Region
g' ast Ann -> Region -> ast Ann
forall (ast :: * -> *) (f :: * -> *).
(Annotated ast, Functor f) =>
ast (f SrcSpanInfo) -> Region -> ast (f SrcSpanInfo)
s' where
	g' :: ast Ann -> Region
g' ast Ann
i = case ast Ann -> Ann
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann ast Ann
i of
		Scoped NameInfo SrcSpanInfo
_ SrcSpanInfo
sinfo -> (Int, Int) -> Position
toPos (SrcSpan -> (Int, Int)
srcSpanStart SrcSpan
span') Position -> Position -> Region
`region` (Int, Int) -> Position
toPos (SrcSpan -> (Int, Int)
srcSpanEnd SrcSpan
span') where
			span' :: SrcSpan
span' = SrcSpanInfo -> SrcSpan
srcInfoSpan SrcSpanInfo
sinfo
			toPos :: (Int, Int) -> Position
toPos = (Int -> Int -> Position) -> (Int, Int) -> Position
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Position
Position
	s' :: ast (f SrcSpanInfo) -> Region -> ast (f SrcSpanInfo)
s' ast (f SrcSpanInfo)
i (Region Position
s Position
e) = (f SrcSpanInfo -> f SrcSpanInfo)
-> ast (f SrcSpanInfo) -> ast (f SrcSpanInfo)
forall (ast :: * -> *) l.
Annotated ast =>
(l -> l) -> ast l -> ast l
amap ((SrcSpanInfo -> SrcSpanInfo) -> f SrcSpanInfo -> f SrcSpanInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SrcSpanInfo -> SrcSpanInfo
upd) ast (f SrcSpanInfo)
i where
		upd :: SrcSpanInfo -> SrcSpanInfo
		upd :: SrcSpanInfo -> SrcSpanInfo
upd SrcSpanInfo
sinfo = SrcSpanInfo
sinfo {
			srcInfoSpan :: SrcSpan
srcInfoSpan = (SrcSpanInfo -> SrcSpan
srcInfoSpan SrcSpanInfo
sinfo) {
				srcSpanStartLine :: Int
srcSpanStartLine = Position
s Position -> Getting Int Position Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Position Int
Lens' Position Int
positionLine,
				srcSpanStartColumn :: Int
srcSpanStartColumn = Position
s Position -> Getting Int Position Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Position Int
Lens' Position Int
positionColumn,
				srcSpanEndLine :: Int
srcSpanEndLine = Position
e Position -> Getting Int Position Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Position Int
Lens' Position Int
positionLine,
				srcSpanEndColumn :: Int
srcSpanEndColumn = Position
e Position -> Getting Int Position Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Position Int
Lens' Position Int
positionColumn },
			srcInfoPoints :: [SrcSpan]
srcInfoPoints = [] }

fileL :: (SrcInfo isrc, Data isrc) => Lens' isrc FilePath
fileL :: Lens' isrc FilePath
fileL = (isrc -> FilePath)
-> (isrc -> FilePath -> isrc) -> Lens' isrc FilePath
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens isrc -> FilePath
g' isrc -> FilePath -> isrc
forall t a. (Data t, Typeable a) => t -> a -> t
s' where
	g' :: isrc -> FilePath
g' = isrc -> FilePath
forall si. SrcInfo si => si -> FilePath
fileName
	s' :: t -> a -> t
s' t
i a
f = ASetter t t a a -> a -> t -> t
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter t t a a
forall s a. (Data s, Typeable a) => Traversal' s a
biplate a
f t
i

-- | Get 'Symbol' as 'Name'
symbolNameL :: Lens' Symbol Name
symbolNameL :: (Name -> f Name) -> Symbol -> f Symbol
symbolNameL = (Symbol -> Name) -> (Symbol -> Name -> Symbol) -> Lens' Symbol Name
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Symbol -> Name
g' Symbol -> Name -> Symbol
s' where
	g' :: Symbol -> Name
g' Symbol
sym' = () -> ModuleName () -> Name () -> Name
forall l. l -> ModuleName l -> Name l -> QName l
Qual () (Symbol -> ModuleName ()
symbolModule Symbol
sym') (Symbol -> Name ()
symbolName Symbol
sym')
	s' :: Symbol -> Name -> Symbol
s' Symbol
sym' (Qual ()
_ ModuleName ()
m Name ()
n) = Symbol
sym' { symbolModule :: ModuleName ()
symbolModule = ModuleName ()
m, symbolName :: Name ()
symbolName = Name ()
n }
	s' Symbol
sym' (UnQual ()
_ Name ()
n) = Symbol
sym' { symbolName :: Name ()
symbolName = Name ()
n }
	s' Symbol
sym' Name
_ = Symbol
sym'