{-# LANGUAGE TemplateHaskell #-}

module HsDev.Inspect.Types (
	Preloaded(..), preloadedId, preloadedMode, preloadedModule, asModule, toImport, preloaded,
	InspectedPreloaded,
	Environment, FixitiesTable,
	Resolved(..), resolvedModule, resolvedSource, resolvedDefs, resolvedImports, resolvedExports, resolvedScope, resolvedFixities,
	InspectedResolved,

	resolvedEnv, resolvedFixitiesTable,

	dropScope, noScope, withNoScope
	) where

import Control.DeepSeq
import Control.Lens
import Data.Map (Map)
import qualified Data.Map as M
import Data.String
import Data.Text (Text)
import qualified Language.Haskell.Exts as H
import qualified Language.Haskell.Names as N
import qualified Language.Haskell.Names.GlobalSymbolTable as N

import HsDev.Symbols.Types
import HsDev.Symbols.Parsed (Parsed, pos)

-- | Preloaded module with contents and extensions
data Preloaded = Preloaded {
	Preloaded -> ModuleId
_preloadedId :: ModuleId,
	Preloaded -> ParseMode
_preloadedMode :: H.ParseMode,
	Preloaded -> Module SrcSpanInfo
_preloadedModule :: H.Module H.SrcSpanInfo,
	-- ^ Loaded module head without declarations
	Preloaded -> Text
_preloaded :: Text }

instance NFData Preloaded where
	rnf :: Preloaded -> ()
rnf (Preloaded ModuleId
mid ParseMode
_ Module SrcSpanInfo
_ Text
cts) = ModuleId -> ()
forall a. NFData a => a -> ()
rnf ModuleId
mid () -> () -> ()
`seq` Text -> ()
forall a. NFData a => a -> ()
rnf Text
cts

asModule :: Lens' Preloaded Module
asModule :: (Module -> f Module) -> Preloaded -> f Preloaded
asModule = (Preloaded -> Module)
-> (Preloaded -> Module -> Preloaded)
-> Lens Preloaded Preloaded Module Module
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Preloaded -> Module
g' Preloaded -> Module -> Preloaded
s' where
	g' :: Preloaded -> Module
g' Preloaded
p = Module :: ModuleId
-> Maybe Text
-> [Import]
-> [Symbol]
-> [Fixity]
-> Map Name [Symbol]
-> Maybe Parsed
-> Module
Module {
		_moduleId :: ModuleId
_moduleId = Preloaded -> ModuleId
_preloadedId Preloaded
p,
		_moduleDocs :: Maybe Text
_moduleDocs = Maybe Text
forall a. Maybe a
Nothing,
		_moduleImports :: [Import]
_moduleImports = (ImportDecl SrcSpanInfo -> Import)
-> [ImportDecl SrcSpanInfo] -> [Import]
forall a b. (a -> b) -> [a] -> [b]
map ImportDecl SrcSpanInfo -> Import
toImport [ImportDecl SrcSpanInfo]
idecls,
		_moduleExports :: [Symbol]
_moduleExports = [Symbol]
forall a. Monoid a => a
mempty,
		_moduleFixities :: [Fixity]
_moduleFixities = [Fixity]
forall a. Monoid a => a
mempty,
		_moduleScope :: Map Name [Symbol]
_moduleScope = Map Name [Symbol]
forall a. Monoid a => a
mempty,
		_moduleSource :: Maybe Parsed
_moduleSource = Parsed -> Maybe Parsed
forall a. a -> Maybe a
Just (Parsed -> Maybe Parsed) -> Parsed -> Maybe Parsed
forall a b. (a -> b) -> a -> b
$ (SrcSpanInfo -> Scoped SrcSpanInfo) -> Module SrcSpanInfo -> Parsed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NameInfo SrcSpanInfo -> SrcSpanInfo -> Scoped SrcSpanInfo
forall l. NameInfo l -> l -> Scoped l
N.Scoped NameInfo SrcSpanInfo
forall l. NameInfo l
N.None) (Module SrcSpanInfo -> Parsed) -> Module SrcSpanInfo -> Parsed
forall a b. (a -> b) -> a -> b
$ Preloaded -> Module SrcSpanInfo
_preloadedModule Preloaded
p }
		where
			H.Module SrcSpanInfo
_ Maybe (ModuleHead SrcSpanInfo)
_ [ModulePragma SrcSpanInfo]
_ [ImportDecl SrcSpanInfo]
idecls [Decl SrcSpanInfo]
_ = Preloaded -> Module SrcSpanInfo
_preloadedModule Preloaded
p
	s' :: Preloaded -> Module -> Preloaded
s' Preloaded
p Module
m = Preloaded
p {
		_preloadedId :: ModuleId
_preloadedId = Module -> ModuleId
_moduleId Module
m,
		_preloadedModule :: Module SrcSpanInfo
_preloadedModule = Module SrcSpanInfo
-> (Parsed -> Module SrcSpanInfo)
-> Maybe Parsed
-> Module SrcSpanInfo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Preloaded -> Module SrcSpanInfo
_preloadedModule Preloaded
p) Parsed -> Module SrcSpanInfo
forall (f :: * -> *) l. Functor f => f (Scoped l) -> f l
dropScope (Module -> Maybe Parsed
_moduleSource Module
m) }

toImport :: H.ImportDecl H.SrcSpanInfo -> Import
toImport :: ImportDecl SrcSpanInfo -> Import
toImport idecl :: ImportDecl SrcSpanInfo
idecl@(H.ImportDecl SrcSpanInfo
_ ModuleName SrcSpanInfo
mname Bool
qual Bool
_ Bool
_ Maybe String
_ Maybe (ModuleName SrcSpanInfo)
alias Maybe (ImportSpecList SrcSpanInfo)
_) = Position -> Text -> Bool -> Maybe Text -> Import
Import (ImportDecl SrcSpanInfo
idecl ImportDecl SrcSpanInfo
-> Getting Position (ImportDecl SrcSpanInfo) Position -> Position
forall s a. s -> Getting a s a -> a
^. Getting Position (ImportDecl SrcSpanInfo) Position
forall (ast :: * -> *) isrc.
(Annotated ast, SrcInfo isrc, Data isrc) =>
Lens' (ast isrc) Position
pos) (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ModuleName SrcSpanInfo -> String
forall l. ModuleName l -> String
getModuleName ModuleName SrcSpanInfo
mname) Bool
qual ((ModuleName SrcSpanInfo -> Text)
-> Maybe (ModuleName SrcSpanInfo) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text)
-> (ModuleName SrcSpanInfo -> String)
-> ModuleName SrcSpanInfo
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName SrcSpanInfo -> String
forall l. ModuleName l -> String
getModuleName) Maybe (ModuleName SrcSpanInfo)
alias) where
	getModuleName :: ModuleName l -> String
getModuleName (H.ModuleName l
_ String
s) = String
s

type InspectedPreloaded = Inspected ModuleLocation ModuleTag Preloaded

-- | Symbols environment, used to resolve names in source
type Environment = N.Environment

-- | Fixities environment, needed to parse source
type FixitiesTable = Map Name H.Fixity

-- | Resolved module
data Resolved = Resolved {
	Resolved -> ModuleName ()
_resolvedModule :: H.ModuleName (),
	Resolved -> Parsed
_resolvedSource :: Parsed,
	Resolved -> [Symbol]
_resolvedDefs :: [Symbol],
	Resolved -> [Import]
_resolvedImports :: [Import],
	Resolved -> [Symbol]
_resolvedExports :: [N.Symbol],
	Resolved -> Table
_resolvedScope :: N.Table,
	Resolved -> [Fixity]
_resolvedFixities :: [H.Fixity] }

instance NFData Resolved where
	rnf :: Resolved -> ()
rnf (Resolved ModuleName ()
_ Parsed
_ [Symbol]
defs [Import]
imps [Symbol]
_ Table
_ [Fixity]
_) = [Symbol] -> ()
forall a. NFData a => a -> ()
rnf [Symbol]
defs () -> () -> ()
`seq` [Import] -> ()
forall a. NFData a => a -> ()
rnf [Import]
imps

-- | Like @InspectedModule@, but for @Resolved@
type InspectedResolved = Inspected ModuleLocation ModuleTag Resolved

-- | Get environment for resolved module
resolvedEnv :: Resolved -> Environment
resolvedEnv :: Resolved -> Environment
resolvedEnv Resolved
r = ModuleName () -> [Symbol] -> Environment
forall k a. k -> a -> Map k a
M.singleton (Resolved -> ModuleName ()
_resolvedModule Resolved
r) (Resolved -> [Symbol]
_resolvedExports Resolved
r)

-- | Get fixities table from resolved module
resolvedFixitiesTable :: Resolved -> FixitiesTable
resolvedFixitiesTable :: Resolved -> FixitiesTable
resolvedFixitiesTable Resolved
r = [FixitiesTable] -> FixitiesTable
forall a. Monoid a => [a] -> a
mconcat [Name -> Fixity -> FixitiesTable
forall k a. k -> a -> Map k a
M.singleton Name
n Fixity
f | f :: Fixity
f@(H.Fixity Assoc ()
_ Int
_ Name
n) <- Resolved -> [Fixity]
_resolvedFixities Resolved
r]

-- | Drop extra info
dropScope :: Functor f => f (N.Scoped l) -> f l
dropScope :: f (Scoped l) -> f l
dropScope = (Scoped l -> l) -> f (Scoped l) -> f l
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(N.Scoped NameInfo l
_ l
a) -> l
a)

-- | Empty scope info
noScope :: l -> N.Scoped l
noScope :: l -> Scoped l
noScope = NameInfo l -> l -> Scoped l
forall l. NameInfo l -> l -> Scoped l
N.Scoped NameInfo l
forall l. NameInfo l
N.None

-- | Set empty scope
withNoScope :: Functor f => f l -> f (N.Scoped l)
withNoScope :: f l -> f (Scoped l)
withNoScope = (l -> Scoped l) -> f l -> f (Scoped l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap l -> Scoped l
forall l. l -> Scoped l
noScope

makeLenses ''Preloaded
makeLenses ''Resolved