{-# LANGUAGE CPP #-}

module HsDev.Inspect.Definitions (
	getSymbols,
	getDecl
	) where

import Control.Lens
import Control.Monad
import Data.Data (Data)
import Data.Generics.Uniplate.Data
import Data.List
import Data.Maybe
import Data.Function
import Data.Ord
import Data.String
import Data.Text (Text)
import qualified Language.Haskell.Exts as H

import HsDev.Symbols.Types
import HsDev.Symbols.Parsed
import HsDev.Symbols.Resolve (symbolUniqId)

-- | Get top symbols
getSymbols :: [H.Decl Ann] -> [Symbol]
getSymbols :: [Decl Ann] -> [Symbol]
getSymbols [Decl Ann]
decls =
	([Symbol] -> Symbol) -> [[Symbol]] -> [Symbol]
forall a b. (a -> b) -> [a] -> [b]
map [Symbol] -> Symbol
mergeSymbols ([[Symbol]] -> [Symbol])
-> ([Symbol] -> [[Symbol]]) -> [Symbol] -> [Symbol]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	(Symbol -> Symbol -> Bool) -> [Symbol] -> [[Symbol]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy ((Text, Text, SymbolInfo) -> (Text, Text, SymbolInfo) -> Bool
forall a. Eq a => a -> a -> Bool
(==) ((Text, Text, SymbolInfo) -> (Text, Text, SymbolInfo) -> Bool)
-> (Symbol -> (Text, Text, SymbolInfo)) -> Symbol -> Symbol -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Symbol -> (Text, Text, SymbolInfo)
symbolUniqId) ([Symbol] -> [[Symbol]])
-> ([Symbol] -> [Symbol]) -> [Symbol] -> [[Symbol]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	(Symbol -> Symbol -> Ordering) -> [Symbol] -> [Symbol]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Symbol -> (Text, Text, SymbolInfo))
-> Symbol -> Symbol -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Symbol -> (Text, Text, SymbolInfo)
symbolUniqId) ([Symbol] -> [Symbol]) -> [Symbol] -> [Symbol]
forall a b. (a -> b) -> a -> b
$
	(Decl Ann -> [Symbol]) -> [Decl Ann] -> [Symbol]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Decl Ann -> [Symbol]
getDecl [Decl Ann]
decls
	where
		mergeSymbols :: [Symbol] -> Symbol
		mergeSymbols :: [Symbol] -> Symbol
mergeSymbols [] = [Char] -> Symbol
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"
		mergeSymbols [Symbol
s] = Symbol
s
		mergeSymbols ss :: [Symbol]
ss@(Symbol
s:[Symbol]
_) = SymbolId -> Maybe Text -> Maybe Position -> SymbolInfo -> Symbol
Symbol
			(Getting SymbolId Symbol SymbolId -> Symbol -> SymbolId
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting SymbolId Symbol SymbolId
Lens' Symbol SymbolId
symbolId Symbol
s)
			([Maybe Text] -> Maybe Text
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe Text] -> Maybe Text) -> [Maybe Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Symbol -> Maybe Text) -> [Symbol] -> [Maybe Text]
forall a b. (a -> b) -> [a] -> [b]
map (Getting (Maybe Text) Symbol (Maybe Text) -> Symbol -> Maybe Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Text) Symbol (Maybe Text)
Lens' Symbol (Maybe Text)
symbolDocs) [Symbol]
ss)
			([Maybe Position] -> Maybe Position
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe Position] -> Maybe Position)
-> [Maybe Position] -> Maybe Position
forall a b. (a -> b) -> a -> b
$ (Symbol -> Maybe Position) -> [Symbol] -> [Maybe Position]
forall a b. (a -> b) -> [a] -> [b]
map (Getting (Maybe Position) Symbol (Maybe Position)
-> Symbol -> Maybe Position
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Position) Symbol (Maybe Position)
Lens' Symbol (Maybe Position)
symbolPosition) [Symbol]
ss)
			((SymbolInfo -> SymbolInfo -> SymbolInfo)
-> [SymbolInfo] -> SymbolInfo
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 SymbolInfo -> SymbolInfo -> SymbolInfo
mergeInfo ([SymbolInfo] -> SymbolInfo) -> [SymbolInfo] -> SymbolInfo
forall a b. (a -> b) -> a -> b
$ (Symbol -> SymbolInfo) -> [Symbol] -> [SymbolInfo]
forall a b. (a -> b) -> [a] -> [b]
map (Getting SymbolInfo Symbol SymbolInfo -> Symbol -> SymbolInfo
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting SymbolInfo Symbol SymbolInfo
Lens' Symbol SymbolInfo
symbolInfo) [Symbol]
ss)

		mergeInfo :: SymbolInfo -> SymbolInfo -> SymbolInfo
		mergeInfo :: SymbolInfo -> SymbolInfo -> SymbolInfo
mergeInfo (Function Maybe Text
lt) (Function Maybe Text
rt) = Maybe Text -> SymbolInfo
Function (Maybe Text -> SymbolInfo) -> Maybe Text -> SymbolInfo
forall a b. (a -> b) -> a -> b
$ Maybe Text
lt Maybe Text -> Maybe Text -> Maybe Text
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe Text
rt
		mergeInfo (PatConstructor [Text]
las Maybe Text
lt) (PatConstructor [Text]
ras Maybe Text
rt) = [Text] -> Maybe Text -> SymbolInfo
PatConstructor (if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
las then [Text]
ras else [Text]
las) (Maybe Text
lt Maybe Text -> Maybe Text -> Maybe Text
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe Text
rt)
		mergeInfo (Selector Maybe Text
lt Text
lp [Text]
lc) (Selector Maybe Text
rt Text
rp [Text]
rc)
			| Maybe Text
lt Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Text
rt Bool -> Bool -> Bool
&& Text
lp Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
rp = Maybe Text -> Text -> [Text] -> SymbolInfo
Selector Maybe Text
lt Text
lp ([Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
lc [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
rc)
			| Bool
otherwise = Maybe Text -> Text -> [Text] -> SymbolInfo
Selector Maybe Text
lt Text
lp [Text]
lc
		mergeInfo SymbolInfo
l SymbolInfo
_ = SymbolInfo
l

-- | Get symbols from declarations
getDecl :: H.Decl Ann -> [Symbol]
getDecl :: Decl Ann -> [Symbol]
getDecl Decl Ann
decl' = case Decl Ann
decl' of
	H.TypeDecl Ann
_ DeclHead Ann
h Type Ann
_ -> [Name Ann -> SymbolInfo -> Symbol
mkSymbol (DeclHead Ann -> Name Ann
tyName DeclHead Ann
h) ([Text] -> [Text] -> SymbolInfo
Type (DeclHead Ann -> [Text]
forall (ast :: * -> *). Data (ast Ann) => ast Ann -> [Text]
tyArgs DeclHead Ann
h) [])]
	H.TypeFamDecl Ann
_ DeclHead Ann
h Maybe (ResultSig Ann)
_ Maybe (InjectivityInfo Ann)
_ -> [Name Ann -> SymbolInfo -> Symbol
mkSymbol (DeclHead Ann -> Name Ann
tyName DeclHead Ann
h) ([Text] -> [Text] -> Maybe Text -> SymbolInfo
TypeFam (DeclHead Ann -> [Text]
forall (ast :: * -> *). Data (ast Ann) => ast Ann -> [Text]
tyArgs DeclHead Ann
h) [] Maybe Text
forall a. Maybe a
Nothing)]
	H.ClosedTypeFamDecl Ann
_ DeclHead Ann
h Maybe (ResultSig Ann)
_ Maybe (InjectivityInfo Ann)
_ [TypeEqn Ann]
_ -> [Name Ann -> SymbolInfo -> Symbol
mkSymbol (DeclHead Ann -> Name Ann
tyName DeclHead Ann
h) ([Text] -> [Text] -> Maybe Text -> SymbolInfo
TypeFam (DeclHead Ann -> [Text]
forall (ast :: * -> *). Data (ast Ann) => ast Ann -> [Text]
tyArgs DeclHead Ann
h) [] Maybe Text
forall a. Maybe a
Nothing)]
	H.DataDecl Ann
_ DataOrNew Ann
dt Maybe (Context Ann)
mctx DeclHead Ann
h [QualConDecl Ann]
dcons [Deriving Ann]
_ -> Name Ann -> SymbolInfo -> Symbol
mkSymbol Name Ann
nm ((DataOrNew Ann -> [Text] -> [Text] -> SymbolInfo
forall l. DataOrNew l -> [Text] -> [Text] -> SymbolInfo
getCtor DataOrNew Ann
dt) (DeclHead Ann -> [Text]
forall (ast :: * -> *). Data (ast Ann) => ast Ann -> [Text]
tyArgs DeclHead Ann
h) (Maybe (Context Ann) -> [Text]
getCtx Maybe (Context Ann)
mctx)) Symbol -> [Symbol] -> [Symbol]
forall a. a -> [a] -> [a]
: (QualConDecl Ann -> [Symbol]) -> [QualConDecl Ann] -> [Symbol]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Name Ann -> QualConDecl Ann -> [Symbol]
getConDecl Name Ann
nm) [QualConDecl Ann]
dcons where
		nm :: Name Ann
nm = DeclHead Ann -> Name Ann
tyName DeclHead Ann
h
	H.GDataDecl Ann
_ DataOrNew Ann
dt Maybe (Context Ann)
mctx DeclHead Ann
h Maybe (Type Ann)
_ [GadtDecl Ann]
gcons [Deriving Ann]
_ -> Name Ann -> SymbolInfo -> Symbol
mkSymbol Name Ann
nm ((DataOrNew Ann -> [Text] -> [Text] -> SymbolInfo
forall l. DataOrNew l -> [Text] -> [Text] -> SymbolInfo
getCtor DataOrNew Ann
dt) (DeclHead Ann -> [Text]
forall (ast :: * -> *). Data (ast Ann) => ast Ann -> [Text]
tyArgs DeclHead Ann
h) (Maybe (Context Ann) -> [Text]
getCtx Maybe (Context Ann)
mctx)) Symbol -> [Symbol] -> [Symbol]
forall a. a -> [a] -> [a]
: (GadtDecl Ann -> [Symbol]) -> [GadtDecl Ann] -> [Symbol]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Name Ann -> GadtDecl Ann -> [Symbol]
getGConDecl Name Ann
nm) [GadtDecl Ann]
gcons where
		nm :: Name Ann
nm = DeclHead Ann -> Name Ann
tyName DeclHead Ann
h
	H.DataFamDecl Ann
_ Maybe (Context Ann)
mctx DeclHead Ann
h Maybe (ResultSig Ann)
_ -> [Name Ann -> SymbolInfo -> Symbol
mkSymbol (DeclHead Ann -> Name Ann
tyName DeclHead Ann
h) ([Text] -> [Text] -> Maybe Text -> SymbolInfo
DataFam (DeclHead Ann -> [Text]
forall (ast :: * -> *). Data (ast Ann) => ast Ann -> [Text]
tyArgs DeclHead Ann
h) (Maybe (Context Ann) -> [Text]
getCtx Maybe (Context Ann)
mctx) Maybe Text
forall a. Maybe a
Nothing)]
	H.ClassDecl Ann
_ Maybe (Context Ann)
mctx DeclHead Ann
h [FunDep Ann]
_ Maybe [ClassDecl Ann]
clsDecls -> Name Ann -> SymbolInfo -> Symbol
mkSymbol Name Ann
nm ([Text] -> [Text] -> SymbolInfo
Class (DeclHead Ann -> [Text]
forall (ast :: * -> *). Data (ast Ann) => ast Ann -> [Text]
tyArgs DeclHead Ann
h) (Maybe (Context Ann) -> [Text]
getCtx Maybe (Context Ann)
mctx)) Symbol -> [Symbol] -> [Symbol]
forall a. a -> [a] -> [a]
: (ClassDecl Ann -> [Symbol]) -> [ClassDecl Ann] -> [Symbol]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Name Ann -> ClassDecl Ann -> [Symbol]
getClassDecl Name Ann
nm) ([ClassDecl Ann] -> Maybe [ClassDecl Ann] -> [ClassDecl Ann]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [ClassDecl Ann]
clsDecls) where
		nm :: Name Ann
nm = DeclHead Ann -> Name Ann
tyName DeclHead Ann
h
	H.TypeSig Ann
_ [Name Ann]
ns Type Ann
tsig -> [Name Ann -> SymbolInfo -> Symbol
mkSymbol Name Ann
n (Maybe Text -> SymbolInfo
Function (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Type Ann -> Text
forall a s. (Pretty a, IsString s) => a -> s
oneLinePrint Type Ann
tsig)) | Name Ann
n <- [Name Ann]
ns]
#if MIN_VERSION_haskell_src_exts(1,21,0)
	H.PatSynSig Ann
_ [Name Ann]
ns Maybe [TyVarBind Ann]
mas Maybe (Context Ann)
_ Maybe [TyVarBind Ann]
_ Maybe (Context Ann)
_ Type Ann
t ->
#else
	H.PatSynSig _ ns mas _ _ t ->
#endif
		[Name Ann -> SymbolInfo -> Symbol
mkSymbol Name Ann
n ([Text] -> Maybe Text -> SymbolInfo
PatConstructor ([Text]
-> ([TyVarBind Ann] -> [Text]) -> Maybe [TyVarBind Ann] -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((TyVarBind Ann -> Text) -> [TyVarBind Ann] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBind Ann -> Text
forall a. Pretty a => a -> Text
prp) Maybe [TyVarBind Ann]
mas) (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Type Ann -> Text
forall a s. (Pretty a, IsString s) => a -> s
oneLinePrint Type Ann
t)) | Name Ann
n <- [Name Ann]
ns'] where
#if MIN_VERSION_haskell_src_exts(1,20,0)
			ns' :: [Name Ann]
ns' = [Name Ann]
ns
#else
			ns' = [ns]
#endif
	H.FunBind Ann
_ [Match Ann]
ms -> [Name Ann -> SymbolInfo -> Symbol
mkSymbol (Match Ann -> Name Ann
forall l. Match l -> Name l
matchName Match Ann
m) (Maybe Text -> SymbolInfo
Function Maybe Text
forall a. Maybe a
Nothing) | Match Ann
m <- [Match Ann]
ms] where
		matchName :: Match l -> Name l
matchName (H.Match l
_ Name l
n [Pat l]
_ Rhs l
_ Maybe (Binds l)
_) = Name l
n
		matchName (H.InfixMatch l
_ Pat l
_ Name l
n [Pat l]
_ Rhs l
_ Maybe (Binds l)
_) = Name l
n
	H.PatBind Ann
_ Pat Ann
p Rhs Ann
_ Maybe (Binds Ann)
_ -> [Name Ann -> SymbolInfo -> Symbol
mkSymbol Name Ann
n (Maybe Text -> SymbolInfo
Function Maybe Text
forall a. Maybe a
Nothing) | Name Ann
n <- Pat Ann -> [Name Ann]
patNames Pat Ann
p] where
		patNames :: H.Pat Ann -> [H.Name Ann]
		patNames :: Pat Ann -> [Name Ann]
patNames = Pat Ann -> [Name Ann]
forall from to. Biplate from to => from -> [to]
childrenBi
	H.PatSyn Ann
_ Pat Ann
p Pat Ann
_ PatternSynDirection Ann
_ -> case Pat Ann
p of
		H.PInfixApp Ann
_ Pat Ann
_ QName Ann
qn Pat Ann
_ -> [Name Ann -> SymbolInfo -> Symbol
mkSymbol (QName Ann -> Name Ann
forall l. QName l -> Name l
qToName QName Ann
qn) ([Text] -> Maybe Text -> SymbolInfo
PatConstructor [] Maybe Text
forall a. Maybe a
Nothing)]
		H.PApp Ann
_ QName Ann
qn [Pat Ann]
_ -> [Name Ann -> SymbolInfo -> Symbol
mkSymbol (QName Ann -> Name Ann
forall l. QName l -> Name l
qToName QName Ann
qn) ([Text] -> Maybe Text -> SymbolInfo
PatConstructor [] Maybe Text
forall a. Maybe a
Nothing)]
		H.PRec Ann
_ QName Ann
qn [PatField Ann]
fs -> Name Ann -> SymbolInfo -> Symbol
mkSymbol (QName Ann -> Name Ann
forall l. QName l -> Name l
qToName QName Ann
qn) ([Text] -> Maybe Text -> SymbolInfo
PatConstructor [] Maybe Text
forall a. Maybe a
Nothing) Symbol -> [Symbol] -> [Symbol]
forall a. a -> [a] -> [a]
:
			[Name Ann -> SymbolInfo -> Symbol
mkSymbol (QName Ann -> Name Ann
forall l. QName l -> Name l
qToName QName Ann
n) (Maybe Text -> Maybe Text -> Text -> SymbolInfo
PatSelector Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing (Name Ann -> Text
forall a. Pretty a => a -> Text
prp (Name Ann -> Text) -> Name Ann -> Text
forall a b. (a -> b) -> a -> b
$ QName Ann -> Name Ann
forall l. QName l -> Name l
qToName QName Ann
qn)) | QName Ann
n <- ([PatField Ann] -> [QName Ann]
forall from to. Biplate from to => from -> [to]
universeBi [PatField Ann]
fs :: [H.QName Ann])]
		Pat Ann
_ -> []
		where
			qToName :: QName l -> Name l
qToName (H.Qual l
_ ModuleName l
_ Name l
n) = Name l
n
			qToName (H.UnQual l
_ Name l
n) = Name l
n
			qToName QName l
_ = [Char] -> Name l
forall a. HasCallStack => [Char] -> a
error [Char]
"invalid qname"
	Decl Ann
_ -> []
	where
		tyName :: H.DeclHead Ann -> H.Name Ann
		tyName :: DeclHead Ann -> Name Ann
tyName = [Name Ann] -> Name Ann
forall a. [a] -> a
head ([Name Ann] -> Name Ann)
-> (DeclHead Ann -> [Name Ann]) -> DeclHead Ann -> Name Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeclHead Ann -> [Name Ann]
forall from to. Biplate from to => from -> [to]
universeBi
		tyArgs :: Data (ast Ann) => ast Ann -> [Text]
		tyArgs :: ast Ann -> [Text]
tyArgs ast Ann
n = (TyVarBind Ann -> Text) -> [TyVarBind Ann] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBind Ann -> Text
forall a. Pretty a => a -> Text
prp (ast Ann -> [TyVarBind Ann]
forall from to. Biplate from to => from -> [to]
universeBi ast Ann
n :: [H.TyVarBind Ann])
		getCtx :: Maybe (H.Context Ann) -> [Text]
		getCtx :: Maybe (Context Ann) -> [Text]
getCtx Maybe (Context Ann)
mctx = (Asst Ann -> Text) -> [Asst Ann] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Asst Ann -> Text
forall a. Pretty a => a -> Text
prp (Maybe (Context Ann) -> [Asst Ann]
forall from to. Biplate from to => from -> [to]
universeBi Maybe (Context Ann)
mctx :: [H.Asst Ann])
		getCtor :: DataOrNew l -> [Text] -> [Text] -> SymbolInfo
getCtor (H.DataType l
_) = [Text] -> [Text] -> SymbolInfo
Data
		getCtor (H.NewType l
_) = [Text] -> [Text] -> SymbolInfo
NewType

getConDecl :: H.Name Ann -> H.QualConDecl Ann -> [Symbol]
getConDecl :: Name Ann -> QualConDecl Ann -> [Symbol]
getConDecl Name Ann
ptype (H.QualConDecl Ann
_ Maybe [TyVarBind Ann]
_ Maybe (Context Ann)
_ ConDecl Ann
cdecl) = case ConDecl Ann
cdecl of
	H.ConDecl Ann
_ Name Ann
n [Type Ann]
ts -> [Name Ann -> SymbolInfo -> Symbol
mkSymbol Name Ann
n ([Text] -> Text -> SymbolInfo
Constructor ((Type Ann -> Text) -> [Type Ann] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Type Ann -> Text
forall a. Pretty a => a -> Text
prp [Type Ann]
ts) (Name Ann -> Text
forall a. Pretty a => a -> Text
prp Name Ann
ptype))]
	H.InfixConDecl Ann
_ Type Ann
lt Name Ann
n Type Ann
rt -> [Name Ann -> SymbolInfo -> Symbol
mkSymbol Name Ann
n ([Text] -> Text -> SymbolInfo
Constructor ((Type Ann -> Text) -> [Type Ann] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Type Ann -> Text
forall a. Pretty a => a -> Text
prp [Type Ann
lt, Type Ann
rt]) (Name Ann -> Text
forall a. Pretty a => a -> Text
prp Name Ann
ptype))]
	H.RecDecl Ann
_ Name Ann
n [FieldDecl Ann]
fs -> Name Ann -> SymbolInfo -> Symbol
mkSymbol Name Ann
n ([Text] -> Text -> SymbolInfo
Constructor [Type Ann -> Text
forall a. Pretty a => a -> Text
prp Type Ann
t | H.FieldDecl Ann
_ [Name Ann]
_ Type Ann
t <- [FieldDecl Ann]
fs] (Name Ann -> Text
forall a. Pretty a => a -> Text
prp Name Ann
ptype)) Symbol -> [Symbol] -> [Symbol]
forall a. a -> [a] -> [a]
:
		[Name Ann -> SymbolInfo -> Symbol
mkSymbol Name Ann
fn (Maybe Text -> Text -> [Text] -> SymbolInfo
Selector (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Type Ann -> Text
forall a. Pretty a => a -> Text
prp Type Ann
ft) (Name Ann -> Text
forall a. Pretty a => a -> Text
prp Name Ann
ptype) [Name Ann -> Text
forall a. Pretty a => a -> Text
prp Name Ann
n]) | H.FieldDecl Ann
_ [Name Ann]
fns Type Ann
ft <- [FieldDecl Ann]
fs, Name Ann
fn <- [Name Ann]
fns]

getGConDecl :: H.Name Ann -> H.GadtDecl Ann -> [Symbol]
#if MIN_VERSION_haskell_src_exts(1,21,0)
getGConDecl :: Name Ann -> GadtDecl Ann -> [Symbol]
getGConDecl Name Ann
_ (H.GadtDecl Ann
_ Name Ann
n Maybe [TyVarBind Ann]
_ Maybe (Context Ann)
_ Maybe [FieldDecl Ann]
Nothing Type Ann
t) =
#else
getGConDecl _ (H.GadtDecl _ n Nothing t) =
#endif
	[Name Ann -> SymbolInfo -> Symbol
mkSymbol Name Ann
n ([Text] -> Text -> SymbolInfo
Constructor ((Type Ann -> Text) -> [Type Ann] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Type Ann -> Text
forall a. Pretty a => a -> Text
prp [Type Ann]
as) (Type Ann -> Text
forall a. Pretty a => a -> Text
prp Type Ann
res))] where
		([Type Ann]
as, Type Ann
res) = Type Ann -> ([Type Ann], Type Ann)
forall l. Type l -> ([Type l], Type l)
tyFunSplit Type Ann
t
		tyFunSplit :: Type l -> ([Type l], Type l)
tyFunSplit = [Type l] -> Type l -> ([Type l], Type l)
forall l. [Type l] -> Type l -> ([Type l], Type l)
go [] where
			go :: [Type l] -> Type l -> ([Type l], Type l)
go [Type l]
as' (H.TyFun l
_ Type l
arg' Type l
res') = [Type l] -> Type l -> ([Type l], Type l)
go (Type l
arg' Type l -> [Type l] -> [Type l]
forall a. a -> [a] -> [a]
: [Type l]
as') Type l
res'
			go [Type l]
as' Type l
t' = ([Type l] -> [Type l]
forall a. [a] -> [a]
reverse [Type l]
as', Type l
t')
#if MIN_VERSION_haskell_src_exts(1,21,0)
getGConDecl Name Ann
ptype (H.GadtDecl Ann
_ Name Ann
n Maybe [TyVarBind Ann]
_ Maybe (Context Ann)
_ (Just [FieldDecl Ann]
fs) Type Ann
t) =
#else
getGConDecl ptype (H.GadtDecl _ n (Just fs) t) =
#endif
	Name Ann -> SymbolInfo -> Symbol
mkSymbol Name Ann
n ([Text] -> Text -> SymbolInfo
Constructor [Type Ann -> Text
forall a. Pretty a => a -> Text
prp Type Ann
ft | H.FieldDecl Ann
_ [Name Ann]
_ Type Ann
ft <- [FieldDecl Ann]
fs] (Type Ann -> Text
forall a. Pretty a => a -> Text
prp Type Ann
t)) Symbol -> [Symbol] -> [Symbol]
forall a. a -> [a] -> [a]
:
		[Name Ann -> SymbolInfo -> Symbol
mkSymbol Name Ann
fn (Maybe Text -> Text -> [Text] -> SymbolInfo
Selector (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Type Ann -> Text
forall a. Pretty a => a -> Text
prp Type Ann
ft) (Name Ann -> Text
forall a. Pretty a => a -> Text
prp Name Ann
ptype) [Name Ann -> Text
forall a. Pretty a => a -> Text
prp Name Ann
n]) | H.FieldDecl Ann
_ [Name Ann]
fns Type Ann
ft <- [FieldDecl Ann]
fs, Name Ann
fn <- [Name Ann]
fns]

getClassDecl :: H.Name Ann -> H.ClassDecl Ann -> [Symbol]
getClassDecl :: Name Ann -> ClassDecl Ann -> [Symbol]
getClassDecl Name Ann
pclass (H.ClsDecl Ann
_ (H.TypeSig Ann
_ [Name Ann]
ns Type Ann
tsig)) = [Name Ann -> SymbolInfo -> Symbol
mkSymbol Name Ann
n (Maybe Text -> Text -> SymbolInfo
Method (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Type Ann -> Text
forall a s. (Pretty a, IsString s) => a -> s
oneLinePrint Type Ann
tsig) (Name Ann -> Text
forall a. Pretty a => a -> Text
prp Name Ann
pclass)) | Name Ann
n <- [Name Ann]
ns]
getClassDecl Name Ann
_ ClassDecl Ann
_ = []

prp :: H.Pretty a => a -> Text
prp :: a -> Text
prp = [Char] -> Text
forall a. IsString a => [Char] -> a
fromString ([Char] -> Text) -> (a -> [Char]) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Pretty a => a -> [Char]
H.prettyPrint


mkSymbol :: H.Name Ann -> SymbolInfo -> Symbol
mkSymbol :: Name Ann -> SymbolInfo -> Symbol
mkSymbol Name Ann
nm = SymbolId -> Maybe Text -> Maybe Position -> SymbolInfo -> Symbol
Symbol (Text -> ModuleId -> SymbolId
SymbolId (Name () -> Text
fromName_ (Name () -> Text) -> Name () -> Text
forall a b. (a -> b) -> a -> b
$ Name Ann -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name Ann
nm) (Text -> ModuleLocation -> ModuleId
ModuleId ([Char] -> Text
forall a. IsString a => [Char] -> a
fromString [Char]
"") ModuleLocation
noLocation)) Maybe Text
forall a. Maybe a
Nothing (Name Ann
nm Name Ann
-> Getting (First Position) (Name Ann) Position -> Maybe Position
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Name Ann -> Const (First Position) (Name Ann))
-> Name Ann -> Const (First Position) (Name Ann)
forall (ast :: * -> *).
Annotated ast =>
Traversal' (ast Ann) (ast Ann)
binders ((Name Ann -> Const (First Position) (Name Ann))
 -> Name Ann -> Const (First Position) (Name Ann))
-> Getting (First Position) (Name Ann) Position
-> Getting (First Position) (Name Ann) Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Position) (Name Ann) Position
forall (ast :: * -> *).
Annotated ast =>
Traversal' (ast Ann) Position
defPos)


-- | Print something in one line
oneLinePrint :: (H.Pretty a, IsString s) => a -> s
oneLinePrint :: a -> s
oneLinePrint = [Char] -> s
forall a. IsString a => [Char] -> a
fromString ([Char] -> s) -> (a -> [Char]) -> a -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style -> PPHsMode -> a -> [Char]
forall a. Pretty a => Style -> PPHsMode -> a -> [Char]
H.prettyPrintStyleMode (Style
H.style { mode :: Mode
H.mode = Mode
H.OneLineMode }) PPHsMode
H.defaultMode