{-# 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)
data Preloaded = Preloaded {
Preloaded -> ModuleId
_preloadedId :: ModuleId,
Preloaded -> ParseMode
_preloadedMode :: H.ParseMode,
Preloaded -> Module SrcSpanInfo
_preloadedModule :: H.Module H.SrcSpanInfo,
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
type Environment = N.Environment
type FixitiesTable = Map Name H.Fixity
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
type InspectedResolved = Inspected ModuleLocation ModuleTag Resolved
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)
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]
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)
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
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