{-# LANGUAGE CPP, TypeSynonymInstances, ImplicitParams, TemplateHaskell #-}

module HsDev.Inspect (
	preload,
	AnalyzeEnv(..), analyzeEnv, analyzeFixities, analyzeRefine, moduleAnalyzeEnv,
	analyzeResolve, analyzePreloaded,
	inspectDocs, inspectDocsGhc,
	inspectContents, contentsInspection,
	inspectFile, sourceInspection, fileMTime, fileInspection, fileContentsInspection, fileContentsInspection_, installedInspection, moduleInspection,
	projectDirs, projectSources,
	getDefines,
	preprocess, preprocess_,

	module HsDev.Inspect.Types,
	module HsDev.Inspect.Resolve,
	module Control.Monad.Except
	) where

import Control.DeepSeq
import qualified Control.Exception as E
import Control.Lens
import Control.Monad
import Control.Monad.Catch
import Control.Monad.Reader
import Control.Monad.Except
import Data.List
import Data.Map.Strict (Map)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Semigroup
import Data.String
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, getPOSIXTime, POSIXTime)
import qualified Data.Map.Strict as M
import qualified Language.Haskell.Exts as H
import Language.Haskell.Exts.Fixity
import qualified Language.Haskell.Names as N
import qualified Language.Haskell.Names.Annotated as N
import qualified Language.Haskell.Names.SyntaxUtils as N
import qualified Language.Haskell.Names.Exports as N
import qualified Language.Haskell.Names.Imports as N
import qualified Language.Haskell.Names.ModuleSymbols as N
import qualified Language.Haskell.Names.Open as N
import qualified Language.Preprocessor.Cpphs as Cpphs
import qualified System.Directory as Dir
import System.FilePath
import Text.Format

import HsDev.Display ()
import HsDev.Error
import HsDev.Inspect.Definitions
import HsDev.Inspect.Types
import HsDev.Inspect.Resolve
import HsDev.Sandbox (searchPackageDbStack)
import HsDev.Symbols
import HsDev.Symbols.Resolve (refineSymbol, refineTable, RefineTable)
import qualified HsDev.Symbols.HaskellNames as HN
import HsDev.Tools.Base
import HsDev.Tools.Ghc.Worker (GhcM)
import HsDev.Tools.HDocs (hdocs, hdocsProcess, readModuleDocs)
import HsDev.Util
import System.Directory.Paths

-- | Preload module - load head and imports to get actual extensions and dependencies
preload :: (MonadIO m, MonadCatch m) => Text -> [(String, String)] -> [String] -> Maybe Text -> InspectM ModuleLocation ModuleTag m Preloaded
preload :: Text
-> [(String, String)]
-> [String]
-> Maybe Text
-> InspectM ModuleLocation ModuleTag m Preloaded
preload Text
name [(String, String)]
defines [String]
opts Maybe Text
mcts = ModuleTag
-> InspectM ModuleLocation ModuleTag m Preloaded
-> InspectM ModuleLocation ModuleTag m Preloaded
forall (m :: * -> *) t k a.
(Monad m, Ord t) =>
t -> InspectM k t m a -> InspectM k t m a
inspectTag ModuleTag
OnlyHeaderTag (InspectM ModuleLocation ModuleTag m Preloaded
 -> InspectM ModuleLocation ModuleTag m Preloaded)
-> InspectM ModuleLocation ModuleTag m Preloaded
-> InspectM ModuleLocation ModuleTag m Preloaded
forall a b. (a -> b) -> a -> b
$ case Maybe Text
mcts of
	Maybe Text
Nothing -> do
		ModuleLocation
mloc <- InspectM ModuleLocation ModuleTag m ModuleLocation
forall r (m :: * -> *). MonadReader r m => m r
ask
		case ModuleLocation
mloc of
			FileModule Text
fpath Maybe Project
mproj -> do
				m Inspection
-> m Preloaded -> InspectM ModuleLocation ModuleTag m Preloaded
forall (m :: * -> *) a k t.
MonadCatch m =>
m Inspection -> m a -> InspectM k t m a
inspect_ (IO Inspection -> m Inspection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Inspection -> m Inspection) -> IO Inspection -> m Inspection
forall a b. (a -> b) -> a -> b
$ Text -> [String] -> IO Inspection
fileInspection Text
fpath [String]
opts) (m Preloaded -> InspectM ModuleLocation ModuleTag m Preloaded)
-> m Preloaded -> InspectM ModuleLocation ModuleTag m Preloaded
forall a b. (a -> b) -> a -> b
$ do
					Text
cts <- IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ String -> IO Text
readFileUtf8 (Getting String Text String -> Text -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Text String
Lens' Text String
path Text
fpath)
					let
						srcExts :: Extensions Text
srcExts = Extensions Text -> Maybe (Extensions Text) -> Extensions Text
forall a. a -> Maybe a -> a
fromMaybe (Text -> Text
takeDir Text
fpath Text -> Info -> Extensions Text
forall a. a -> Info -> Extensions a
`withExtensions` Info
forall a. Monoid a => a
mempty) (Maybe (Extensions Text) -> Extensions Text)
-> Maybe (Extensions Text) -> Extensions Text
forall a b. (a -> b) -> a -> b
$ do
							Project
proj <- Maybe Project
mproj
							Project -> Text -> Maybe (Extensions Text)
findSourceDir Project
proj Text
fpath
					IO Preloaded -> m Preloaded
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Preloaded -> m Preloaded) -> IO Preloaded -> m Preloaded
forall a b. (a -> b) -> a -> b
$ Text
-> [(String, String)]
-> [String]
-> ModuleLocation
-> Text
-> IO Preloaded
preload' Text
name [(String, String)]
defines ([String]
opts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Extensions Text -> [String]
forall a. Extensions a -> [String]
extensionsOpts Extensions Text
srcExts) ModuleLocation
mloc Text
cts
			ModuleLocation
_ -> HsDevError -> InspectM ModuleLocation ModuleTag m Preloaded
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (HsDevError -> InspectM ModuleLocation ModuleTag m Preloaded)
-> HsDevError -> InspectM ModuleLocation ModuleTag m Preloaded
forall a b. (a -> b) -> a -> b
$ String -> HsDevError
InspectError (String -> HsDevError) -> String -> HsDevError
forall a b. (a -> b) -> a -> b
$ String -> Format
forall r. FormatResult r => String -> r
format String
"preload called on non-sourced module: {}" Format -> ModuleLocation -> String
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ ModuleLocation
mloc
	Just Text
cts -> m Inspection
-> (ModuleLocation -> m Preloaded)
-> InspectM ModuleLocation ModuleTag m Preloaded
forall (m :: * -> *) k a t.
MonadCatch m =>
m Inspection -> (k -> m a) -> InspectM k t m a
inspect (IO Inspection -> m Inspection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Inspection -> m Inspection) -> IO Inspection -> m Inspection
forall a b. (a -> b) -> a -> b
$ [String] -> IO Inspection
fileContentsInspection [String]
opts) ((ModuleLocation -> m Preloaded)
 -> InspectM ModuleLocation ModuleTag m Preloaded)
-> (ModuleLocation -> m Preloaded)
-> InspectM ModuleLocation ModuleTag m Preloaded
forall a b. (a -> b) -> a -> b
$ \ModuleLocation
mloc ->
		IO Preloaded -> m Preloaded
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Preloaded -> m Preloaded) -> IO Preloaded -> m Preloaded
forall a b. (a -> b) -> a -> b
$ Text
-> [(String, String)]
-> [String]
-> ModuleLocation
-> Text
-> IO Preloaded
preload' Text
name [(String, String)]
defines [String]
opts ModuleLocation
mloc Text
cts
	where
		preload' :: Text
-> [(String, String)]
-> [String]
-> ModuleLocation
-> Text
-> IO Preloaded
preload' Text
name' [(String, String)]
defines' [String]
opts' ModuleLocation
mloc' Text
cts' = do
			Text
cts'' <- [(String, String)] -> [String] -> Text -> Text -> IO Text
preprocess_ [(String, String)]
defines' [String]
exts Text
fpath (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> Text -> Text
T.map Char -> Char
untab Text
cts'
			[ModulePragma SrcSpanInfo]
pragmas <- ParseResult [ModulePragma SrcSpanInfo]
-> IO [ModulePragma SrcSpanInfo]
forall a. ParseResult a -> IO a
parseOk (ParseResult [ModulePragma SrcSpanInfo]
 -> IO [ModulePragma SrcSpanInfo])
-> ParseResult [ModulePragma SrcSpanInfo]
-> IO [ModulePragma SrcSpanInfo]
forall a b. (a -> b) -> a -> b
$ String -> ParseResult [ModulePragma SrcSpanInfo]
H.getTopPragmas (Text -> String
T.unpack Text
cts'')
			let
				fileExts :: [Extension]
fileExts = [String -> Extension
H.parseExtension (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Name () -> Text
fromName_ (Name () -> Text) -> Name () -> Text
forall a b. (a -> b) -> a -> b
$ Name SrcSpanInfo -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name SrcSpanInfo
lang) | H.LanguagePragma SrcSpanInfo
_ [Name SrcSpanInfo]
langs <- [ModulePragma SrcSpanInfo]
pragmas, Name SrcSpanInfo
lang <- [Name SrcSpanInfo]
langs]
				pmode :: ParseMode
pmode = ParseMode :: String
-> Language
-> [Extension]
-> Bool
-> Bool
-> Maybe [Fixity]
-> Bool
-> ParseMode
H.ParseMode {
					parseFilename :: String
H.parseFilename = Getting String Text String -> Text -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Text String
Lens' Text String
path Text
fpath,
					baseLanguage :: Language
H.baseLanguage = Language
H.Haskell2010,
					extensions :: [Extension]
H.extensions = [Extension] -> [Extension]
forall a. Ord a => [a] -> [a]
ordNub ((String -> Extension) -> [String] -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
map String -> Extension
H.parseExtension [String]
exts [Extension] -> [Extension] -> [Extension]
forall a. [a] -> [a] -> [a]
++ [Extension]
fileExts),
					ignoreLanguagePragmas :: Bool
H.ignoreLanguagePragmas = Bool
False,
					ignoreLinePragmas :: Bool
H.ignoreLinePragmas = Bool
True,
					fixities :: Maybe [Fixity]
H.fixities = Maybe [Fixity]
forall a. Maybe a
Nothing,
					ignoreFunctionArity :: Bool
H.ignoreFunctionArity = Bool
False }
			H.ModuleHeadAndImports SrcSpanInfo
l [ModulePragma SrcSpanInfo]
mpragmas Maybe (ModuleHead SrcSpanInfo)
mhead [ImportDecl SrcSpanInfo]
mimps <- ParseResult (ModuleHeadAndImports SrcSpanInfo)
-> IO (ModuleHeadAndImports SrcSpanInfo)
forall a. ParseResult a -> IO a
parseOk (ParseResult (ModuleHeadAndImports SrcSpanInfo)
 -> IO (ModuleHeadAndImports SrcSpanInfo))
-> ParseResult (ModuleHeadAndImports SrcSpanInfo)
-> IO (ModuleHeadAndImports SrcSpanInfo)
forall a b. (a -> b) -> a -> b
$ (NonGreedy (ModuleHeadAndImports SrcSpanInfo)
 -> ModuleHeadAndImports SrcSpanInfo)
-> ParseResult (NonGreedy (ModuleHeadAndImports SrcSpanInfo))
-> ParseResult (ModuleHeadAndImports SrcSpanInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonGreedy (ModuleHeadAndImports SrcSpanInfo)
-> ModuleHeadAndImports SrcSpanInfo
forall a. NonGreedy a -> a
H.unNonGreedy (ParseResult (NonGreedy (ModuleHeadAndImports SrcSpanInfo))
 -> ParseResult (ModuleHeadAndImports SrcSpanInfo))
-> ParseResult (NonGreedy (ModuleHeadAndImports SrcSpanInfo))
-> ParseResult (ModuleHeadAndImports SrcSpanInfo)
forall a b. (a -> b) -> a -> b
$ ParseMode
-> String
-> ParseResult (NonGreedy (ModuleHeadAndImports SrcSpanInfo))
forall ast. Parseable ast => ParseMode -> String -> ParseResult ast
H.parseWithMode ParseMode
pmode (Text -> String
T.unpack Text
cts'')
			let
				mname :: String
mname = case Maybe (ModuleHead SrcSpanInfo)
mhead of
					Just (H.ModuleHead SrcSpanInfo
_ (H.ModuleName SrcSpanInfo
_ String
nm) Maybe (WarningText SrcSpanInfo)
_ Maybe (ExportSpecList SrcSpanInfo)
_) -> String
nm
					Maybe (ModuleHead SrcSpanInfo)
_ -> String
"Main"
			Preloaded -> IO Preloaded
forall (m :: * -> *) a. Monad m => a -> m a
return (Preloaded -> IO Preloaded) -> Preloaded -> IO Preloaded
forall a b. (a -> b) -> a -> b
$ Preloaded :: ModuleId -> ParseMode -> Module SrcSpanInfo -> Text -> Preloaded
Preloaded {
				_preloadedId :: ModuleId
_preloadedId = Text -> ModuleLocation -> ModuleId
ModuleId (String -> Text
forall a. IsString a => String -> a
fromString String
mname) ModuleLocation
mloc',
				_preloadedMode :: ParseMode
_preloadedMode = ParseMode
pmode,
				_preloadedModule :: Module SrcSpanInfo
_preloadedModule = SrcSpanInfo
-> Maybe (ModuleHead SrcSpanInfo)
-> [ModulePragma SrcSpanInfo]
-> [ImportDecl SrcSpanInfo]
-> [Decl SrcSpanInfo]
-> Module SrcSpanInfo
forall l.
l
-> Maybe (ModuleHead l)
-> [ModulePragma l]
-> [ImportDecl l]
-> [Decl l]
-> Module l
H.Module SrcSpanInfo
l Maybe (ModuleHead SrcSpanInfo)
mhead [ModulePragma SrcSpanInfo]
mpragmas [ImportDecl SrcSpanInfo]
mimps [],
				_preloaded :: Text
_preloaded = Text
cts'' }
			where
				fpath :: Text
fpath = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
name' (ModuleLocation
mloc' ModuleLocation
-> Getting (First Text) ModuleLocation Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First Text) ModuleLocation Text
Traversal' ModuleLocation Text
moduleFile)
				parseOk :: H.ParseResult a -> IO a
				parseOk :: ParseResult a -> IO a
parseOk (H.ParseOk a
v) = a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
				parseOk (H.ParseFailed SrcLoc
loc String
err) = HsDevError -> IO a
forall (m :: * -> *) a. MonadThrow m => HsDevError -> m a
hsdevError (HsDevError -> IO a) -> HsDevError -> IO a
forall a b. (a -> b) -> a -> b
$ String -> HsDevError
InspectError (String -> HsDevError) -> String -> HsDevError
forall a b. (a -> b) -> a -> b
$
					String -> Format
forall r. FormatResult r => String -> r
format String
"Parse {} failed at {} with: {}" Format -> Text -> Format
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ Text
fpath Format -> String -> Format
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ SrcLoc -> String
forall a. Show a => a -> String
show SrcLoc
loc Format -> String -> String
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ String
err
				untab :: Char -> Char
untab Char
'\t' = Char
' '
				untab Char
ch = Char
ch
				exts :: [String]
exts = (String -> Maybe String) -> [String] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe String
flagExtension [String]
opts'

data AnalyzeEnv = AnalyzeEnv {
	AnalyzeEnv -> Environment
_analyzeEnv :: N.Environment,
	AnalyzeEnv -> Map Name Fixity
_analyzeFixities :: M.Map Name H.Fixity,
	AnalyzeEnv -> RefineTable
_analyzeRefine :: RefineTable }

instance Semigroup AnalyzeEnv where
	AnalyzeEnv Environment
lenv Map Name Fixity
lf RefineTable
lt <> :: AnalyzeEnv -> AnalyzeEnv -> AnalyzeEnv
<> AnalyzeEnv Environment
renv Map Name Fixity
rf RefineTable
rt = Environment -> Map Name Fixity -> RefineTable -> AnalyzeEnv
AnalyzeEnv
		(Environment
lenv Environment -> Environment -> Environment
forall a. Semigroup a => a -> a -> a
<> Environment
renv)
		(Map Name Fixity
lf Map Name Fixity -> Map Name Fixity -> Map Name Fixity
forall a. Semigroup a => a -> a -> a
<> Map Name Fixity
rf)
		(RefineTable
lt RefineTable -> RefineTable -> RefineTable
forall a. Semigroup a => a -> a -> a
<> RefineTable
rt)

instance Monoid AnalyzeEnv where
	mempty :: AnalyzeEnv
mempty = Environment -> Map Name Fixity -> RefineTable -> AnalyzeEnv
AnalyzeEnv Environment
forall a. Monoid a => a
mempty Map Name Fixity
forall a. Monoid a => a
mempty RefineTable
forall a. Monoid a => a
mempty
	mappend :: AnalyzeEnv -> AnalyzeEnv -> AnalyzeEnv
mappend AnalyzeEnv
l AnalyzeEnv
r = AnalyzeEnv
l AnalyzeEnv -> AnalyzeEnv -> AnalyzeEnv
forall a. Semigroup a => a -> a -> a
<> AnalyzeEnv
r

moduleAnalyzeEnv :: Module -> AnalyzeEnv
moduleAnalyzeEnv :: Module -> AnalyzeEnv
moduleAnalyzeEnv Module
m = Environment -> Map Name Fixity -> RefineTable -> AnalyzeEnv
AnalyzeEnv
	(Module -> Environment
forall a. ToEnvironment a => a -> Environment
environment Module
m)
	(Module
m Module
-> Getting (Map Name Fixity) Module (Map Name Fixity)
-> Map Name Fixity
forall s a. s -> Getting a s a -> a
^. Getting (Map Name Fixity) Module (Map Name Fixity)
Lens' Module (Map Name Fixity)
fixitiesMap)
	([Symbol] -> RefineTable
refineTable (Module
m Module -> Getting (Endo [Symbol]) Module Symbol -> [Symbol]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Symbol]) Module Symbol
Traversal' Module Symbol
exportedSymbols))

-- | Resolve module imports/exports/scope
analyzeResolve :: AnalyzeEnv -> Module -> Module
analyzeResolve :: AnalyzeEnv -> Module -> Module
analyzeResolve (AnalyzeEnv Environment
env Map Name Fixity
_ RefineTable
rtable) Module
m = case Module
m Module
-> Getting (Maybe Parsed) Module (Maybe Parsed) -> Maybe Parsed
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Parsed) Module (Maybe Parsed)
Lens' Module (Maybe Parsed)
moduleSource of
	Maybe Parsed
Nothing -> Module
m
	Just Parsed
msrc -> ASetter Module Module Symbol Symbol
-> (Symbol -> Symbol) -> Module -> Module
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Module Module Symbol Symbol
Traversal' Module Symbol
moduleSymbols (RefineTable -> Symbol -> Symbol
refineSymbol RefineTable
stbl) (Module -> Module) -> Module -> Module
forall a b. (a -> b) -> a -> b
$ Module
m {
		_moduleImports :: [Import]
_moduleImports = (ImportDecl (Scoped SrcSpanInfo) -> Import)
-> [ImportDecl (Scoped SrcSpanInfo)] -> [Import]
forall a b. (a -> b) -> [a] -> [b]
map (ImportDecl SrcSpanInfo -> Import
toImport (ImportDecl SrcSpanInfo -> Import)
-> (ImportDecl (Scoped SrcSpanInfo) -> ImportDecl SrcSpanInfo)
-> ImportDecl (Scoped SrcSpanInfo)
-> Import
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl (Scoped SrcSpanInfo) -> ImportDecl SrcSpanInfo
forall (f :: * -> *) l. Functor f => f (Scoped l) -> f l
dropScope) [ImportDecl (Scoped SrcSpanInfo)]
idecls',
		_moduleExports :: [Symbol]
_moduleExports = (Symbol -> Symbol) -> [Symbol] -> [Symbol]
forall a b. (a -> b) -> [a] -> [b]
map Symbol -> Symbol
HN.fromSymbol ([Symbol] -> [Symbol]) -> [Symbol] -> [Symbol]
forall a b. (a -> b) -> a -> b
$ Table -> Parsed -> [Symbol]
forall l. (Data l, Eq l) => Table -> Module l -> [Symbol]
N.exportedSymbols Table
tbl Parsed
msrc,
		_moduleFixities :: [Fixity]
_moduleFixities = [Assoc () -> Int -> Name -> Fixity
Fixity (Assoc (Scoped SrcSpanInfo) -> Assoc ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Assoc (Scoped SrcSpanInfo)
assoc) (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
pr) (Name (Scoped SrcSpanInfo) -> Name
forall a. Name a -> Name
fixName Name (Scoped SrcSpanInfo)
opName)
			| H.InfixDecl Scoped SrcSpanInfo
_ Assoc (Scoped SrcSpanInfo)
assoc Maybe Int
pr [Op (Scoped SrcSpanInfo)]
ops <- [Decl (Scoped SrcSpanInfo)]
decls', Name (Scoped SrcSpanInfo)
opName <- (Op (Scoped SrcSpanInfo) -> Name (Scoped SrcSpanInfo))
-> [Op (Scoped SrcSpanInfo)] -> [Name (Scoped SrcSpanInfo)]
forall a b. (a -> b) -> [a] -> [b]
map Op (Scoped SrcSpanInfo) -> Name (Scoped SrcSpanInfo)
forall l. Op l -> Name l
getOpName [Op (Scoped SrcSpanInfo)]
ops],
		_moduleScope :: Map Name [Symbol]
_moduleScope = ([Symbol] -> [Symbol]) -> Table -> Map Name [Symbol]
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ((Symbol -> Symbol) -> [Symbol] -> [Symbol]
forall a b. (a -> b) -> [a] -> [b]
map Symbol -> Symbol
HN.fromSymbol) Table
tbl,
		_moduleSource :: Maybe Parsed
_moduleSource = Parsed -> Maybe Parsed
forall a. a -> Maybe a
Just Parsed
annotated }
		where
			getOpName :: Op l -> Name l
getOpName (H.VarOp l
_ Name l
nm) = Name l
nm
			getOpName (H.ConOp l
_ Name l
nm) = Name l
nm
			fixName :: Name a -> Name
fixName Name a
o = () -> ModuleName () -> Name () -> Name
forall l. l -> ModuleName l -> Name l -> QName l
H.Qual () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
H.ModuleName () (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Module
m Module -> Getting Text Module Text -> Text
forall s a. s -> Getting a s a -> a
^. (ModuleId -> Const Text ModuleId) -> Module -> Const Text Module
Lens' Module ModuleId
moduleId ((ModuleId -> Const Text ModuleId) -> Module -> Const Text Module)
-> ((Text -> Const Text Text) -> ModuleId -> Const Text ModuleId)
-> Getting Text Module Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> ModuleId -> Const Text ModuleId
Lens' ModuleId Text
moduleName)) (Name a -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name a
o)
			itbl :: Table
itbl = Environment -> Parsed -> Table
forall l. Environment -> Module l -> Table
N.importTable Environment
env Parsed
msrc
			tbl :: Table
tbl = Table -> Parsed -> Table
forall l. (Eq l, Data l) => Table -> Module l -> Table
N.moduleTable Table
itbl Parsed
msrc
			syms :: [Symbol]
syms = ASetter [Symbol] [Symbol] ModuleId ModuleId
-> ModuleId -> [Symbol] -> [Symbol]
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Symbol -> Identity Symbol) -> [Symbol] -> Identity [Symbol]
forall s t a b. Each s t a b => Traversal s t a b
each ((Symbol -> Identity Symbol) -> [Symbol] -> Identity [Symbol])
-> ((ModuleId -> Identity ModuleId) -> Symbol -> Identity Symbol)
-> ASetter [Symbol] [Symbol] ModuleId ModuleId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SymbolId -> Identity SymbolId) -> Symbol -> Identity Symbol
Lens' Symbol SymbolId
symbolId ((SymbolId -> Identity SymbolId) -> Symbol -> Identity Symbol)
-> ((ModuleId -> Identity ModuleId)
    -> SymbolId -> Identity SymbolId)
-> (ModuleId -> Identity ModuleId)
-> Symbol
-> Identity Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleId -> Identity ModuleId) -> SymbolId -> Identity SymbolId
Lens' SymbolId ModuleId
symbolModule) (Module
m Module -> Getting ModuleId Module ModuleId -> ModuleId
forall s a. s -> Getting a s a -> a
^. Getting ModuleId Module ModuleId
Lens' Module ModuleId
moduleId) ([Symbol] -> [Symbol]) -> [Symbol] -> [Symbol]
forall a b. (a -> b) -> a -> b
$
				[Decl (Scoped SrcSpanInfo)] -> [Symbol]
getSymbols [Decl (Scoped SrcSpanInfo)]
decls'
			stbl :: RefineTable
stbl = [Symbol] -> RefineTable
refineTable [Symbol]
syms RefineTable -> RefineTable -> RefineTable
forall a. Monoid a => a -> a -> a
`mappend` RefineTable
rtable
			-- Not using 'annotate' because we already computed needed tables
			annotated :: Parsed
annotated = Scoped SrcSpanInfo
-> Maybe (ModuleHead (Scoped SrcSpanInfo))
-> [ModulePragma (Scoped SrcSpanInfo)]
-> [ImportDecl (Scoped SrcSpanInfo)]
-> [Decl (Scoped SrcSpanInfo)]
-> Parsed
forall l.
l
-> Maybe (ModuleHead l)
-> [ModulePragma l]
-> [ImportDecl l]
-> [Decl l]
-> Module l
H.Module Scoped SrcSpanInfo
l Maybe (ModuleHead (Scoped SrcSpanInfo))
mhead' [ModulePragma (Scoped SrcSpanInfo)]
mpragmas [ImportDecl (Scoped SrcSpanInfo)]
idecls' [Decl (Scoped SrcSpanInfo)]
decls'
			H.Module Scoped SrcSpanInfo
l Maybe (ModuleHead (Scoped SrcSpanInfo))
mhead [ModulePragma (Scoped SrcSpanInfo)]
mpragmas [ImportDecl (Scoped SrcSpanInfo)]
idecls [Decl (Scoped SrcSpanInfo)]
decls = (Scoped SrcSpanInfo -> Scoped SrcSpanInfo) -> Parsed -> Parsed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(N.Scoped NameInfo SrcSpanInfo
_ SrcSpanInfo
v) -> NameInfo SrcSpanInfo -> SrcSpanInfo -> Scoped SrcSpanInfo
forall l. NameInfo l -> l -> Scoped l
N.Scoped NameInfo SrcSpanInfo
forall l. NameInfo l
N.None SrcSpanInfo
v) Parsed
msrc
			mhead' :: Maybe (ModuleHead (Scoped SrcSpanInfo))
mhead' = (ModuleHead (Scoped SrcSpanInfo)
 -> ModuleHead (Scoped SrcSpanInfo))
-> Maybe (ModuleHead (Scoped SrcSpanInfo))
-> Maybe (ModuleHead (Scoped SrcSpanInfo))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ModuleHead (Scoped SrcSpanInfo) -> ModuleHead (Scoped SrcSpanInfo)
forall l. ModuleHead (Scoped l) -> ModuleHead (Scoped l)
scopeHead Maybe (ModuleHead (Scoped SrcSpanInfo))
mhead
			scopeHead :: ModuleHead (Scoped l) -> ModuleHead (Scoped l)
scopeHead (H.ModuleHead Scoped l
lh ModuleName (Scoped l)
mname Maybe (WarningText (Scoped l))
mwarns Maybe (ExportSpecList (Scoped l))
mexports) = Scoped l
-> ModuleName (Scoped l)
-> Maybe (WarningText (Scoped l))
-> Maybe (ExportSpecList (Scoped l))
-> ModuleHead (Scoped l)
forall l.
l
-> ModuleName l
-> Maybe (WarningText l)
-> Maybe (ExportSpecList l)
-> ModuleHead l
H.ModuleHead Scoped l
lh ModuleName (Scoped l)
mname Maybe (WarningText (Scoped l))
mwarns (Maybe (ExportSpecList (Scoped l)) -> ModuleHead (Scoped l))
-> Maybe (ExportSpecList (Scoped l)) -> ModuleHead (Scoped l)
forall a b. (a -> b) -> a -> b
$
				(ExportSpecList (Scoped l) -> ExportSpecList (Scoped l))
-> Maybe (ExportSpecList (Scoped l))
-> Maybe (ExportSpecList (Scoped l))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Table -> ExportSpecList l -> ExportSpecList (Scoped l)
forall l. Table -> ExportSpecList l -> ExportSpecList (Scoped l)
N.annotateExportSpecList Table
tbl (ExportSpecList l -> ExportSpecList (Scoped l))
-> (ExportSpecList (Scoped l) -> ExportSpecList l)
-> ExportSpecList (Scoped l)
-> ExportSpecList (Scoped l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExportSpecList (Scoped l) -> ExportSpecList l
forall (f :: * -> *) l. Functor f => f (Scoped l) -> f l
dropScope) Maybe (ExportSpecList (Scoped l))
mexports
			idecls' :: [ImportDecl (Scoped SrcSpanInfo)]
idecls' = ModuleName SrcSpanInfo
-> Environment
-> [ImportDecl SrcSpanInfo]
-> [ImportDecl (Scoped SrcSpanInfo)]
forall l.
ModuleName l
-> Environment -> [ImportDecl l] -> [ImportDecl (Scoped l)]
N.annotateImportDecls ModuleName SrcSpanInfo
mn Environment
env ((ImportDecl (Scoped SrcSpanInfo) -> ImportDecl SrcSpanInfo)
-> [ImportDecl (Scoped SrcSpanInfo)] -> [ImportDecl SrcSpanInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ImportDecl (Scoped SrcSpanInfo) -> ImportDecl SrcSpanInfo
forall (f :: * -> *) l. Functor f => f (Scoped l) -> f l
dropScope [ImportDecl (Scoped SrcSpanInfo)]
idecls)
			decls' :: [Decl (Scoped SrcSpanInfo)]
decls' = (Decl (Scoped SrcSpanInfo) -> Decl (Scoped SrcSpanInfo))
-> [Decl (Scoped SrcSpanInfo)] -> [Decl (Scoped SrcSpanInfo)]
forall a b. (a -> b) -> [a] -> [b]
map (Scope -> Decl SrcSpanInfo -> Decl (Scoped SrcSpanInfo)
forall (a :: * -> *) l.
(Resolvable (a (Scoped l)), Functor a, Typeable l) =>
Scope -> a l -> a (Scoped l)
N.annotateDecl (ModuleName () -> Table -> Scope
N.initialScope (ModuleName SrcSpanInfo -> ModuleName ()
forall (f :: * -> *) a. Functor f => f a -> f ()
N.dropAnn ModuleName SrcSpanInfo
mn) Table
tbl) (Decl SrcSpanInfo -> Decl (Scoped SrcSpanInfo))
-> (Decl (Scoped SrcSpanInfo) -> Decl SrcSpanInfo)
-> Decl (Scoped SrcSpanInfo)
-> Decl (Scoped SrcSpanInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decl (Scoped SrcSpanInfo) -> Decl SrcSpanInfo
forall (f :: * -> *) l. Functor f => f (Scoped l) -> f l
dropScope) [Decl (Scoped SrcSpanInfo)]
decls
			mn :: ModuleName SrcSpanInfo
mn = ModuleName (Scoped SrcSpanInfo) -> ModuleName SrcSpanInfo
forall (f :: * -> *) l. Functor f => f (Scoped l) -> f l
dropScope (ModuleName (Scoped SrcSpanInfo) -> ModuleName SrcSpanInfo)
-> ModuleName (Scoped SrcSpanInfo) -> ModuleName SrcSpanInfo
forall a b. (a -> b) -> a -> b
$ Parsed -> ModuleName (Scoped SrcSpanInfo)
forall l. Module l -> ModuleName l
N.getModuleName Parsed
msrc

-- | Inspect preloaded module
analyzePreloaded :: AnalyzeEnv -> Preloaded -> Either String Module
analyzePreloaded :: AnalyzeEnv -> Preloaded -> Either String Module
analyzePreloaded aenv :: AnalyzeEnv
aenv@(AnalyzeEnv Environment
env Map Name Fixity
gfixities RefineTable
_) Preloaded
p = case ParseMode -> String -> ParseResult (Module SrcSpanInfo)
H.parseFileContentsWithMode (Preloaded -> ParseMode
_preloadedMode Preloaded
p') (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Preloaded -> Text
_preloaded Preloaded
p') of
	H.ParseFailed SrcLoc
loc String
reason -> String -> Either String Module
forall a b. a -> Either a b
Left (String -> Either String Module) -> String -> Either String Module
forall a b. (a -> b) -> a -> b
$ String
"Parse failed at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SrcLoc -> String
forall a. Show a => a -> String
show SrcLoc
loc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
reason
	H.ParseOk Module SrcSpanInfo
m -> Module -> Either String Module
forall a b. b -> Either a b
Right (Module -> Either String Module) -> Module -> Either String Module
forall a b. (a -> b) -> a -> b
$ AnalyzeEnv -> Module -> Module
analyzeResolve AnalyzeEnv
aenv (Module -> Module) -> Module -> Module
forall a b. (a -> b) -> a -> b
$ 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 = [Import]
forall a. Monoid a => a
mempty,
		_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
m }
	where
		qimps :: [Name]
qimps = Table -> [Name]
forall k a. Map k a -> [k]
M.keys (Table -> [Name]) -> Table -> [Name]
forall a b. (a -> b) -> a -> b
$ Environment -> Module SrcSpanInfo -> Table
forall l. Environment -> Module l -> Table
N.importTable Environment
env (Preloaded -> Module SrcSpanInfo
_preloadedModule Preloaded
p)
		p' :: Preloaded
p' = Preloaded
p { _preloadedMode :: ParseMode
_preloadedMode = (Preloaded -> ParseMode
_preloadedMode Preloaded
p) { fixities :: Maybe [Fixity]
H.fixities = [Fixity] -> Maybe [Fixity]
forall a. a -> Maybe a
Just ((Name -> Maybe Fixity) -> [Name] -> [Fixity]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Name -> Map Name Fixity -> Maybe Fixity
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map Name Fixity
gfixities) [Name]
qimps) } }

-- | Adds documentation to declaration
addDoc :: Map String String -> Symbol -> Symbol
addDoc :: Map String String -> Symbol -> Symbol
addDoc Map String String
docsMap Symbol
sym' = ASetter Symbol Symbol (Maybe Text) (Maybe Text)
-> Maybe Text -> Symbol -> Symbol
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Symbol Symbol (Maybe Text) (Maybe Text)
Lens' Symbol (Maybe Text)
symbolDocs (Getting (First Text) (Map Text Text) Text
-> Map Text Text -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Index (Map Text Text)
-> Traversal' (Map Text Text) (IxValue (Map Text Text))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Getting Text Symbol Text -> Symbol -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((SymbolId -> Const Text SymbolId) -> Symbol -> Const Text Symbol
Lens' Symbol SymbolId
symbolId ((SymbolId -> Const Text SymbolId) -> Symbol -> Const Text Symbol)
-> ((Text -> Const Text Text) -> SymbolId -> Const Text SymbolId)
-> Getting Text Symbol Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> SymbolId -> Const Text SymbolId
Lens' SymbolId Text
symbolName) Symbol
sym')) Map Text Text
docsMap') Symbol
sym' where
	docsMap' :: Map Text Text
docsMap' = (String -> Text) -> Map String Text -> Map Text Text
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys String -> Text
forall a. IsString a => String -> a
fromString (Map String Text -> Map Text Text)
-> (Map String String -> Map String Text)
-> Map String String
-> Map Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text) -> Map String String -> Map String Text
forall a b k. (a -> b) -> Map k a -> Map k b
M.map String -> Text
forall a. IsString a => String -> a
fromString (Map String String -> Map Text Text)
-> Map String String -> Map Text Text
forall a b. (a -> b) -> a -> b
$ Map String String
docsMap

-- | Adds documentation to all declarations in module
addDocs :: Map String String -> Module -> Module
addDocs :: Map String String -> Module -> Module
addDocs Map String String
docsMap = ASetter Module Module Symbol Symbol
-> (Symbol -> Symbol) -> Module -> Module
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Module Module Symbol Symbol
Traversal' Module Symbol
moduleSymbols (Map String String -> Symbol -> Symbol
addDoc Map String String
docsMap)

-- | Extract file docs and set them to module declarations
inspectDocs :: [String] -> Module -> GhcM Module
inspectDocs :: [String] -> Module -> GhcM Module
inspectDocs [String]
opts Module
m = do
	let
		hdocsWorkaround :: Bool
hdocsWorkaround = Bool
False
	PackageDbStack
pdbs <- case Getting ModuleLocation Module ModuleLocation
-> Module -> ModuleLocation
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((ModuleId -> Const ModuleLocation ModuleId)
-> Module -> Const ModuleLocation Module
Lens' Module ModuleId
moduleId ((ModuleId -> Const ModuleLocation ModuleId)
 -> Module -> Const ModuleLocation Module)
-> ((ModuleLocation -> Const ModuleLocation ModuleLocation)
    -> ModuleId -> Const ModuleLocation ModuleId)
-> Getting ModuleLocation Module ModuleLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleLocation -> Const ModuleLocation ModuleLocation)
-> ModuleId -> Const ModuleLocation ModuleId
Lens' ModuleId ModuleLocation
moduleLocation) Module
m of
		FileModule Text
fpath Maybe Project
mproj -> BuildTool
-> Text
-> MGhcT SessionConfig (First DynFlags) (LogT IO) PackageDbStack
searchPackageDbStack (BuildTool -> (Project -> BuildTool) -> Maybe Project -> BuildTool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe BuildTool
CabalTool (Getting BuildTool Project BuildTool -> Project -> BuildTool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting BuildTool Project BuildTool
Lens' Project BuildTool
projectBuildTool) Maybe Project
mproj) Text
fpath
		InstalledModule{} -> PackageDbStack
-> MGhcT SessionConfig (First DynFlags) (LogT IO) PackageDbStack
forall (m :: * -> *) a. Monad m => a -> m a
return PackageDbStack
userDb
		ModuleLocation
_ -> PackageDbStack
-> MGhcT SessionConfig (First DynFlags) (LogT IO) PackageDbStack
forall (m :: * -> *) a. Monad m => a -> m a
return PackageDbStack
userDb
	Maybe (Map String String)
docsMap <- if Bool
hdocsWorkaround
		then IO (Maybe (Map String String))
-> MGhcT
     SessionConfig
     (First DynFlags)
     (LogT IO)
     (Maybe (Map String String))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Map String String))
 -> MGhcT
      SessionConfig
      (First DynFlags)
      (LogT IO)
      (Maybe (Map String String)))
-> IO (Maybe (Map String String))
-> MGhcT
     SessionConfig
     (First DynFlags)
     (LogT IO)
     (Maybe (Map String String))
forall a b. (a -> b) -> a -> b
$ String -> [String] -> IO (Maybe (Map String String))
hdocsProcess (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Getting Text Module Text -> Module -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((ModuleId -> Const Text ModuleId) -> Module -> Const Text Module
Lens' Module ModuleId
moduleId ((ModuleId -> Const Text ModuleId) -> Module -> Const Text Module)
-> ((Text -> Const Text Text) -> ModuleId -> Const Text ModuleId)
-> Getting Text Module Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> ModuleId -> Const Text ModuleId
Lens' ModuleId Text
moduleName) Module
m) (Getting (First String) Module String -> Module -> Maybe String
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((ModuleId -> Const (First String) ModuleId)
-> Module -> Const (First String) Module
Lens' Module ModuleId
moduleId ((ModuleId -> Const (First String) ModuleId)
 -> Module -> Const (First String) Module)
-> ((String -> Const (First String) String)
    -> ModuleId -> Const (First String) ModuleId)
-> Getting (First String) Module String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleLocation -> Const (First String) ModuleLocation)
-> ModuleId -> Const (First String) ModuleId
Lens' ModuleId ModuleLocation
moduleLocation ((ModuleLocation -> Const (First String) ModuleLocation)
 -> ModuleId -> Const (First String) ModuleId)
-> ((String -> Const (First String) String)
    -> ModuleLocation -> Const (First String) ModuleLocation)
-> (String -> Const (First String) String)
-> ModuleId
-> Const (First String) ModuleId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First String) Text)
-> ModuleLocation -> Const (First String) ModuleLocation
Traversal' ModuleLocation Text
moduleFile ((Text -> Const (First String) Text)
 -> ModuleLocation -> Const (First String) ModuleLocation)
-> ((String -> Const (First String) String)
    -> Text -> Const (First String) Text)
-> (String -> Const (First String) String)
-> ModuleLocation
-> Const (First String) ModuleLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Const (First String) String)
-> Text -> Const (First String) Text
Lens' Text String
path) Module
m)) [String]
opts
		else (Map String String -> Maybe (Map String String))
-> MGhcT
     SessionConfig (First DynFlags) (LogT IO) (Map String String)
-> MGhcT
     SessionConfig
     (First DynFlags)
     (LogT IO)
     (Maybe (Map String String))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Map String String -> Maybe (Map String String)
forall a. a -> Maybe a
Just (MGhcT SessionConfig (First DynFlags) (LogT IO) (Map String String)
 -> MGhcT
      SessionConfig
      (First DynFlags)
      (LogT IO)
      (Maybe (Map String String)))
-> MGhcT
     SessionConfig (First DynFlags) (LogT IO) (Map String String)
-> MGhcT
     SessionConfig
     (First DynFlags)
     (LogT IO)
     (Maybe (Map String String))
forall a b. (a -> b) -> a -> b
$ PackageDbStack
-> ModuleLocation
-> [String]
-> MGhcT
     SessionConfig (First DynFlags) (LogT IO) (Map String String)
hdocs PackageDbStack
pdbs (Getting ModuleLocation Module ModuleLocation
-> Module -> ModuleLocation
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((ModuleId -> Const ModuleLocation ModuleId)
-> Module -> Const ModuleLocation Module
Lens' Module ModuleId
moduleId ((ModuleId -> Const ModuleLocation ModuleId)
 -> Module -> Const ModuleLocation Module)
-> ((ModuleLocation -> Const ModuleLocation ModuleLocation)
    -> ModuleId -> Const ModuleLocation ModuleId)
-> Getting ModuleLocation Module ModuleLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleLocation -> Const ModuleLocation ModuleLocation)
-> ModuleId -> Const ModuleLocation ModuleId
Lens' ModuleId ModuleLocation
moduleLocation) Module
m) [String]
opts
	Module -> GhcM Module
forall (m :: * -> *) a. Monad m => a -> m a
return (Module -> GhcM Module) -> Module -> GhcM Module
forall a b. (a -> b) -> a -> b
$ (Module -> Module)
-> (Map String String -> Module -> Module)
-> Maybe (Map String String)
-> Module
-> Module
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Module -> Module
forall a. a -> a
id Map String String -> Module -> Module
addDocs Maybe (Map String String)
docsMap Module
m

-- | Like @inspectDocs@, but in @Ghc@ monad
inspectDocsGhc :: [String] -> Module -> GhcM Module
inspectDocsGhc :: [String] -> Module -> GhcM Module
inspectDocsGhc [String]
opts Module
m = do
	Maybe (Map String String)
docsMap <- [String]
-> Module
-> MGhcT
     SessionConfig
     (First DynFlags)
     (LogT IO)
     (Maybe (Map String String))
readModuleDocs [String]
opts Module
m
	Module -> GhcM Module
forall (m :: * -> *) a. Monad m => a -> m a
return (Module -> GhcM Module) -> Module -> GhcM Module
forall a b. (a -> b) -> a -> b
$ (Module -> Module)
-> (Map String String -> Module -> Module)
-> Maybe (Map String String)
-> Module
-> Module
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Module -> Module
forall a. a -> a
id Map String String -> Module -> Module
addDocs Maybe (Map String String)
docsMap Module
m

-- | Inspect contents
inspectContents :: Text -> [(String, String)] -> [String] -> Text -> IO InspectedModule
inspectContents :: Text
-> [(String, String)] -> [String] -> Text -> IO InspectedModule
inspectContents Text
name [(String, String)]
defines [String]
opts Text
cts = ModuleLocation
-> InspectM ModuleLocation ModuleTag IO Module
-> IO InspectedModule
forall (m :: * -> *) t k a.
(Monad m, Ord t) =>
k -> InspectM k t m a -> m (Inspected k t a)
runInspect (Text -> ModuleLocation
OtherLocation Text
name) (InspectM ModuleLocation ModuleTag IO Module -> IO InspectedModule)
-> InspectM ModuleLocation ModuleTag IO Module
-> IO InspectedModule
forall a b. (a -> b) -> a -> b
$ IO Inspection
-> InspectM ModuleLocation ModuleTag IO Module
-> InspectM ModuleLocation ModuleTag IO Module
forall (m :: * -> *) k t a.
MonadCatch m =>
m Inspection -> InspectM k t m a -> InspectM k t m a
withInspection (Text -> [String] -> IO Inspection
contentsInspection Text
cts [String]
opts) (InspectM ModuleLocation ModuleTag IO Module
 -> InspectM ModuleLocation ModuleTag IO Module)
-> InspectM ModuleLocation ModuleTag IO Module
-> InspectM ModuleLocation ModuleTag IO Module
forall a b. (a -> b) -> a -> b
$ do
	Preloaded
p <- Text
-> [(String, String)]
-> [String]
-> Maybe Text
-> InspectM ModuleLocation ModuleTag IO Preloaded
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Text
-> [(String, String)]
-> [String]
-> Maybe Text
-> InspectM ModuleLocation ModuleTag m Preloaded
preload Text
name [(String, String)]
defines [String]
opts (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
cts)
	Module
analyzed <- IO Module -> InspectM ModuleLocation ModuleTag IO Module
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Module -> InspectM ModuleLocation ModuleTag IO Module)
-> IO Module -> InspectM ModuleLocation ModuleTag IO Module
forall a b. (a -> b) -> a -> b
$ (String -> IO Module)
-> (Module -> IO Module) -> Either String Module -> IO Module
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (HsDevError -> IO Module
forall (m :: * -> *) a. MonadThrow m => HsDevError -> m a
hsdevError (HsDevError -> IO Module)
-> (String -> HsDevError) -> String -> IO Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HsDevError
InspectError) Module -> IO Module
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Module -> IO Module)
-> Either String Module -> IO Module
forall a b. (a -> b) -> a -> b
$ AnalyzeEnv -> Preloaded -> Either String Module
analyzePreloaded AnalyzeEnv
forall a. Monoid a => a
mempty Preloaded
p
	ModuleTag
-> InspectM ModuleLocation ModuleTag IO Module
-> InspectM ModuleLocation ModuleTag IO Module
forall (m :: * -> *) t k a.
(Monad m, Ord t) =>
t -> InspectM k t m a -> InspectM k t m a
inspectUntag ModuleTag
OnlyHeaderTag (InspectM ModuleLocation ModuleTag IO Module
 -> InspectM ModuleLocation ModuleTag IO Module)
-> InspectM ModuleLocation ModuleTag IO Module
-> InspectM ModuleLocation ModuleTag IO Module
forall a b. (a -> b) -> a -> b
$
		Module -> InspectM ModuleLocation ModuleTag IO Module
forall (m :: * -> *) a. Monad m => a -> m a
return (Module -> InspectM ModuleLocation ModuleTag IO Module)
-> Module -> InspectM ModuleLocation ModuleTag IO Module
forall a b. (a -> b) -> a -> b
$ ASetter Module Module ModuleLocation ModuleLocation
-> ModuleLocation -> Module -> Module
forall s t a b. ASetter s t a b -> b -> s -> t
set ((ModuleId -> Identity ModuleId) -> Module -> Identity Module
Lens' Module ModuleId
moduleId ((ModuleId -> Identity ModuleId) -> Module -> Identity Module)
-> ((ModuleLocation -> Identity ModuleLocation)
    -> ModuleId -> Identity ModuleId)
-> ASetter Module Module ModuleLocation ModuleLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleLocation -> Identity ModuleLocation)
-> ModuleId -> Identity ModuleId
Lens' ModuleId ModuleLocation
moduleLocation) (Text -> ModuleLocation
OtherLocation Text
name) Module
analyzed

contentsInspection :: Text -> [String] -> IO Inspection
contentsInspection :: Text -> [String] -> IO Inspection
contentsInspection Text
_ [String]
_ = Inspection -> IO Inspection
forall (m :: * -> *) a. Monad m => a -> m a
return Inspection
InspectionNone -- crc or smth

-- | Inspect file
inspectFile :: [(String, String)] -> [String] -> Path -> Maybe Project -> Maybe Text -> IO InspectedModule
inspectFile :: [(String, String)]
-> [String]
-> Text
-> Maybe Project
-> Maybe Text
-> IO InspectedModule
inspectFile [(String, String)]
defines [String]
opts Text
file Maybe Project
mproj Maybe Text
mcts = IO InspectedModule -> IO InspectedModule
forall (m :: * -> *) a. MonadCatch m => m a -> m a
hsdevLiftIO (IO InspectedModule -> IO InspectedModule)
-> IO InspectedModule -> IO InspectedModule
forall a b. (a -> b) -> a -> b
$ do
	Text
absFilename <- Text -> IO Text
forall a. Paths a => a -> IO a
canonicalize Text
file
	Bool
ex <- Text -> IO Bool
fileExists Text
absFilename
	Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
ex (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ HsDevError -> IO ()
forall (m :: * -> *) a. MonadThrow m => HsDevError -> m a
hsdevError (HsDevError -> IO ()) -> HsDevError -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> HsDevError
FileNotFound Text
absFilename
	ModuleLocation
-> InspectM ModuleLocation ModuleTag IO Module
-> IO InspectedModule
forall (m :: * -> *) t k a.
(Monad m, Ord t) =>
k -> InspectM k t m a -> m (Inspected k t a)
runInspect (Text -> Maybe Project -> ModuleLocation
FileModule Text
absFilename Maybe Project
mproj) (InspectM ModuleLocation ModuleTag IO Module -> IO InspectedModule)
-> InspectM ModuleLocation ModuleTag IO Module
-> IO InspectedModule
forall a b. (a -> b) -> a -> b
$ IO Inspection
-> InspectM ModuleLocation ModuleTag IO Module
-> InspectM ModuleLocation ModuleTag IO Module
forall (m :: * -> *) k t a.
MonadCatch m =>
m Inspection -> InspectM k t m a -> InspectM k t m a
withInspection (Text -> Maybe Text -> [String] -> IO Inspection
sourceInspection Text
absFilename Maybe Text
mcts [String]
opts) (InspectM ModuleLocation ModuleTag IO Module
 -> InspectM ModuleLocation ModuleTag IO Module)
-> InspectM ModuleLocation ModuleTag IO Module
-> InspectM ModuleLocation ModuleTag IO Module
forall a b. (a -> b) -> a -> b
$ do
		Preloaded
p <- Text
-> [(String, String)]
-> [String]
-> Maybe Text
-> InspectM ModuleLocation ModuleTag IO Preloaded
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Text
-> [(String, String)]
-> [String]
-> Maybe Text
-> InspectM ModuleLocation ModuleTag m Preloaded
preload Text
absFilename [(String, String)]
defines [String]
opts Maybe Text
mcts
		Module
forced <- IO (Either String Module)
-> InspectM ModuleLocation ModuleTag IO (Either String Module)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((ErrorCall -> IO (Either String Module))
-> IO (Either String Module) -> IO (Either String Module)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle ErrorCall -> IO (Either String Module)
onErr (Either String Module -> IO (Either String Module)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Module -> IO (Either String Module))
-> Either String Module -> IO (Either String Module)
forall a b. NFData a => (a -> b) -> a -> b
$!! AnalyzeEnv -> Preloaded -> Either String Module
analyzePreloaded AnalyzeEnv
forall a. Monoid a => a
mempty Preloaded
p)) InspectM ModuleLocation ModuleTag IO (Either String Module)
-> (Either String Module
    -> InspectM ModuleLocation ModuleTag IO Module)
-> InspectM ModuleLocation ModuleTag IO Module
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> InspectM ModuleLocation ModuleTag IO Module)
-> (Module -> InspectM ModuleLocation ModuleTag IO Module)
-> Either String Module
-> InspectM ModuleLocation ModuleTag IO Module
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (HsDevError -> InspectM ModuleLocation ModuleTag IO Module
forall (m :: * -> *) a. MonadThrow m => HsDevError -> m a
hsdevError (HsDevError -> InspectM ModuleLocation ModuleTag IO Module)
-> (String -> HsDevError)
-> String
-> InspectM ModuleLocation ModuleTag IO Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HsDevError
InspectError) Module -> InspectM ModuleLocation ModuleTag IO Module
forall (m :: * -> *) a. Monad m => a -> m a
return
		Module -> InspectM ModuleLocation ModuleTag IO Module
forall (m :: * -> *) a. Monad m => a -> m a
return (Module -> InspectM ModuleLocation ModuleTag IO Module)
-> Module -> InspectM ModuleLocation ModuleTag IO Module
forall a b. (a -> b) -> a -> b
$ ASetter Module Module ModuleLocation ModuleLocation
-> ModuleLocation -> Module -> Module
forall s t a b. ASetter s t a b -> b -> s -> t
set ((ModuleId -> Identity ModuleId) -> Module -> Identity Module
Lens' Module ModuleId
moduleId ((ModuleId -> Identity ModuleId) -> Module -> Identity Module)
-> ((ModuleLocation -> Identity ModuleLocation)
    -> ModuleId -> Identity ModuleId)
-> ASetter Module Module ModuleLocation ModuleLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleLocation -> Identity ModuleLocation)
-> ModuleId -> Identity ModuleId
Lens' ModuleId ModuleLocation
moduleLocation) (Text -> Maybe Project -> ModuleLocation
FileModule Text
absFilename Maybe Project
mproj) Module
forced
	where
		onErr :: E.ErrorCall -> IO (Either String Module)
		onErr :: ErrorCall -> IO (Either String Module)
onErr = Either String Module -> IO (Either String Module)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Module -> IO (Either String Module))
-> (ErrorCall -> Either String Module)
-> ErrorCall
-> IO (Either String Module)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Module
forall a b. a -> Either a b
Left (String -> Either String Module)
-> (ErrorCall -> String) -> ErrorCall -> Either String Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorCall -> String
forall a. Show a => a -> String
show

-- | Source inspection data, differs whether there are contents provided
sourceInspection :: Path -> Maybe Text -> [String] -> IO Inspection
sourceInspection :: Text -> Maybe Text -> [String] -> IO Inspection
sourceInspection Text
f Maybe Text
Nothing = Text -> [String] -> IO Inspection
fileInspection Text
f
sourceInspection Text
_ (Just Text
_) = [String] -> IO Inspection
fileContentsInspection

-- | File modification time as posix time
fileMTime :: Path -> IO POSIXTime
fileMTime :: Text -> IO POSIXTime
fileMTime Text
f = do
	UTCTime
tm <- String -> IO UTCTime
Dir.getModificationTime (Getting String Text String -> Text -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Text String
Lens' Text String
path Text
f)
	POSIXTime -> IO POSIXTime
forall (m :: * -> *) a. Monad m => a -> m a
return (POSIXTime -> IO POSIXTime) -> POSIXTime -> IO POSIXTime
forall a b. (a -> b) -> a -> b
$ UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
tm

-- | File inspection data
fileInspection :: Path -> [String] -> IO Inspection
fileInspection :: Text -> [String] -> IO Inspection
fileInspection Text
f [String]
opts = do
	POSIXTime
mtime <- Text -> IO POSIXTime
fileMTime Text
f
	Inspection -> IO Inspection
forall (m :: * -> *) a. Monad m => a -> m a
return (Inspection -> IO Inspection) -> Inspection -> IO Inspection
forall a b. (a -> b) -> a -> b
$ POSIXTime -> [Text] -> Inspection
InspectionAt POSIXTime
mtime ([Text] -> Inspection) -> [Text] -> Inspection
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
forall a. IsString a => String -> a
fromString ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Ord a => [a] -> [a]
ordNub [String]
opts

-- | File contents inspection data
fileContentsInspection :: [String] -> IO Inspection
fileContentsInspection :: [String] -> IO Inspection
fileContentsInspection [String]
opts = [String] -> POSIXTime -> Inspection
fileContentsInspection_ [String]
opts (POSIXTime -> Inspection) -> IO POSIXTime -> IO Inspection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO POSIXTime
getPOSIXTime

-- | File contents inspection data
fileContentsInspection_ :: [String] -> POSIXTime -> Inspection
fileContentsInspection_ :: [String] -> POSIXTime -> Inspection
fileContentsInspection_ [String]
opts POSIXTime
tm = POSIXTime -> [Text] -> Inspection
InspectionAt POSIXTime
tm ([Text] -> Inspection) -> [Text] -> Inspection
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
forall a. IsString a => String -> a
fromString ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Ord a => [a] -> [a]
ordNub [String]
opts

-- | Installed module inspection data, just opts
installedInspection :: [String] -> IO Inspection
installedInspection :: [String] -> IO Inspection
installedInspection [String]
opts = Inspection -> IO Inspection
forall (m :: * -> *) a. Monad m => a -> m a
return (Inspection -> IO Inspection) -> Inspection -> IO Inspection
forall a b. (a -> b) -> a -> b
$ POSIXTime -> [Text] -> Inspection
InspectionAt POSIXTime
0 ([Text] -> Inspection) -> [Text] -> Inspection
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
forall a. IsString a => String -> a
fromString ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Ord a => [a] -> [a]
ordNub [String]
opts

-- | Inspection by module location
moduleInspection :: ModuleLocation -> [String] -> IO Inspection
moduleInspection :: ModuleLocation -> [String] -> IO Inspection
moduleInspection (FileModule Text
fpath Maybe Project
_) = Text -> [String] -> IO Inspection
fileInspection Text
fpath
moduleInspection ModuleLocation
_ = [String] -> IO Inspection
installedInspection

-- | Enumerate project dirs
projectDirs :: Project -> IO [Extensions Path]
projectDirs :: Project -> IO [Extensions Text]
projectDirs Project
p = do
	Project
p' <- Project -> IO Project
loadProject Project
p
	[Extensions Text] -> IO [Extensions Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Extensions Text] -> IO [Extensions Text])
-> [Extensions Text] -> IO [Extensions Text]
forall a b. (a -> b) -> a -> b
$ [Extensions Text] -> [Extensions Text]
forall a. Ord a => [a] -> [a]
ordNub ([Extensions Text] -> [Extensions Text])
-> [Extensions Text] -> [Extensions Text]
forall a b. (a -> b) -> a -> b
$ (Extensions Text -> Extensions Text)
-> [Extensions Text] -> [Extensions Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text) -> Extensions Text -> Extensions Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text
normPath (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Getting Text Project Text -> Project -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Project Text
Lens' Project Text
projectPath Project
p' Text -> Text -> Text
`subPath`))) ([Extensions Text] -> [Extensions Text])
-> [Extensions Text] -> [Extensions Text]
forall a b. (a -> b) -> a -> b
$ [Extensions Text]
-> (ProjectDescription -> [Extensions Text])
-> Maybe ProjectDescription
-> [Extensions Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ProjectDescription -> [Extensions Text]
sourceDirs (Maybe ProjectDescription -> [Extensions Text])
-> Maybe ProjectDescription -> [Extensions Text]
forall a b. (a -> b) -> a -> b
$ Getting
  (Maybe ProjectDescription) Project (Maybe ProjectDescription)
-> Project -> Maybe ProjectDescription
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe ProjectDescription) Project (Maybe ProjectDescription)
Lens' Project (Maybe ProjectDescription)
projectDescription Project
p'

-- | Enumerate project source files
projectSources :: Project -> IO [Extensions Path]
projectSources :: Project -> IO [Extensions Text]
projectSources Project
p = do
	[Extensions Text]
dirs <- Project -> IO [Extensions Text]
projectDirs Project
p
	let
		enumCabals :: String -> IO [String]
enumCabals = ([String] -> [String]) -> IO [String] -> IO [String]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
takeDirectory ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
cabalFile) (IO [String] -> IO [String])
-> (String -> IO [String]) -> String -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO [String]
traverseDirectory
		dirs' :: [String]
dirs' = (Extensions Text -> String) -> [Extensions Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Getting String (Extensions Text) String
-> Extensions Text -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Text -> Const String Text)
-> Extensions Text -> Const String (Extensions Text)
forall a1 a2. Lens (Extensions a1) (Extensions a2) a1 a2
entity ((Text -> Const String Text)
 -> Extensions Text -> Const String (Extensions Text))
-> Getting String Text String
-> Getting String (Extensions Text) String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting String Text String
Lens' Text String
path)) [Extensions Text]
dirs
	-- enum inner projects and dont consider them as part of this project
	[Text]
subProjs <- ([[String]] -> [Text]) -> IO [[String]] -> IO [Text]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
fromFilePath ([String] -> [Text])
-> ([[String]] -> [String]) -> [[String]] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. Eq a => a -> [a] -> [a]
delete (Getting String Project String -> Project -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Text -> Const String Text) -> Project -> Const String Project
Lens' Project Text
projectPath ((Text -> Const String Text) -> Project -> Const String Project)
-> Getting String Text String -> Getting String Project String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting String Text String
Lens' Text String
path) Project
p) ([String] -> [String])
-> ([[String]] -> [String]) -> [[String]] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. Ord a => [a] -> [a]
ordNub ([String] -> [String])
-> ([[String]] -> [String]) -> [[String]] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) (IO [[String]] -> IO [Text]) -> IO [[String]] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ (String -> IO [String]) -> [String] -> IO [[String]]
forall (m :: * -> *) a b. MonadPlus m => (a -> m b) -> [a] -> m [b]
triesMap (String -> IO [String]
enumCabals) [String]
dirs'
	let
		enumHs :: String -> IO [String]
enumHs = ([String] -> [String]) -> IO [String] -> IO [String]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
thisProjectSource) (IO [String] -> IO [String])
-> (String -> IO [String]) -> String -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO [String]
traverseDirectory
		thisProjectSource :: String -> Bool
thisProjectSource String
h = String -> Bool
haskellSource String
h Bool -> Bool -> Bool
&& Bool -> Bool
not ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`isParent` String -> Text
fromFilePath String
h) [Text]
subProjs)
	([[Extensions Text]] -> [Extensions Text])
-> IO [[Extensions Text]] -> IO [Extensions Text]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([Extensions Text] -> [Extensions Text]
forall a. Ord a => [a] -> [a]
ordNub ([Extensions Text] -> [Extensions Text])
-> ([[Extensions Text]] -> [Extensions Text])
-> [[Extensions Text]]
-> [Extensions Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Extensions Text]] -> [Extensions Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) (IO [[Extensions Text]] -> IO [Extensions Text])
-> IO [[Extensions Text]] -> IO [Extensions Text]
forall a b. (a -> b) -> a -> b
$ (Extensions Text -> IO [Extensions Text])
-> [Extensions Text] -> IO [[Extensions Text]]
forall (m :: * -> *) a b. MonadPlus m => (a -> m b) -> [a] -> m [b]
triesMap ((Extensions [Text] -> [Extensions Text])
-> IO (Extensions [Text]) -> IO [Extensions Text]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Extensions [Text] -> [Extensions Text]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (IO (Extensions [Text]) -> IO [Extensions Text])
-> (Extensions Text -> IO (Extensions [Text]))
-> Extensions Text
-> IO [Extensions Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> IO [Text]) -> Extensions Text -> IO (Extensions [Text])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (([String] -> [Text]) -> IO [String] -> IO [Text]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
fromFilePath) (IO [String] -> IO [Text])
-> (Text -> IO [String]) -> Text -> IO [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO [String]
enumHs (String -> IO [String]) -> (Text -> String) -> Text -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting String Text String -> Text -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Text String
Lens' Text String
path)) [Extensions Text]
dirs

-- | Get actual defines
getDefines :: IO [(String, String)]
getDefines :: IO [(String, String)]
getDefines = (IOException -> IO [(String, String)])
-> IO [(String, String)] -> IO [(String, String)]
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle IOException -> IO [(String, String)]
onIO (IO [(String, String)] -> IO [(String, String)])
-> IO [(String, String)] -> IO [(String, String)]
forall a b. (a -> b) -> a -> b
$ do
	String
tmp <- IO String
Dir.getTemporaryDirectory
	String -> String -> IO ()
writeFile (String
tmp String -> String -> String
</> String
"defines.hs") String
""
	Result
_ <- String -> [String] -> String -> IO Result
runWait String
"ghc" [String
"-E", String
"-optP-dM", String
"-cpp", String
tmp String -> String -> String
</> String
"defines.hs"] String
""
	Text
cts <- String -> IO Text
readFileUtf8 (String
tmp String -> String -> String
</> String
"defines.hspp")
	String -> IO ()
Dir.removeFile (String
tmp String -> String -> String
</> String
"defines.hs")
	String -> IO ()
Dir.removeFile (String
tmp String -> String -> String
</> String
"defines.hspp")
	[(String, String)] -> IO [(String, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, String)] -> IO [(String, String)])
-> [(String, String)] -> IO [(String, String)]
forall a b. (a -> b) -> a -> b
$ ((Int -> Maybe String) -> Maybe (String, String))
-> [Int -> Maybe String] -> [(String, String)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\Int -> Maybe String
g -> (,) (String -> String -> (String, String))
-> Maybe String -> Maybe (String -> (String, String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe String
g Int
1 Maybe (String -> (String, String))
-> Maybe String -> Maybe (String, String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Maybe String
g Int
2) ([Int -> Maybe String] -> [(String, String)])
-> [Int -> Maybe String] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe (Int -> Maybe String))
-> [Text] -> [Int -> Maybe String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> String -> Maybe (Int -> Maybe String)
matchRx String
rx (String -> Maybe (Int -> Maybe String))
-> (Text -> String) -> Text -> Maybe (Int -> Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) ([Text] -> [Int -> Maybe String])
-> [Text] -> [Int -> Maybe String]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
cts
	where
		rx :: String
rx = String
"#define ([^\\s]+) (.*)"
		onIO :: E.IOException -> IO [(String, String)]
		onIO :: IOException -> IO [(String, String)]
onIO IOException
_ = [(String, String)] -> IO [(String, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return []

preprocess :: [(String, String)] -> Path -> Text -> IO Text
preprocess :: [(String, String)] -> Text -> Text -> IO Text
preprocess [(String, String)]
defines Text
fpath Text
cts = do
	[(Posn, String)]
cts' <- IO [(Posn, String)]
-> (IOException -> IO [(Posn, String)]) -> IO [(Posn, String)]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (String
-> [(String, String)]
-> [String]
-> BoolOptions
-> String
-> IO [(Posn, String)]
Cpphs.cppIfdef (Getting String Text String -> Text -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Text String
Lens' Text String
path Text
fpath) [(String, String)]
defines [] BoolOptions
cppOpts (Text -> String
T.unpack Text
cts)) IOException -> IO [(Posn, String)]
onIOError
	Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((Posn, String) -> Text) -> [(Posn, String)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text)
-> ((Posn, String) -> String) -> (Posn, String) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Posn, String) -> String
forall a b. (a, b) -> b
snd) [(Posn, String)]
cts'
	where
		onIOError :: E.IOException -> IO [(Cpphs.Posn, String)]
		onIOError :: IOException -> IO [(Posn, String)]
onIOError IOException
_ = [(Posn, String)] -> IO [(Posn, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return []

		cppOpts :: BoolOptions
cppOpts = BoolOptions
Cpphs.defaultBoolOptions {
			locations :: Bool
Cpphs.locations = Bool
False,
			hashline :: Bool
Cpphs.hashline = Bool
False
		}

preprocess_ :: [(String, String)] -> [String] -> Path -> Text -> IO Text
preprocess_ :: [(String, String)] -> [String] -> Text -> Text -> IO Text
preprocess_ [(String, String)]
defines [String]
exts Text
fpath Text
cts
	| Bool
hasCPP = [(String, String)] -> Text -> Text -> IO Text
preprocess [(String, String)]
defines Text
fpath Text
cts
	| Bool
otherwise = Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
cts
	where
		exts' :: [Extension]
exts' = (String -> Extension) -> [String] -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
map String -> Extension
H.parseExtension [String]
exts [Extension] -> [Extension] -> [Extension]
forall a. [a] -> [a] -> [a]
++ [Extension]
-> ((Maybe Language, [Extension]) -> [Extension])
-> Maybe (Maybe Language, [Extension])
-> [Extension]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Maybe Language, [Extension]) -> [Extension]
forall a b. (a, b) -> b
snd (String -> Maybe (Maybe Language, [Extension])
H.readExtensions (String -> Maybe (Maybe Language, [Extension]))
-> String -> Maybe (Maybe Language, [Extension])
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
cts)
		hasCPP :: Bool
hasCPP = KnownExtension -> Extension
H.EnableExtension KnownExtension
H.CPP Extension -> [Extension] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Extension]
exts'

makeLenses ''AnalyzeEnv